OK, i have done some changes on the Authen::SASL::Perl::GSSAPI To do:
1. Let me know how to implement proper error reporting (or replace the dies by what you think is better) 2. Let me know how to implement proper debugging messages (or go to __debug_message and fill in what you think is better) Test was done against Windows2003 AD Server. Please let me know what information is needed in POD, can you send a empty template I can fill with my info? Thank you, Achim
GSSAPI.pm
Description: application/perl-module
Index: GSSAPI.pm
===================================================================
--- GSSAPI.pm (revision 73)
+++ GSSAPI.pm (working copy)
@@ -7,7 +7,7 @@
use strict;
use vars qw($VERSION @ISA);
-use GSSAPI;
+use GSSAPI qw(:all);
$VERSION= "0.01";
@ISA = qw(Authen::SASL::Perl);
@@ -25,20 +25,33 @@
sub mechanism { 'GSSAPI' }
+#---------------------------------------------------------------------------------
sub client_start {
my $self = shift;
my $status;
my $principal = $self->service.'@'.$self->host;
+
+ my $target;
+ $status = GSSAPI::Name->import( $target,
+ $principal,
+ GSSAPI::OID::gss_nt_hostbased_service );
+ if ( $status->major == GSS_S_COMPLETE ) {
+ $self->{gss_ctx} = new GSSAPI::Context;
+ $self->{gss_state} = 0;
- $self->{gss_name} = new GSSAPI::Name;
- $status = $self->{gss_name}->import($self->{gss_name}, $principal,
- gss_nt_service_name)
- or return $self->set_error("GSSAPI Error : ".$status);
- $self->{gss_ctx} = new GSSAPI::Context;
- $self->{gss_state} = 0;
- return $self->client_step("");
+ my $tname;
+ $status = $target->display($tname);
+ if ( $status->major != GSS_S_COMPLETE ) {die "GSSAPI Error : ".$status; }
+ __debug_message( " Name import OK $tname");
+ $self->{gss_name} = $target;
+ return $self->client_step( q{} );
+ }
+ else {
+ die 'GSSAPI name import error ', $self->host, ' ', $status;
+ return $self->set_error("GSSAPI Error : ".$status);
+ }
}
-
+#---------------------------------------------------------------------------------
sub client_step
{
my ($self, $challenge) = @_;
@@ -46,45 +59,72 @@
my $status;
if ($self->{gss_state}==0) {
- my $outtok;
- my $flags;
- $status = $self->{gss_ctx}->init(undef, $self->{gss_name},
- gss_mech_krb5,
- GSS_C_INTEG_FLAG | GSS_C_MUTUAL_FLAG,
- undef, undef, $challenge, undef,
- $outtok, $flags, undef);
- if (GSSAPI::Status::GSS_ERROR($status->major)) {
- return $self->set_error("GSSAPI Error : ".$status);
- }
- if ($status->major == GSS_S_COMPLETE) {
- $self->{gss_state}=1;
- }
- return $outtok;
+ my $itime = 0;
+ my $bindings = GSS_C_NO_CHANNEL_BINDINGS;
+ my $imech = GSSAPI::OID::gss_mech_krb5;
+
+ my $iflags = GSS_C_MUTUAL_FLAG | GSS_C_INTEG_FLAG ;
+ my $creds = GSS_C_NO_CREDENTIAL;
+ my ( $omech,$otoken,$oflags,$otime);
+
+ $status = $self->{gss_ctx}->init( $creds,
+ $self->{gss_name} ,
+ $imech, $iflags, $itime, $bindings, $challenge,
+ $omech,$otoken,$oflags,$otime);
+
+ if ( $status->major == GSS_S_COMPLETE ) {
+ $self->{gss_state} = 1;
+ __debug_message(' reached GSS_S_COMPLETE ');
+ }
+ else {
+ if ( $status->major != GSS_S_CONTINUE_NEEDED ) {
+ die ' init() error', $status;
+ #return $self->set_error("GSSAPI Error : " . $status);
+ }
+ __debug_message(' reached GSS_S_CONTINUE_NEEDED ');
+ }
+ return $otoken;
} elsif ($self->{gss_state}==1) {
+
+
# If the server has an empty output token when it COMPLETEs, Cyrus SASL
# kindly sends us that empty token. We need to ignore it, which introduces
# another round into the process.
return "" if $challenge eq "";
my $unwrapped;
- $status = $self->{gss_ctx}->unwrap($challenge, $unwrapped, undef, undef)
- or return $self->set_error("GSSAPI Error : ".$status);
+ $status = $self->{gss_ctx}->unwrap( $challenge,
+ $unwrapped,
+ undef,
+ undef);
+ if ( $status->major != GSS_S_COMPLETE ) { die 'unwrap error', $status; }
+ __debug_message(' reached UNWRAP');
# XXX - Security layer support will require us to decode this packet
# Need to set message to be 0x01, 0x00, 0x00, 0x00 for no security layers
my $message = pack('CCCC', 0x01, 0x00, 0x00, 0x00);
- $message.= $self->_call('user');
+ $message.= $self->_call('user') if ( $self->_call('user') );
+
my $outtok;
- $status = $self->{gss_ctx}->wrap(0, undef, $message, undef, $outtok)
- or return $self->set_error("GSSAPI Error : ".$status);
-
+ $status = $self->{gss_ctx}->wrap( 0,
+ 0,
+ $message,
+ 0,
+ $outtok,
+ );
+ if ( $status->major != GSS_S_COMPLETE ) { die 'wrap error', $status; }
$self->{gss_state}=0;
+ __debug_message(' reached WRAP');
return $outtok;
}
}
-
+#-----------------------------------------------------------------------------
+sub __debug_message {
+ print "\n DEBUG Authen::SASL::Perl::GSSAPI", @_;
+}
+#-----------------------------------------------------------------------------
__END__
=head1 NAME
