diff --git a/lib/Authen/SASL.pm b/lib/Authen/SASL.pm new file mode 100644 index 0000000..b00cac1 --- /dev/null +++ b/lib/Authen/SASL.pm @@ -0,0 +1,130 @@ +# Copyright (c) 2004-2006 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package Authen::SASL; + +use strict; +use vars qw($VERSION @Plugins); +use Carp; + +$VERSION = "2.16"; + +@Plugins = qw( + Authen::SASL::XS + Authen::SASL::Cyrus + Authen::SASL::Perl +); + + +sub import { + shift; + return unless @_; + + local $SIG{__DIE__}; + @Plugins = grep { /^[:\w]+$/ and eval "require $_" } map { /::/ ? $_ : "Authen::SASL::$_" } @_ + or croak "no valid Authen::SASL plugins found"; +} + + +sub new { + my $pkg = shift; + my %opt = ((@_ % 2 ? 'mechanism' : ()), @_); + + my $self = bless { + mechanism => $opt{mechanism} || $opt{mech}, + callback => {}, + debug => $opt{debug}, + }, $pkg; + + $self->callback(%{$opt{callback}}) if ref($opt{callback}) eq 'HASH'; + + # Compat + $self->callback(user => ($self->{user} = $opt{user})) if exists $opt{user}; + $self->callback(pass => $opt{password}) if exists $opt{password}; + $self->callback(pass => $opt{response}) if exists $opt{response}; + + $self; +} + + +sub mechanism { + my $self = shift; + @_ ? $self->{mechanism} = shift + : $self->{mechanism}; +} + +sub callback { + my $self = shift; + + return $self->{callback}{$_[0]} if @_ == 1; + + my %new = @_; + @{$self->{callback}}{keys %new} = values %new; + + $self->{callback}; +} + +# The list of packages should not really be hardcoded here +# We need some way to discover what plugins are installed + +sub client_new { # $self, $service, $host, $secflags + my $self = shift; + + my $err; + foreach my $pkg (@Plugins) { + if (eval "require $pkg" and $pkg->can("client_new")) { + if ($self->{conn} = eval { $pkg->client_new($self, @_) }) { + return $self->{conn}; + } + $err = $@; + } + } + + croak $err || "Cannot find a SASL Connection library"; +} + +sub server_new { # $self, $service, $host, $secflags + my $self = shift; + + my $err; + foreach my $pkg (@Plugins) { + if (eval "require $pkg" and $pkg->can("server_new")) { + if ($self->{conn} = eval { $pkg->server_new($self, @_) } ) { + return $self->{conn}; + } + $err = $@; + } + } + croak $err || "Cannot find a SASL Connection library for server-side authentication"; +} + +sub error { + my $self = shift; + $self->{conn} && $self->{conn}->error; +} + +# Compat. +sub user { + my $self = shift; + my $user = $self->{callback}{user}; + $self->{callback}{user} = shift if @_; + $user; +} + +sub challenge { + my $self = shift; + $self->{conn}->client_step(@_); +} + +sub initial { + my $self = shift; + $self->client_new($self)->client_start; +} + +sub name { + my $self = shift; + $self->{conn} ? $self->{conn}->mechanism : ($self->{mechanism} =~ /(\S+)/)[0]; +} + +1; diff --git a/lib/Authen/SASL.pod b/lib/Authen/SASL.pod new file mode 100644 index 0000000..dd70775 --- /dev/null +++ b/lib/Authen/SASL.pod @@ -0,0 +1,241 @@ + +=head1 NAME + +Authen::SASL - SASL Authentication framework + +=head1 SYNOPSIS + + use Authen::SASL; + + $sasl = Authen::SASL->new( + mechanism => 'CRAM-MD5 PLAIN ANONYMOUS', + callback => { + pass => \&fetch_password, + user => $user, + } + ); + +=head1 DESCRIPTION + +SASL is a generic mechanism for authentication used by several +network protocols. B provides an implementation +framework that all protocols should be able to share. + +The framework allows different implementations of the connection +class to be plugged in. At the time of writing there were two such +plugins. + +=over 4 + +=item Authen::SASL::Perl + +This module implements several mechanisms and is implemented +entirely in Perl. + +=item Authen::SASL::XS + +This module uses the Cyrus SASL C-library (both version 1 and 2 +are supported). + +=item Authen::SASL::Cyrus + +This module is the predecessor to L. It is reccomended +to use L + +=back + +By default the order in which these plugins are selected is +Authen::SASL::XS, Authen::SASL::Cyrus and then Authen::SASL::Perl. + +If you want to change it or want to specifically use one +implementation only simply do + + use Authen::SASL qw(Perl); + +or if you have another plugin module that supports the Authen::SASL API + + use Authen::SASL qw(My::SASL::Plugin); + +=head2 CONTRUCTOR + +=over 4 + +=item new ( OPTIONS ) + +The constructor may be called with or without arguments. Passing arguments is +just a short cut to calling the C and C methods. + +=over 4 + +=item callback =E { NAME => VALUE, NAME => VALUE, ... } + +Set the callbacks. +See the L method for details. + +=item mechanism =E NAMES + +=item mech =E NAMES + +Set the list of mechanisms to choose from. +See the L method for details. + +=item debug =E VALUE + +Set the debug level bit-value to C + +Debug output will be sent to C. The +bits of this value are: + + 1 Show debug messages in the Perl modules for the mechanisms. + (Currently only used in GSSAPI) + 4 With security layers in place show information on packages read. + 8 With security layers in place show information on packages written. + +The default value is 0. + +=back + +=back + +=head2 METHODS + +=over 4 + +=item mechanism ( ) + +Returns the current list of mechanisms + +=item mechanism ( NAMES ) + +Set the list of mechanisms to choose from. C should be a space separated string +of the names. + +=item callback ( NAME ) + +Returns the current callback associated with C. + +=item callback ( NAME => VALUE, NAME => VALUE, ... ) + +Sets the given callbacks to the given values + +=item client_new ( SERVICE, HOST, SECURITY ) + +Creates and returns a new connection object for a client-side connection. + +=item server_new ( SERVICE, HOST, OPTIONS ) + +Creates and returns a new connection object for a server-side connection. + +=item error ( ) + +Returns any error from the last connection + +=back + +=head1 The Connection Class + +=over 4 + +=item server_start ( CHALLENGE ) + +server_start begins the authentication using the chosen mechanism. +If the mechanism is not supported by the installed SASL it fails. +Because for some mechanisms the client has to start the negotiation, +you can give the client challenge as a parameter. + +=item server_step ( CHALLENGE ) + +server_step performs the next step in the negotiation process. The +first parameter you give is the clients challenge/response. + +=item client_start ( ) + +The initial step to be performed. Returns the initial value to pass to the server +or an empty list on error. + +=item client_step ( CHALLENGE ) + +This method is called when a response from the server requires it. CHALLENGE +is the value from the server. Returns the next value to pass to the server or an +empty list on error. + +=item need_step ( ) + +Returns true if the selected mechanism requires another step before completion +(error or success). + +=item answer ( NAME ) + +The method will return the value returned from the last call to the callback NAME + +=item property ( NAME ) + +Returns the property value associated with C. + +=item property ( NAME => VALUE, NAME => VALUE, ... ) + +Sets the named properties to their associated values. + +=item service ( ) + +Returns the service argument that was passed to *_new-methods. + +=item host ( ) + +Returns the host argument that was passed to *_new-methods. + +=item mechanism ( ) + +Returns the name of the chosen mechanism. + +=item is_success ( ) + +Once need_step() returns false, then you can check if the authentication +succeeded by calling this method which returns a boolean value. + +=back + +=head2 Callbacks + +There are three different ways in which a callback may be passed + +=over + +=item CODEREF + +If the value passed is a code reference then, when needed, it will be called +and the connection object will be passed as the first argument. In addition +some callbacks may be passed additional arguments. + +=item ARRAYREF + +If the value passed is an array reference, the first element in the array +must be a code reference. When the callback is called the code reference +will be called with the connection object passed as the first argument +and all other values from the array passed after. + +=item SCALAR + +All other values passed will be used directly. ie it is the same as +passing an code reference that, when called, returns the value. + +=back + +=head1 SEE ALSO + +L, L, L + +=head1 AUTHOR + +Graham Barr + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 1998-2005 Graham Barr. All rights reserved. This program is +free software; you can redistribute it and/or modify it under the same +terms as Perl itself. + +=cut diff --git a/lib/Authen/SASL/CRAM_MD5.pm b/lib/Authen/SASL/CRAM_MD5.pm new file mode 100644 index 0000000..2f88542 --- /dev/null +++ b/lib/Authen/SASL/CRAM_MD5.pm @@ -0,0 +1,18 @@ +# Copyright (c) 2002 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package Authen::SASL::CRAM_MD5; + +use strict; +use vars qw($VERSION); + +$VERSION = "2.14"; + +sub new { + shift; + Authen::SASL->new(@_, mechanism => 'CRAM-MD5'); +} + +1; + diff --git a/lib/Authen/SASL/EXTERNAL.pm b/lib/Authen/SASL/EXTERNAL.pm new file mode 100644 index 0000000..ed0541e --- /dev/null +++ b/lib/Authen/SASL/EXTERNAL.pm @@ -0,0 +1,18 @@ +# Copyright (c) 2002 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package Authen::SASL::EXTERNAL; + +use strict; +use vars qw($VERSION); + +$VERSION = "2.14"; + +sub new { + shift; + Authen::SASL->new(@_, mechanism => 'EXTERNAL'); +} + +1; + diff --git a/lib/Authen/SASL/Perl.pm b/lib/Authen/SASL/Perl.pm new file mode 100644 index 0000000..53e66a2 --- /dev/null +++ b/lib/Authen/SASL/Perl.pm @@ -0,0 +1,344 @@ +# Copyright (c) 2002 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package Authen::SASL::Perl; + +use strict; +use vars qw($VERSION); +use Carp; + +$VERSION = "2.14"; + +my %secflags = ( + noplaintext => 1, + noanonymous => 1, + nodictionary => 1, +); +my %have; + +sub server_new { + my ($pkg, $parent, $service, $host, $options) = @_; + + my $self = { + callback => { %{$parent->callback} }, + service => $service || '', + host => $host || '', + debug => $parent->{debug} || 0, + need_step => 1, + }; + + my $mechanism = $parent->mechanism + or croak "No server mechanism specified"; + $mechanism =~ s/^\s*\b(.*)\b\s*$/$1/g; + $mechanism =~ s/-/_/g; + $mechanism = uc $mechanism; + my $mpkg = __PACKAGE__ . "::$mechanism"; + eval "require $mpkg;" + or croak "Cannot use $mpkg for " . $parent->mechanism; + my $server = $mpkg->_init($self); + $server->_init_server($options); + return $server; +} + +sub client_new { + my ($pkg, $parent, $service, $host, $secflags) = @_; + + my @sec = grep { $secflags{$_} } split /\W+/, lc($secflags || ''); + + my $self = { + callback => { %{$parent->callback} }, + service => $service || '', + host => $host || '', + debug => $parent->{debug} || 0, + need_step => 1, + }; + + my @mpkg = sort { + $b->_order <=> $a->_order + } grep { + my $have = $have{$_} ||= (eval "require $_;" and $_->can('_secflags')) ? 1 : -1; + $have > 0 and $_->_secflags(@sec) == @sec + } map { + (my $mpkg = __PACKAGE__ . "::$_") =~ s/-/_/g; + $mpkg; + } split /[^-\w]+/, $parent->mechanism + or croak "No SASL mechanism found\n"; + + $mpkg[0]->_init($self); +} + +sub _init_server {} + +sub _order { 0 } +sub code { defined(shift->{error}) || 0 } +sub error { shift->{error} } +sub service { shift->{service} } +sub host { shift->{host} } + +sub need_step { + my $self = shift; + return 0 if $self->{error}; + return $self->{need_step}; +} + +## I think I need to rename that to end()? +## It doesn't mean that SASL is successful, but that +## that the negotiation is over, no more step necessary +## at least for the client +sub set_success { + my $self = shift; + $self->{need_step} = 0; +} + +sub is_success { + my $self = shift; + return !$self->code && !$self->need_step; +} + +sub set_error { + my $self = shift; + $self->{error} = shift; + return; +} + +# set/get property +sub property { + my $self = shift; + my $prop = $self->{property} ||= {}; + return $prop->{ $_[0] } if @_ == 1; + my %new = @_; + @{$prop}{keys %new} = values %new; + 1; +} + +sub callback { + my $self = shift; + + return $self->{callback}{$_[0]} if @_ == 1; + + my %new = @_; + @{$self->{callback}}{keys %new} = values %new; + + $self->{callback}; +} + +# Should be defined in the mechanism sub-class +sub mechanism { undef } +sub client_step { undef } +sub client_start { undef } +sub server_step { undef } +sub server_start { undef } + +# Private methods used by Authen::SASL::Perl that +# may be overridden in mechanism sub-calsses + +sub _init { + my ($pkg, $href) = @_; + + bless $href, $pkg; +} + +sub _call { + my ($self, $name) = splice(@_,0,2); + + my $cb = $self->{callback}{$name}; + + return undef unless defined $cb; + + my $value; + + if (ref($cb) eq 'ARRAY') { + my @args = @$cb; + $cb = shift @args; + $value = $cb->($self, @args); + } + elsif (ref($cb) eq 'CODE') { + $value = $cb->($self, @_); + } + else { + $value = $cb; + } + + $self->{answer}{$name} = $value + unless $name eq 'pass'; # Do not store password + + return $value; +} + +# TODO: Need a better name than this +sub answer { + my ($self, $name) = @_; + $self->{answer}{$name}; +} + +sub _secflags { 0 } + +sub securesocket { + my $self = shift; + return $_[0] unless (defined($self->property('ssf')) && $self->property('ssf') > 0); + + local *GLOB; # avoid used only once warning + my $glob = \do { local *GLOB; }; + tie(*$glob, 'Authen::SASL::Perl::Layer', $_[0], $self); + $glob; +} + +{ + +# +# Add SASL encoding/decoding to a filehandle +# + + package Authen::SASL::Perl::Layer; + + use bytes; + + require Tie::Handle; + our @ISA = qw(Tie::Handle); + + sub TIEHANDLE { + my ($class, $fh, $conn) = @_; + my $self; + + warn __PACKAGE__ . ': non-blocking handle may not work' + if ($fh->can('blocking') and not $fh->blocking()); + + $self->{fh} = $fh; + $self->{conn} = $conn; + $self->{readbuflen} = 0; + $self->{sndbufsz} = $conn->property('maxout'); + $self->{rcvbufsz} = $conn->property('maxbuf'); + + return bless($self, $class); + } + + sub CLOSE { + my ($self) = @_; + + # forward close to the inner handle + close($self->{fh}); + delete $self->{fh}; + } + + sub DESTROY { + my ($self) = @_; + delete $self->{fh}; + undef $self; + } + + sub FETCH { + my ($self) = @_; + return $self->{fh}; + } + + sub FILENO { + my ($self) = @_; + return fileno($self->{fh}); + } + + + sub READ { + my ($self, $buf, $len, $offset) = @_; + my $debug = $self->{conn}->{debug}; + + $buf = \$_[1]; + + my $avail = $self->{readbuflen}; + + print STDERR " [READ(len=$len,offset=$offset)] avail=$avail;\n" + if ($debug & 4); + + # Check if there's leftovers from a previous READ + if ($avail <= 0) { + $avail = $self->_getbuf(); + return undef unless ($avail > 0); + } + + # if there's more than we need right now, leave the rest for later + if ($avail >= $len) { + print STDERR " GOT ALL: avail=$avail; need=$len\n" + if ($debug & 4); + substr($$buf, $offset, $len) = substr($self->{readbuf}, 0, $len, ''); + $self->{readbuflen} -= $len; + return ($len); + } + + # there's not enough; take all we have, read more on next call + print STDERR " GOT PARTIAL: avail=$avail; need=$len\n" + if ($debug & 4); + substr($$buf, $offset || 0, $avail) = $self->{readbuf}; + $self->{readbuf} = ''; + $self->{readbuflen} = 0; + + return ($avail); + } + + # retrieve and decode a buffer of cipher text in SASL format + sub _getbuf { + my ($self) = @_; + my $debug = $self->{conn}->{debug}; + my $fh = $self->{fh}; + my $buf = ''; + + # first, read 4-octet buffer size + my $n = 0; + while ($n < 4) { + my $rv = sysread($fh, $buf, 4 - $n, $n); + print STDERR " [getbuf: sysread($fh,$buf,4-$n,$n)=$rv: $!\n" + if ($debug & 4); + return $rv unless $rv > 0; + $n += $rv; + } + + # size is encoded in network byte order + my ($bsz) = unpack('N', $buf); + print STDERR " [getbuf: cipher buffer sz=$bsz]\n" if ($debug & 4); + return undef unless ($bsz <= $self->{rcvbufsz}); + + # next, read actual cipher text + $buf = ''; + $n = 0; + while ($n < $bsz) { + my $rv = sysread($fh, $buf, $bsz - $n, $n); + print STDERR " [getbuf: got o=$n,n=", $bsz - $n, ",rv=$rv,bl=" . length($buf) . "]\n" + if ($debug & 4); + return $rv unless $rv > 0; + $n += $rv; + } + + # call mechanism specific decoding routine + $self->{readbuf} = $self->{conn}->decode($buf, $bsz); + $n = length($self->{readbuf}); + print STDERR " [getbuf: clear text buffer sz=$n]\n" if ($debug & 4); + $self->{readbuflen} = $n; + } + + + # Encrypting a write() to a filehandle is much easier than reading, because + # all the data to be encrypted is immediately available + sub WRITE { + my ($self, undef, $len, $offset) = @_; + my $debug = $self->{conn}->{debug}; + + my $fh = $self->{fh}; + + # put on wire in peer-sized chunks + my $bsz = $self->{sndbufsz}; + while ($len > 0) { + print STDERR " [WRITE: chunk $bsz/$len]\n" + if ($debug & 8); + + # call mechanism specific encoding routine + my $x = $self->{conn}->encode(substr($_[1], $offset || 0, $bsz)); + print $fh pack('N', length($x)), $x; + $len -= $bsz; + $offset += $bsz; + } + + return $_[2]; + } + +} + +1; diff --git a/lib/Authen/SASL/Perl.pod b/lib/Authen/SASL/Perl.pod new file mode 100644 index 0000000..bb0b451 --- /dev/null +++ b/lib/Authen/SASL/Perl.pod @@ -0,0 +1,154 @@ +# Copyright (c) 2004 Peter Marschall . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +=head1 NAME + +Authen::SASL::Perl -- Perl implementation of the SASL Authentication framework + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'CRAM-MD5 PLAIN ANONYMOUS', + callback => { + user => $user, + pass => \&fetch_password + } + ); + +=head1 DESCRIPTION + +B is the pure Perl implementation of SASL mechanisms +in the B framework. + +At the time of this writing it provides the client part implementation +for the following SASL mechanisms: + +=over 4 + +=item ANONYMOUS + +The Anonymous SASL Mechanism as defined in RFC 2245 resp. +in IETF Draft draft-ietf-sasl-anon-03.txt from February 2004 +provides a method to anonymously access internet services. + +Since it does no authentication it does not need to send +any confidential information such as passwords in plain text +over the network. + + +=item CRAM-MD5 + +The CRAM-MD5 SASL Mechanism as defined in RFC2195 resp. +in IETF Draft draft-ietf-sasl-crammd5-XX.txt +offers a simple challenge-response authentication mechanism. + +Since it is a challenge-response authentication mechanism +no passwords are transferred in clear-text over the wire. + +Due to the simplicity of the protocol CRAM-MD5 is susceptible +to replay and dictionary attacks, so DIGEST-MD5 should be used +in preferrence. + + +=item DIGEST-MD5 + +The DIGEST-MD5 SASL Mechanism as defined in RFC 2831 resp. +in IETF Draft draft-ietf-sasl-rfc2831bis-XX.txt +offers the HTTP Digest Access Authentication as SASL mechanism. + +Like CRAM-MD5 it is a challenge-response authentication +method that does not send plain text passwords over the network. + +Compared to CRAM-MD5, DIGEST-MD5 prevents chosen plaintext +attacks, and permits the use of third party authentication servers, +so that it is recommended to use DIGEST-MD5 instead of CRAM-MD5 +when possible. + + +=item EXTERNAL + +The EXTERNAL SASL mechanism as defined in RFC 2222 +allows the use of external authentication systems as SASL mechanisms. + + +=item GSSAPI + +The GSSAPI SASL mechanism as defined in RFC 2222 resp. IETF Draft +draft-ietf-sasl-gssapi-XX.txt allows using the Generic Security Service +Application Program Interface [GSSAPI] KERBEROS V5 as as SASL mechanism. + +Although GSSAPI is a general mechanism for authentication it is almost +exlusively used for Kerberos 5. + + +=item LOGIN + +The LOGIN SASL Mechanism as defined in IETF Draft +draft-murchison-sasl-login-XX.txt allows the +combination of username and clear-text password to be used +in a SASL mechanism. + +It does does not provide a security layer and sends the credentials +in clear over the wire. +Thus this mechanism should not be used without adequate security +protection. + + +=item PLAIN + +The Plain SASL Mechanism as defined in RFC 2595 resp. IETF Draft +draft-ietf-sasl-plain-XX.txt is another SASL mechanism that allows +username and clear-text password combinations in SASL environments. + +Like LOGIN it sends the credentials in clear over the network +and should not be used without sufficient security protection. + +=back + +As for server support, only I, I and I are supported +at the time of this writing. + +C OPTIONS is a hashref that is only relevant for I for +now and it supports the following options: + +=over 4 + +=item - no_integrity + +=item - no_confidentiality + +=back + +which configures how the security layers are negotiated with the client (or +rather imposed to the client). + + +=head1 SEE ALSO + +L, +L, +L, +L, +L, +L, +L, +L + +=head1 AUTHOR + +Peter Marschall + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 2004-2006 Peter Marschall. +All rights reserved. This document is distributed, and may be redistributed, +under the same terms as Perl itself. + +=cut + diff --git a/lib/Authen/SASL/Perl/ANONYMOUS.pm b/lib/Authen/SASL/Perl/ANONYMOUS.pm new file mode 100644 index 0000000..7bb8c00 --- /dev/null +++ b/lib/Authen/SASL/Perl/ANONYMOUS.pm @@ -0,0 +1,93 @@ +# Copyright (c) 2002 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package Authen::SASL::Perl::ANONYMOUS; + +use strict; +use vars qw($VERSION @ISA); + +$VERSION = "2.14"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noplaintext => 1, +); + +sub _order { 0 } +sub _secflags { + shift; + grep { $secflags{$_} } @_; +} + +sub mechanism { 'ANONYMOUS' } + +sub client_start { + shift->_call('authname') +} + +sub client_step { + shift->_call('authname') +} + +1; + +__END__ + +=head1 NAME + +Authen::SASL::Perl::ANONYMOUS - Anonymous Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'ANONYMOUS', + callback => { + authname => $mailaddress + }, + ); + +=head1 DESCRIPTION + +This method implements the client part of the ANONYMOUS SASL algorithm, +as described in RFC 2245 resp. in IETF Draft draft-ietf-sasl-anon-XX.txt. + +=head2 CALLBACK + +The callbacks used are: + +=over 4 + +=item authname + +email address or UTF-8 encoded string to be used as +trace information for the server + +=back + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Software written by Graham Barr , +documentation written by Peter Marschall . + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 2002-2004 Graham Barr. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +Documentation Copyright (c) 2004 Peter Marschall. +All rights reserved. This documentation is distributed, +and may be redistributed, under the same terms as Perl itself. + +=cut diff --git a/lib/Authen/SASL/Perl/CRAM_MD5.pm b/lib/Authen/SASL/Perl/CRAM_MD5.pm new file mode 100644 index 0000000..84db3a0 --- /dev/null +++ b/lib/Authen/SASL/Perl/CRAM_MD5.pm @@ -0,0 +1,105 @@ +# Copyright (c) 2002 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package Authen::SASL::Perl::CRAM_MD5; + +use strict; +use vars qw($VERSION @ISA); +use Digest::HMAC_MD5 qw(hmac_md5_hex); + +$VERSION = "2.14"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noplaintext => 1, + noanonymous => 1, +); + +sub _order { 2 } +sub _secflags { + shift; + scalar grep { $secflags{$_} } @_; +} + +sub mechanism { 'CRAM-MD5' } + +sub client_start { + ''; +} + +sub client_step { + my ($self, $string) = @_; + my ($user, $pass) = map { + my $v = $self->_call($_); + defined($v) ? $v : '' + } qw(user pass); + + $user . " " . hmac_md5_hex($string,$pass); +} + +1; + +__END__ + +=head1 NAME + +Authen::SASL::Perl::CRAM_MD5 - CRAM MD5 Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'CRAM-MD5', + callback => { + user => $user, + pass => $pass + }, + ); + +=head1 DESCRIPTION + +This method implements the client part of the CRAM-MD5 SASL algorithm, +as described in RFC 2195 resp. in IETF Draft draft-ietf-sasl-crammd5-XX.txt. + +=head2 CALLBACK + +The callbacks used are: + +=over 4 + +=item user + +The username to be used for authentication + +=item pass + +The user's password to be used for authentication + +=back + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Software written by Graham Barr , +documentation written by Peter Marschall . + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 2002-2004 Graham Barr. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +Documentation Copyright (c) 2004 Peter Marschall. +All rights reserved. This documentation is distributed, +and may be redistributed, under the same terms as Perl itself. + +=cut diff --git a/lib/Authen/SASL/Perl/DIGEST_MD5.pm b/lib/Authen/SASL/Perl/DIGEST_MD5.pm new file mode 100644 index 0000000..ca25b6e --- /dev/null +++ b/lib/Authen/SASL/Perl/DIGEST_MD5.pm @@ -0,0 +1,877 @@ +# Copyright (c) 2003-2009 Graham Barr, Djamel Boudjerda, Paul Connolly, Julian +# Onions, Nexor and Yann Kerherve. +# All rights reserved. This program is free software; you can redistribute +# it and/or modify it under the same terms as Perl itself. + +# See http://www.ietf.org/rfc/rfc2831.txt for details + +package Authen::SASL::Perl::DIGEST_MD5; + +use strict; +use vars qw($VERSION @ISA $CNONCE $NONCE); +use Digest::MD5 qw(md5_hex md5); +use Digest::HMAC_MD5 qw(hmac_md5); + +# TODO: complete qop support in server, should be configurable + +$VERSION = "2.14"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noplaintext => 1, + noanonymous => 1, +); + +# some have to be quoted - some don't - sigh! +my (%cqdval, %sqdval); +@cqdval{qw( + username authzid realm nonce cnonce digest-uri +)} = (); + +## ...and server behaves different than client - double sigh! +@sqdval{keys %cqdval, qw(qop cipher)} = (); +# username authzid realm nonce cnonce digest-uri qop cipher +#)} = (); + +my %multi; +@{$multi{server}}{qw(realm auth-param)} = (); +@{$multi{client}}{qw()} = (); + +my @server_required = qw(algorithm nonce); +my @client_required = qw(username nonce cnonce nc qop response); + +# available ciphers +my @ourciphers = ( + { + name => 'rc4', + ssf => 128, + bs => 1, + ks => 16, + pkg => 'Crypt::RC4', + key => sub { $_[0] }, + iv => sub {}, + fixup => sub { + # retrofit the Crypt::RC4 module with standard subs + *Crypt::RC4::encrypt = *Crypt::RC4::decrypt = + sub { goto &Crypt::RC4::RC4; }; + *Crypt::RC4::keysize = sub {128}; + *Crypt::RC4::blocksize = sub {1}; + } + }, + { + name => '3des', + ssf => 112, + bs => 8, + ks => 16, + pkg => 'Crypt::DES3', + key => sub { + pack('B8' x 16, + map { $_ . '0' } + map { unpack('a7' x 16, $_); } + unpack('B*', substr($_[0], 0, 14)) ); + }, + iv => sub { substr($_[0], -8, 8) }, + }, + { + name => 'des', + ssf => 56, + bs => 8, + ks => 16, + pkg => 'Crypt::DES', + key => sub { + pack('B8' x 8, + map { $_ . '0' } + map { unpack('a7' x 8, $_); } + unpack('B*',substr($_[0], 0, 7)) ); + }, + iv => sub { substr($_[0], -8, 8) }, + }, + { + name => 'rc4-56', + ssf => 56, + bs => 1, + ks => 7, + pkg => 'Crypt::RC4', + key => sub { $_[0] }, + iv => sub {}, + fixup => sub { + *Crypt::RC4::encrypt = *Crypt::RC4::decrypt = + sub { goto &Crypt::RC4::RC4; }; + *Crypt::RC4::keysize = sub {56}; + *Crypt::RC4::blocksize = sub {1}; + } + }, + { + name => 'rc4-40', + ssf => 40, + bs => 1, + ks => 5, + pkg => 'Crypt::RC4', + key => sub { $_[0] }, + iv => sub {}, + fixup => sub { + *Crypt::RC4::encrypt = *Crypt::RC4::decrypt = + sub { goto &Crypt::RC4::RC4; }; + *Crypt::RC4::keysize = sub {40}; + *Crypt::RC4::blocksize = sub {1}; + } + }, +); + +## The system we are on, might not be able to crypt the stream +our $NO_CRYPT_AVAILABLE = 1; +for (@ourciphers) { + eval "require $_->{pkg}"; + unless ($@) { + $NO_CRYPT_AVAILABLE = 0; + last; + } +} + +sub _order { 3 } +sub _secflags { + shift; + scalar grep { $secflags{$_} } @_; +} + +sub mechanism { 'DIGEST-MD5' } + +sub _init { + my ($pkg, $self) = @_; + bless $self, $pkg; + + # set default security properties + $self->property('minssf', 0); + $self->property('maxssf', int 2**31 - 1); # XXX - arbitrary "high" value + $self->property('maxbuf', 0xFFFFFF); # maximum supported by GSSAPI mech + $self->property('externalssf', 0); + + $self; +} + +sub _init_server { + my $server = shift; + my $options = shift || {}; + if (!ref $options or ref $options ne 'HASH') { + warn "options for DIGEST_MD5 should be a hashref"; + $options = {}; + } + + ## new server, means new nonce_counts + $server->{nonce_counts} = {}; + + ## determine supported qop + my @qop = ('auth'); + push @qop, 'auth-int' unless $options->{no_integrity}; + push @qop, 'auth-conf' unless $options->{no_integrity} + or $options->{no_confidentiality} + or $NO_CRYPT_AVAILABLE; + + $server->{supported_qop} = { map { $_ => 1 } @qop }; +} + +sub init_sec_layer { + my $self = shift; + $self->{cipher} = undef; + $self->{khc} = undef; + $self->{khs} = undef; + $self->{sndseqnum} = 0; + $self->{rcvseqnum} = 0; + + # reset properties for new session + $self->property(maxout => undef); + $self->property(ssf => undef); +} + +# no initial value passed to the server +sub client_start { + my $self = shift; + + $self->{need_step} = 1; + $self->{error} = undef; + $self->{state} = 0; + $self->init_sec_layer; + ''; +} + +sub server_start { + my $self = shift; + my $challenge = shift; + my $cb = shift || sub {}; + + $self->{need_step} = 1; + $self->{error} = undef; + $self->{nonce} = md5_hex($NONCE || join (":", $$, time, rand)); + + $self->init_sec_layer; + + my $qop = [ sort keys %{$self->{supported_qop}} ]; + + ## get the realm using callbacks but default to the host specified + ## during the instanciation of the SASL object + my $realm = $self->_call('realm'); + $realm ||= $self->host; + + my %response = ( + nonce => $self->{nonce}, + charset => 'utf-8', + algorithm => 'md5-sess', + realm => $realm, + maxbuf => $self->property('maxbuf'), + +## IN DRAFT ONLY: +# If this directive is present multiple times the client MUST treat +# it as if it received a single qop directive containing a comma +# separated value from all instances. I.e., +# 'qop="auth",qop="auth-int"' is the same as 'qop="auth,auth-int" + + 'qop' => $qop, + 'cipher' => [ map { $_->{name} } @ourciphers ], + ); + my $final_response = _response(\%response); + $cb->($final_response); + return; +} + +sub client_step { # $self, $server_sasl_credentials + my ($self, $challenge) = @_; + $self->{server_params} = \my %sparams; + + # Parse response parameters + $self->_parse_challenge(\$challenge, server => $self->{server_params}) + or return $self->set_error("Bad challenge: '$challenge'"); + + if ($self->{state} == 1) { + # check server's `rspauth' response + return $self->set_error("Server did not send rspauth in step 2") + unless ($sparams{rspauth}); + return $self->set_error("Invalid rspauth in step 2") + unless ($self->{rspauth} eq $sparams{rspauth}); + + # all is well + $self->set_success; + return ''; + } + + # check required fields in server challenge + if (my @missing = grep { !exists $sparams{$_} } @server_required) { + return $self->set_error("Server did not provide required field(s): @missing") + } + + my %response = ( + nonce => $sparams{'nonce'}, + cnonce => md5_hex($CNONCE || join (":", $$, time, rand)), + 'digest-uri' => $self->service . '/' . $self->host, + # calc how often the server nonce has been seen; server expects "00000001" + nc => sprintf("%08d", ++$self->{nonce_counts}{$sparams{'nonce'}}), + charset => $sparams{'charset'}, + ); + + return $self->set_error("Server qop too weak (qop = $sparams{'qop'})") + unless ($self->_client_layer(\%sparams,\%response)); + + # let caller-provided fields override defaults: authorization ID, service name, realm + + my $s_realm = $sparams{realm} || []; + my $realm = $self->_call('realm', @$s_realm); + unless (defined $realm) { + # If the user does not pick a realm, use the first from the server + $realm = $s_realm->[0]; + } + if (defined $realm) { + $response{realm} = $realm; + } + + my $authzid = $self->_call('authname'); + if (defined $authzid) { + $response{authzid} = $authzid; + } + + my $serv_name = $self->_call('serv'); + if (defined $serv_name) { + $response{'digest-uri'} .= '/' . $serv_name; + } + + my $user = $self->_call('user'); + return $self->set_error("Username is required") + unless defined $user; + $response{username} = $user; + + my $password = $self->_call('pass'); + return $self->set_error("Password is required") + unless defined $password; + + $self->property('maxout', $sparams{maxbuf} || 65536); + + # Generate the response value + $self->{state} = 1; + + my ($response, $rspauth) + = $self->_compute_digests_and_set_keys($password, \%response); + + $response{response} = $response; + $self->{rspauth} = $rspauth; + + # finally, return our response token + return _response(\%response, "is_client"); +} + +sub _compute_digests_and_set_keys { + my $self = shift; + my $password = shift; + my $params = shift; + + if (defined $params->{realm} and ref $params->{realm} eq 'ARRAY') { + $params->{realm} = $params->{realm}[0]; + } + + my $realm = $params->{realm}; + $realm = "" unless defined $realm; + + my $A1 = join (":", + md5(join (":", $params->{username}, $realm, $password)), + @$params{defined($params->{authzid}) + ? qw(nonce cnonce authzid) + : qw(nonce cnonce) + } + ); + + # pre-compute MD5(A1) and HEX(MD5(A1)); these are used multiple times below + my $hdA1 = unpack("H*", (my $dA1 = md5($A1)) ); + + # derive keys for layer encryption / integrity + $self->{kic} = md5($dA1, + 'Digest session key to client-to-server signing key magic constant'); + + $self->{kis} = md5($dA1, + 'Digest session key to server-to-client signing key magic constant'); + + if (my $cipher = $self->{cipher}) { + &{ $cipher->{fixup} || sub{} }; + + # compute keys for encryption + my $ks = $cipher->{ks}; + $self->{kcc} = md5(substr($dA1,0,$ks), + 'Digest H(A1) to client-to-server sealing key magic constant'); + $self->{kcs} = md5(substr($dA1,0,$ks), + 'Digest H(A1) to server-to-client sealing key magic constant'); + + # get an encryption and decryption handle for the chosen cipher + $self->{khc} = $cipher->{pkg}->new($cipher->{key}->($self->{kcc})); + $self->{khs} = $cipher->{pkg}->new($cipher->{key}->($self->{kcs})); + + # initialize IVs + $self->{ivc} = $cipher->{iv}->($self->{kcc}); + $self->{ivs} = $cipher->{iv}->($self->{kcs}); + } + + my $A2 = "AUTHENTICATE:" . $params->{'digest-uri'}; + $A2 .= ":00000000000000000000000000000000" if ($params->{qop} ne 'auth'); + + my $response = md5_hex( + join (":", $hdA1, @$params{qw(nonce nc cnonce qop)}, md5_hex($A2)) + ); + + # calculate server `rspauth' response, so we can check in step 2 + # the only difference here is in the A2 string which from which + # `AUTHENTICATE' is omitted in the calculation of `rspauth' + $A2 = ":" . $params->{'digest-uri'}; + $A2 .= ":00000000000000000000000000000000" if ($params->{qop} ne 'auth'); + + my $rspauth = md5_hex( + join (":", $hdA1, @$params{qw(nonce nc cnonce qop)}, md5_hex($A2)) + ); + + return ($response, $rspauth); +} + +sub server_step { + my $self = shift; + my $challenge = shift; + my $cb = shift || sub {}; + + $self->{client_params} = \my %cparams; + unless ( $self->_parse_challenge(\$challenge, client => $self->{client_params}) ) { + $self->set_error("Bad challenge: '$challenge'"); + return $cb->(); + } + + # check required fields in server challenge + if (my @missing = grep { !exists $cparams{$_} } @client_required) { + $self->set_error("Client did not provide required field(s): @missing"); + return $cb->(); + } + + my $count = hex ($cparams{'nc'} || 0); + unless ($count == ++$self->{nonce_counts}{$cparams{nonce}}) { + $self->set_error("nonce-count doesn't match: $count"); + return $cb->(); + } + + my $qop = $cparams{'qop'} || "auth"; + unless ($self->is_qop_supported($qop)) { + $self->set_error("Client qop not supported (qop = '$qop')"); + return $cb->(); + } + + my $username = $cparams{'username'}; + unless ($username) { + $self->set_error("Client didn't provide a username"); + return $cb->(); + } + + # "The authzid MUST NOT be an empty string." + if (exists $cparams{authzid} && $cparams{authzid} eq '') { + $self->set_error("authzid cannot be empty"); + return $cb->(); + } + my $authzid = $cparams{authzid}; + + # digest-uri: "Servers SHOULD check that the supplied value is correct. + # This will detect accidental connection to the incorrect server, as well as + # some redirection attacks" + my $digest_uri = $cparams{'digest-uri'}; + my ($cservice, $chost, $cservname) = split '/', $digest_uri, 3; + if ($cservice ne $self->service or $chost ne $self->host) { + # XXX deal with serv_name + $self->set_error("Incorrect digest-uri"); + return $cb->(); + } + + unless (defined $self->callback('getsecret')) { + $self->set_error("a getsecret callback MUST be defined"); + $cb->(); + return; + } + + my $realm = $self->{client_params}->{'realm'}; + my $response_check = sub { + my $password = shift; + return $self->set_error("Cannot get the passord for $username") + unless defined $password; + + ## configure the security layer + $self->_server_layer($qop) + or return $self->set_error("Cannot negociate the security layer"); + + my ($expected, $rspauth) + = $self->_compute_digests_and_set_keys($password, $self->{client_params}); + + return $self->set_error("Incorrect response $self->{client_params}->{response} <> $expected") + unless $expected eq $self->{client_params}->{response}; + + my %response = ( + rspauth => $rspauth, + ); + + # I'm not entirely sure of what I am doing + $self->{answer}{$_} = $self->{client_params}->{$_} for qw/username authzid realm serv/; + + $self->set_success; + return _response(\%response); + }; + + $self->callback('getsecret')->( + $self, + { user => $username, realm => $realm, authzid => $authzid }, + sub { $cb->( $response_check->( shift ) ) }, + ); +} + +sub is_qop_supported { + my $self = shift; + my $qop = shift; + return $self->{supported_qop}{$qop}; +} + +sub _response { + my $response = shift; + my $is_client = shift; + + my @out; + for my $k (sort keys %$response) { + my $is_array = ref $response->{$k} && ref $response->{$k} eq 'ARRAY'; + my @values = $is_array ? @{$response->{$k}} : ($response->{$k}); + # Per spec, one way of doing it: multiple k=v + #push @out, [$k, $_] for @values; + # other way: comma separated list + push @out, [$k, join (',', @values)]; + } + return join (",", map { _qdval($_->[0], $_->[1], $is_client) } @out); +} + +sub _parse_challenge { + my $self = shift; + my $challenge_ref = shift; + my $type = shift; + my $params = shift; + + while($$challenge_ref =~ + s/^(?:\s*,)*\s* # remaining or crap + ([\w-]+) # key, eg: qop + = + ("([^\\"]+|\\.)*"|[^,]+) # value, eg: auth-conf or "NoNcE" + \s*(?:,\s*)* # remaining + //x) { + + my ($k, $v) = ($1,$2); + if ($v =~ /^"(.*)"$/s) { + ($v = $1) =~ s/\\(.)/$1/g; + } + if (exists $multi{$type}{$k}) { + my $aref = $params->{$k} ||= []; + push @$aref, $v; + } + elsif (defined $params->{$k}) { + return $self->set_error("Bad challenge: '$$challenge_ref'"); + } + else { + $params->{$k} = $v; + } + } + return length $$challenge_ref ? 0 : 1; +} + +sub _qdval { + my ($k, $v, $is_client) = @_; + + my $qdval = $is_client ? \%cqdval : \%sqdval; + + if (!defined $v) { + return; + } + elsif (exists $qdval->{$k}) { + $v =~ s/([\\"])/\\$1/g; + return qq{$k="$v"}; + } + + return "$k=$v"; +} + +sub _server_layer { + my ($self, $auth) = @_; + + # XXX dupe + # construct our qop mask + my $maxssf = $self->property('maxssf') - $self->property('externalssf'); + $maxssf = 0 if ($maxssf < 0); + my $minssf = $self->property('minssf') - $self->property('externalssf'); + $minssf = 0 if ($minssf < 0); + + return undef if ($maxssf < $minssf); # sanity check + + my $ciphers = [ map { $_->{name} } @ourciphers ]; + if (( $auth eq 'auth-conf') + and $self->_select_cipher($minssf, $maxssf, $ciphers )) { + $self->property('ssf', $self->{cipher}->{ssf}); + return 1; + } + if ($auth eq 'auth-int') { + $self->property('ssf', 1); + return 1; + } + if ($auth eq 'auth') { + $self->property('ssf', 0); + return 1; + } + + return undef; +} + +sub _client_layer { + my ($self, $sparams, $response) = @_; + + # construct server qop mask + # qop in server challenge is optional: if not there "auth" is assumed + my $smask = 0; + map { + m/^auth$/ and $smask |= 1; + m/^auth-int$/ and $smask |= 2; + m/^auth-conf$/ and $smask |= 4; + } split(/,/, $sparams->{qop}||'auth'); # XXX I think we might have a bug here bc. of LWS + + # construct our qop mask + my $cmask = 0; + my $maxssf = $self->property('maxssf') - $self->property('externalssf'); + $maxssf = 0 if ($maxssf < 0); + my $minssf = $self->property('minssf') - $self->property('externalssf'); + $minssf = 0 if ($minssf < 0); + + return undef if ($maxssf < $minssf); # sanity check + + # ssf values > 1 mean integrity and confidentiality + # ssf == 1 means integrity but no confidentiality + # ssf < 1 means neither integrity nor confidentiality + # no security layer can be had if buffer size is 0 + $cmask |= 1 if ($minssf < 1); + $cmask |= 2 if ($minssf <= 1 and $maxssf >= 1); + $cmask |= 4 if ($maxssf > 1); + + # find common bits + $cmask &= $smask; + + # parse server cipher options + my @sciphers = split(/,/, $sparams->{'cipher-opts'}||$sparams->{cipher}||''); + + if (($cmask & 4) and $self->_select_cipher($minssf,$maxssf,\@sciphers)) { + $response->{qop} = 'auth-conf'; + $response->{cipher} = $self->{cipher}->{name}; + $self->property('ssf', $self->{cipher}->{ssf}); + return 1; + } + if ($cmask & 2) { + $response->{qop} = 'auth-int'; + $self->property('ssf', 1); + return 1; + } + if ($cmask & 1) { + $response->{qop} = 'auth'; + $self->property('ssf', 0); + return 1; + } + + return undef; +} + +sub _select_cipher { + my ($self, $minssf, $maxssf, $ciphers) = @_; + + # compose a subset of candidate ciphers based on ssf and peer list + my @a = map { + my $c = $_; + (grep { $c->{name} eq $_ } @$ciphers and + $c->{ssf} >= $minssf and $c->{ssf} <= $maxssf) ? $_ : () + } @ourciphers; + + # from these, select the first one we can create an instance of + for (@a) { + next unless eval "require $_->{pkg}"; + $self->{cipher} = $_; + return 1; + } + + return 0; +} + +use Digest::HMAC_MD5 qw(hmac_md5); + +sub encode { # input: self, plaintext buffer,length (length not used here) + my $self = shift; + my $seqnum = pack('N', $self->{sndseqnum}++); + my $mac = substr(hmac_md5($seqnum . $_[0], $self->{kic}), 0, 10); + + # if integrity only, return concatenation of buffer, MAC, TYPE and SEQNUM + return $_[0] . $mac.pack('n',1) . $seqnum unless ($self->{khc}); + + # must encrypt, block ciphers need padding bytes + my $pad = ''; + my $bs = $self->{cipher}->{bs}; + if ($bs > 1) { + # padding is added in between BUF and MAC + my $n = $bs - ((length($_[0]) + 10) & ($bs - 1)); + $pad = chr($n) x $n; + } + + # XXX - for future AES cipher support, the currently used common _crypt() + # function probably wont do; we might to switch to per-cipher routines + # like so: + # return $self->{khc}->encrypt($_[0] . $pad . $mac) . pack('n', 1) . $seqnum; + return $self->_crypt(0, $_[0] . $pad . $mac) . pack('n', 1) . $seqnum; +} + +sub decode { # input: self, cipher buffer,length + my ($self, $buf, $len) = @_; + + return if ($len <= 16); + + # extract TYPE/SEQNUM from end of buffer + my ($type,$seqnum) = unpack('na[4]', substr($buf, -6, 6, '')); + + # decrypt remaining buffer, if necessary + if ($self->{khs}) { + # XXX - see remark above in encode() #$buf = $self->{khs}->decrypt($buf); + $buf = $self->_crypt(1, $buf); + } + return unless ($buf); + + # extract 10-byte MAC from the end of (decrypted) buffer + my ($mac) = unpack('a[10]', substr($buf, -10, 10, '')); + + if ($self->{khs} and $self->{cipher}->{bs} > 1) { + # remove padding + my $n = ord(substr($buf, -1, 1)); + substr($buf, -$n, $n, ''); + } + + # check the MAC + my $check = substr(hmac_md5($seqnum . $buf, $self->{kis}), 0, 10); + return if ($mac ne $check); + return if (unpack('N', $seqnum) != $self->{rcvseqnum}); + $self->{rcvseqnum}++; + + return $buf; +} + +sub _crypt { # input: op(decrypting=1/encrypting=0)), buffer + my ($self,$d) = (shift,shift); + my $bs = $self->{cipher}->{bs}; + + if ($bs <= 1) { + # stream cipher + return $d ? $self->{khs}->decrypt($_[0]) : $self->{khc}->encrypt($_[0]) + } + + # the remainder of this sub is for block ciphers + + # get current IV + my $piv = \$self->{$d ? 'ivs' : 'ivc'}; + my $iv = $$piv; + + my $result = join '', map { + my $x = $d + ? $iv ^ $self->{khs}->decrypt($_) + : $self->{khc}->encrypt($iv ^ $_); + $iv = $d ? $_ : $x; + $x; + } unpack("a$bs "x(int(length($_[0])/$bs)), $_[0]); + + # store current IV + $$piv = $iv; + return $result; +} + +1; + +__END__ + +=head1 NAME + +Authen::SASL::Perl::DIGEST_MD5 - Digest MD5 Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'DIGEST-MD5', + callback => { + user => $user, + pass => $pass, + serv => $serv + }, + ); + +=head1 DESCRIPTION + +This method implements the client and server parts of the DIGEST-MD5 SASL +algorithm, as described in RFC 2831. + +=head2 CALLBACK + +The callbacks used are: + +=head3 client + +=over 4 + +=item authname + +The authorization id to use after successful authentication + +=item user + +The username to be used in the response + +=item pass + +The password to be used to compute the response. + +=item serv + +The service name when authenticating to a replicated service + +=item realm + +The authentication realm when overriding the server-provided default. +If not given the server-provided value is used. + +The callback will be passed the list of realms that the server provided +in the initial response. + +=back + +=head3 server + +=over4 + +=item realm + +The default realm to provide to the client + +=item getsecret(username, realm, authzid) + +returns the password associated with C and C + +=back + +=head2 PROPERTIES + +The properties used are: + +=over 4 + +=item maxbuf + +The maximum buffer size for receiving cipher text + +=item minssf + +The minimum SSF value that should be provided by the SASL security layer. +The default is 0 + +=item maxssf + +The maximum SSF value that should be provided by the SASL security layer. +The default is 2**31 + +=item externalssf + +The SSF value provided by an underlying external security layer. +The default is 0 + +=item ssf + +The actual SSF value provided by the SASL security layer after the SASL +authentication phase has been completed. This value is read-only and set +by the implementation after the SASL authentication phase has been completed. + +=item maxout + +The maximum plaintext buffer size for sending data to the peer. +This value is set by the implementation after the SASL authentication +phase has been completed and a SASL security layer is in effect. + +=back + + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Graham Barr, Djamel Boudjerda (NEXOR), Paul Connolly, Julian Onions (NEXOR), +Yann Kerherve. + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 2003-2009 Graham Barr, Djamel Boudjerda, Paul Connolly, +Julian Onions, Nexor, Peter Marschall and Yann Kerherve. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +=cut diff --git a/lib/Authen/SASL/Perl/EXTERNAL.pm b/lib/Authen/SASL/Perl/EXTERNAL.pm new file mode 100644 index 0000000..1eeafbe --- /dev/null +++ b/lib/Authen/SASL/Perl/EXTERNAL.pm @@ -0,0 +1,97 @@ +# Copyright (c) 1998-2002 Graham Barr and 2001 Chris Ridd +# . All rights reserved. This program +# is free software; you can redistribute it and/or modify it under the +# same terms as Perl itself. + +package Authen::SASL::Perl::EXTERNAL; + +use strict; +use vars qw($VERSION @ISA); + +$VERSION = "2.14"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noplaintext => 1, + nodictionary => 1, + noanonymous => 1, +); + +sub _order { 2 } +sub _secflags { + shift; + grep { $secflags{$_} } @_; +} + +sub mechanism { 'EXTERNAL' } + +sub client_start { + my $self = shift; + my $v = $self->_call('user'); + defined($v) ? $v : '' +} + +#sub client_step { +# shift->_call('user'); +#} + +1; + +__END__ + +=head1 NAME + +Authen::SASL::Perl::EXTERNAL - External Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'EXTERNAL', + callback => { + user => $user + }, + ); + +=head1 DESCRIPTION + +This method implements the client part of the EXTERNAL SASL algorithm, +as described in RFC 2222. + +=head2 CALLBACK + +The callbacks used are: + +=over 4 + +=item user + +The username to be used for authentication + +=back + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Software written by Graham Barr , +documentation written by Peter Marschall . + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 1998-2004 Graham Barr. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +Documentation Copyright (c) 2004 Peter Marschall. +All rights reserved. This documentation is distributed, +and may be redistributed, under the same terms as Perl itself. + +=cut diff --git a/lib/Authen/SASL/Perl/GSSAPI.pm b/lib/Authen/SASL/Perl/GSSAPI.pm new file mode 100644 index 0000000..d2670fc --- /dev/null +++ b/lib/Authen/SASL/Perl/GSSAPI.pm @@ -0,0 +1,375 @@ +# Copyright (c) 2006 Simon Wilkinson +# All rights reserved. This program is free software; you can redistribute +# it and/or modify it under the same terms as Perl itself. + +package Authen::SASL::Perl::GSSAPI; + +use strict; + +use vars qw($VERSION @ISA); +use GSSAPI; + +$VERSION= "0.05"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noplaintext => 1, + noanonymous => 1, +); + +sub _order { 4 } +sub _secflags { + shift; + scalar grep { $secflags{$_} } @_; +} + +sub mechanism { 'GSSAPI' } + +sub _init { + my ($pkg, $self) = @_; + bless $self, $pkg; + + # set default security properties + $self->property('minssf', 0); + $self->property('maxssf', int 2**31 - 1); # XXX - arbitrary "high" value + $self->property('maxbuf', 0xFFFFFF); # maximum supported by GSSAPI mech + $self->property('externalssf', 0); + # the cyrus sasl library allows only one bit to be set in the + # layer selection mask in the client reply, we default to + # compatibility with that bug + $self->property('COMPAT_CYRUSLIB_REPLY_MASK_BUG', 1); + $self; +} + +sub client_start { + my $self = shift; + my $status; + my $principal = $self->service.'@'.$self->host; + + # GSSAPI::Name->import is the *constructor*, + # storing the new GSSAPI::Name into $target. + # GSSAPI::Name->import is not the standard + # import() method as used in Perl normally + my $target; + $status = GSSAPI::Name->import($target, $principal, gss_nt_service_name) + or return $self->set_error("GSSAPI Error : ".$status); + $self->{gss_name} = $target; + $self->{gss_ctx} = new GSSAPI::Context; + $self->{gss_state} = 0; + $self->{gss_layer} = undef; + my $cred = $self->_call('pass'); + $self->{gss_cred} = (ref($cred) && $cred->isa('GSSAPI::Cred')) ? $cred : GSS_C_NO_CREDENTIAL; + $self->{gss_mech} = $self->_call('gssmech') || gss_mech_krb5; + + # reset properties for new session + $self->property(maxout => undef); + $self->property(ssf => undef); + + return $self->client_step(''); +} + +sub client_step { + my ($self, $challenge) = @_; + my $debug = $self->{debug}; + + my $status; + + if ($self->{gss_state} == 0) { + my $outtok; + my $inflags = GSS_C_INTEG_FLAG | GSS_C_MUTUAL_FLAG;#todo:set according to ssf props + my $outflags; + $status = $self->{gss_ctx}->init($self->{gss_cred}, $self->{gss_name}, + $self->{gss_mech}, + $inflags, + 0, GSS_C_NO_CHANNEL_BINDINGS, $challenge, undef, + $outtok, $outflags, undef); + + print STDERR "state(0): ". + $status->generic_message.';'.$status->specific_message. + "; output token sz: ".length($outtok)."\n" + if ($debug & 1); + + if (GSSAPI::Status::GSS_ERROR($status->major)) { + return $self->set_error("GSSAPI Error (init): ".$status); + } + if ($status->major == GSS_S_COMPLETE) { + $self->{gss_state} = 1; + } + return $outtok; + } + 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. + print STDERR " state(1): challenge is EMPTY\n" + if ($debug and $challenge eq ''); + return '' if ($challenge eq ''); + + my $unwrapped; + $status = $self->{gss_ctx}->unwrap($challenge, $unwrapped, undef, undef) + or return $self->set_error("GSSAPI Error (unwrap challenge): ".$status); + + return $self->set_error("GSSAPI Error : invalid security layer token") + if (length($unwrapped) != 4); + + # the security layers the server supports: bitmask of + # 1 = no security layer, + # 2 = integrity protection, + # 4 = confidelity protection + # which is encoded in the first octet of the response; + # the remote maximum buffer size is encoded in the next three octets + # + my $layer = ord(substr($unwrapped, 0, 1, chr(0))); + my ($rsz) = unpack('N',$unwrapped); + + # get local receive buffer size + my $lsz = $self->property('maxbuf'); + + # choose security layer + my $choice = $self->_layer($layer,$rsz,$lsz); + return $self->set_error("GSSAPI Error: security too weak") unless $choice; + + $self->{gss_layer} = $choice; + + if ($choice > 1) { + # determine maximum plain text message size for peer's cipher buffer + my $psz; + $status = $self->{gss_ctx}->wrap_size_limit($choice & 4, 0, $rsz, $psz) + or return $self->set_error("GSSAPI Error (wrap size): ".$status); + return $self->set_error("GSSAPI wrap size = 0") unless ($psz); + $self->property(maxout => $psz); + # set SSF property; if we have just integrity protection SSF is set + # to 1. If we have confidentiality, SSF would be an estimate of the + # strength of the actual encryption ciphers in use which is not + # available through the GSSAPI interface; for now just set it to + # the lowest value that signifies confidentiality. + $self->property(ssf => (($choice & 4) ? 2 : 1)); + } else { + # our advertised buffer size should be 0 if no layer selected + $lsz = 0; + $self->property(ssf => 0); + } + + print STDERR "state(1): layermask $layer,rsz $rsz,lsz $lsz,choice $choice\n" + if ($debug & 1); + + my $message = pack('CCCC', $choice, + ($lsz >> 16)&0xff, ($lsz >> 8)&0xff, $lsz&0xff); + + # append authorization identity if we have one + my $authz = $self->_call('authname'); + $message .= $authz if ($authz); + + my $outtok; + $status = $self->{gss_ctx}->wrap(0, 0, $message, undef, $outtok) + or return $self->set_error("GSSAPI Error (wrap token): ".$status); + + $self->{gss_state} = 0; + return $outtok; + } +} + +# default layer selection +sub _layer { + my ($self, $theirmask, $rsz, $lsz) = @_; + my $maxssf = $self->property('maxssf') - $self->property('externalssf'); + $maxssf = 0 if ($maxssf < 0); + + my $minssf = $self->property('minssf') - $self->property('externalssf'); + $minssf = 0 if ($minssf < 0); + + return undef if ($maxssf < $minssf); # sanity check + + # ssf values > 1 mean integrity and confidentiality + # ssf == 1 means integrity but no confidentiality + # ssf < 1 means neither integrity nor confidentiality + # no security layer can be had if buffer size is 0 + my $ourmask = 0; + $ourmask |= 1 if ($minssf < 1); + $ourmask |= 2 if ($minssf <= 1 and $maxssf >= 1); + $ourmask |= 4 if ($maxssf > 1); + $ourmask &= 1 unless ($rsz and $lsz); + + # mask the bits they dont have + $ourmask &= $theirmask; + + return $ourmask unless $self->property('COMPAT_CYRUSLIB_REPLY_MASK_BUG'); + + # in cyrus sasl bug compat mode, select the highest bit set + return 4 if ($ourmask & 4); + return 2 if ($ourmask & 2); + return 1 if ($ourmask & 1); + return undef; +} + +sub encode { # input: self, plaintext buffer,length (length not used here) + my $self = shift; + my $wrapped; + my $status = $self->{gss_ctx}->wrap($self->{gss_layer} & 4, 0, $_[0], undef, $wrapped); + $self->set_error("GSSAPI Error (encode): " . $status), return + unless ($status); + return $wrapped; +} + +sub decode { # input: self, cipher buffer,length (length not used here) + my $self = shift; + my $unwrapped; + my $status = $self->{gss_ctx}->unwrap($_[0], $unwrapped, undef, undef); + $self->set_error("GSSAPI Error (decode): " . $status), return + unless ($status); + return $unwrapped; +} + +__END__ + +=head1 NAME + +Authen::SASL::Perl::GSSAPI - GSSAPI (Kerberosv5) Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( mechanism => 'GSSAPI' ); + + $sasl = Authen::SASL->new( mechanism => 'GSSAPI', + callback => { pass => $mycred }); + + $sasl->client_start( $service, $host ); + +=head1 DESCRIPTION + +This method implements the client part of the GSSAPI SASL algorithm, +as described in RFC 2222 section 7.2.1 resp. draft-ietf-sasl-gssapi-XX.txt. + +With a valid Kerberos 5 credentials cache (aka TGT) it allows +to connect to I@I given as the first two parameters +to Authen::SASL's client_start() method. Alternatively, a GSSAPI::Cred +object can be passed in via the Authen::SASL callback hash using +the `pass' key. + +Please note that this module does not currently implement a SASL +security layer following authentication. Unless the connection is +protected by other means, such as TLS, it will be vulnerable to +man-in-the-middle attacks. If security layers are required, then the +L GSSAPI module should be used instead. + +=head2 CALLBACK + +The callbacks used are: + +=over 4 + +=item authname + +The authorization identity to be used in SASL exchange + +=item gssmech + +The GSS mechanism to be used in the connection + +=item pass + +The GSS credentials to be used in the connection (optional) + +=back + + +=head1 EXAMPLE + + #! /usr/bin/perl -w + + use strict; + + use Net::LDAP 0.33; + use Authen::SASL 2.10; + + # -------- Adjust to your environment -------- + my $adhost = 'theserver.bla.net'; + my $ldap_base = 'dc=bla,dc=net'; + my $ldap_filter = '(&(sAMAccountName=BLAAGROL))'; + + my $sasl = Authen::SASL->new(mechanism => 'GSSAPI'); + my $ldap; + + eval { + $ldap = Net::LDAP->new($adhost, + onerror => 'die') + or die "Cannot connect to LDAP host '$adhost': '$@'"; + $ldap->bind(sasl => $sasl); + }; + + if ($@) { + chomp $@; + die "\nBind error : $@", + "\nDetailed SASL error: ", $sasl->error, + "\nTerminated"; + } + + print "\nLDAP bind() succeeded, working in authenticated state"; + + my $mesg = $ldap->search(base => $ldap_base, + filter => $ldap_filter); + + # -------- evaluate $mesg + +=head2 PROPERTIES + +The properties used are: + +=over 4 + +=item maxbuf + +The maximum buffer size for receiving cipher text + +=item minssf + +The minimum SSF value that should be provided by the SASL security layer. +The default is 0 + +=item maxssf + +The maximum SSF value that should be provided by the SASL security layer. +The default is 2**31 + +=item externalssf + +The SSF value provided by an underlying external security layer. +The default is 0 + +=item ssf + +The actual SSF value provided by the SASL security layer after the SASL +authentication phase has been completed. This value is read-only and set +by the implementation after the SASL authentication phase has been completed. + +=item maxout + +The maximum plaintext buffer size for sending data to the peer. +This value is set by the implementation after the SASL authentication +phase has been completed and a SASL security layer is in effect. + +=back + + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Written by Simon Wilkinson, with patches and extensions by Achim Grolms +and Peter Marschall. + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 2006 Simon Wilkinson, Achim Grolms and Peter Marschall. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +=cut diff --git a/lib/Authen/SASL/Perl/LOGIN.pm b/lib/Authen/SASL/Perl/LOGIN.pm new file mode 100644 index 0000000..f248b29 --- /dev/null +++ b/lib/Authen/SASL/Perl/LOGIN.pm @@ -0,0 +1,216 @@ +# Copyright (c) 2002 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package Authen::SASL::Perl::LOGIN; + +use strict; +use vars qw($VERSION @ISA); + +$VERSION = "2.14"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noanonymous => 1, +); + +sub _order { 1 } +sub _secflags { + shift; + scalar grep { $secflags{$_} } @_; +} + +sub mechanism { 'LOGIN' } + +sub client_start { + my $self = shift; + $self->{stage} = 0; + ''; +} + +sub client_step { + my ($self, $string) = @_; + + # XXX technically this is wrong. I might want to change that. + # spec say it's "staged" and that the content of the challenge doesn't + # matter + # actually, let's try + my $stage = ++$self->{stage}; + if ($stage == 1) { + return $self->_call('user'); + } + elsif ($stage == 2) { + return $self->_call('pass'); + } + elsif ($stage == 3) { + $self->set_success; + return; + } + else { + return $self->set_error("Invalid sequence"); + } +} + +sub server_start { + my $self = shift; + my $response = shift; + my $user_cb = shift || sub {}; + + $self->{answer} = {}; + $self->{stage} = 0; + $self->{need_step} = 1; + $self->{error} = undef; + $user_cb->('Username:'); + return; +} + +sub server_step { + my $self = shift; + my $response = shift; + my $user_cb = shift || sub {}; + + my $stage = ++$self->{stage}; + + if ($stage == 1) { + unless (defined $response) { + $self->set_error("Invalid sequence (empty username)"); + return $user_cb->(); + } + $self->{answer}{user} = $response; + return $user_cb->("Password:"); + } + elsif ($stage == 2) { + unless (defined $response) { + $self->set_error("Invalid sequence (empty pass)"); + return $user_cb->(); + } + $self->{answer}{pass} = $response; + } + else { + $self->set_error("Invalid sequence (end)"); + return $user_cb->(); + } + my $error = "Credentials don't match"; + my $answers = { user => $self->{answer}{user}, pass => $self->{answer}{pass} }; + if (my $checkpass = $self->{callback}{checkpass}) { + my $cb = sub { + my $result = shift; + unless ($result) { + $self->set_error($error); + } + else { + $self->set_success; + } + $user_cb->(); + }; + $checkpass->($self => $answers => $cb ); + return; + } + elsif (my $getsecret = $self->{callback}{getsecret}) { + my $cb = sub { + my $good_pass = shift; + if ($good_pass && $good_pass eq ($self->{answer}{pass} || "")) { + $self->set_success; + } + else { + $self->set_error($error); + } + $user_cb->(); + }; + $getsecret->($self => $answers => $cb ); + return; + } + else { + $self->set_error($error); + $user_cb->(); + } + return; +} + +1; + +__END__ + +=head1 NAME + +Authen::SASL::Perl::LOGIN - Login Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'LOGIN', + callback => { + user => $user, + pass => $pass + }, + ); + +=head1 DESCRIPTION + +This method implements the client and server part of the LOGIN SASL algorithm, +as described in IETF Draft draft-murchison-sasl-login-XX.txt. + +=head2 CALLBACK + +The callbacks used are: + +=head3 Client + +=over 4 + +=item user + +The username to be used for authentication + +=item pass + +The user's password to be used for authentication + +=back + +=head3 Server + +=over4 + +=item getsecret(username) + +returns the password associated with C + +=item checkpass(username, password) + +returns true and false depending on the validity of the credentials passed +in arguments. + +=back + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Software written by Graham Barr , +documentation written by Peter Marschall . +Server support by Yann Kerherve + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 2002-2004 Graham Barr. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +Documentation Copyright (c) 2004 Peter Marschall. +All rights reserved. This documentation is distributed, +and may be redistributed, under the same terms as Perl itself. + +Server support Copyright (c) 2009 Yann Kerherve. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +=cut diff --git a/lib/Authen/SASL/Perl/PLAIN.pm b/lib/Authen/SASL/Perl/PLAIN.pm new file mode 100644 index 0000000..31fed89 --- /dev/null +++ b/lib/Authen/SASL/Perl/PLAIN.pm @@ -0,0 +1,182 @@ +# Copyright (c) 2002 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package Authen::SASL::Perl::PLAIN; + +use strict; +use vars qw($VERSION @ISA); + +$VERSION = "2.14"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noanonymous => 1, +); + +my @tokens = qw(authname user pass); + +sub _order { 1 } +sub _secflags { + shift; + grep { $secflags{$_} } @_; +} + +sub mechanism { 'PLAIN' } + +sub client_start { + my $self = shift; + + $self->{error} = undef; + $self->{need_step} = 0; + + my @parts = map { + my $v = $self->_call($_); + defined($v) ? $v : '' + } @tokens; + + join("\0", @parts); +} + +sub server_start { + my $self = shift; + my $response = shift; + my $user_cb = shift || sub {}; + + $self->{error} = undef; + return $self->set_error("No response: Credentials don't match") + unless defined $response; + + my %parts; + @parts{@tokens} = split "\0", $response, scalar @tokens; + + + # I'm not entirely sure of what I am doing + $self->{answer}{$_} = $parts{$_} for qw/authname user/; + my $error = "Credentials don't match"; + + ## checkpass + if (my $checkpass = $self->callback('checkpass')) { + my $cb = sub { + my $result = shift; + unless ($result) { + $self->set_error($error); + } + else { + $self->set_success; + } + $user_cb->(); + }; + $checkpass->($self => { %parts } => $cb ); + return; + } + + ## getsecret + elsif (my $getsecret = $self->callback('getsecret')) { + my $cb = sub { + my $good_pass = shift; + if ($good_pass && $good_pass eq ($parts{pass} || "")) { + $self->set_success; + } + else { + $self->set_error($error); + } + $user_cb->(); + }; + $getsecret->( $self, { map { $_ => $parts{$_ } } qw/user authname/ }, $cb ); + return; + } + + ## error by default + else { + $self->set_error($error); + $user_cb->(); + } +} + +1; + +__END__ + +=head1 NAME + +Authen::SASL::Perl::PLAIN - Plain Login Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'PLAIN', + callback => { + user => $user, + pass => $pass + }, + ); + +=head1 DESCRIPTION + +This method implements the client and server part of the PLAIN SASL algorithm, +as described in RFC 2595 resp. IETF Draft draft-ietf-sasl-plain-XX.txt + +=head2 CALLBACK + +The callbacks used are: + +=head3 Client + +=over 4 + +=item authname + +The authorization id to use after successful authentication (client) + +=item user + +The username to be used for authentication (client) + +=item pass + +The user's password to be used for authentication. + +=back + +=head3 Server + +=over4 + +=item checkpass(username, password, realm) + +returns true and false depending on the validity of the credentials passed +in arguments. + +=back + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Software written by Graham Barr , +documentation written by Peter Marschall . + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 2002-2004 Graham Barr. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +Documentation Copyright (c) 2004 Peter Marschall. +All rights reserved. This documentation is distributed, +and may be redistributed, under the same terms as Perl itself. + +Server support Copyright (c) 2009 Yann Kerherve. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +=cut