On Wednesday 22 February 2006 09:22, Peter Marschall wrote: > Hi, > > On Tuesday, 21. February 2006 19:55, Achim Grolms wrote: > > Is there an easy way to export the actual version of Authen::SASL::Perl > > you want me to test? > > svn export https://svn.mutatus.co.uk/repos/Authen-SASL/trunk/
I've done some testing now using Net::LDAP againt a Windows2003 AD server.
#! /usr/bin/perl -w
use strict;
use Net::LDAP;
use Authen::SASL;
my $sasl = Authen::SASL->new( mechanism => 'GSSAPI' );
my $adhost = 'ldapserver.example.com';
my $ldap = Net::LDAP->new( $adhost,
onerror => 'die',
#debug => 2,
) or die "Cannot connect to LDAP host
###$adhost###$@";
$ldap->bind ( sasl => $sasl );
print "\n\n ##### reached bind OK Phase";
my $mesg = $ldap->search ( base => 'dc=fsc,dc=net',
#attrs => $p_attrs,
filter => "(&(sAMAccountName=USERNAME))");
worked for me.
I've done some persnonal adjusments to the GSSAPI.pm module
(See attached diff).
DO NOT FEED THAT INTO SVN,
it's juts a base for discussion.
But it worked :-)
Questions:
1. I there a canonical way in Authen::SASL to printout debugmessages?
(I've added sub __debug_message(), but I think there is a better way :-D)
I needed that to see the states og the module.
2. the GSSAPI system can fail and reports errormessages
(caused by DNS problems, wrong /etc/hosts, credentials expired)...
All this errormessaged has to be passed to the user so he gets a chance to fix
that problems (typing kinit etc...)
When useing the
return $self->set_error("GSSAPI Error : ".$status);
I see no errormessage, so I make the module simple die
in case of GSSAPI error.
(That was the simplest for debugging).
But what is the ebst way for errorreporting in a CPAN version of the module?
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,32 @@
sub mechanism { 'GSSAPI' }
+#---------------------------------------------------------------------------------
sub client_start {
my $self = shift;
my $status;
my $principal = $self->service.'@'.$self->host;
$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("");
+ $status = $self->{gss_name}->import( $self->{gss_name},
+ $principal,
+ GSSAPI::OID::gss_nt_hostbased_service );
+ if ( $status->major == GSS_S_COMPLETE ) {
+ $self->{gss_ctx} = new GSSAPI::Context;
+ $self->{gss_state} = 0;
+
+ my $tname;
+ $status = $self->{gss_name}->display($tname);
+ __debug_message( " Name import OK $tname");
+
+ 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 +58,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
