This patch has some of the problems described at http://bugs.koha.org/cgi-bin/bugzilla3/show_bug.cgi?id=4256
especially destroying of ExtendedPatronAttributes without update turned on. It's also too large, since Net::LDAP would like like charm if only ldap directory is supplied as ldaps://ldap.example.com instead of just hostname. This let me to beleve that it's a simple diff between ByWaterSolutions version of Auth_with_ldap.pm and latest community edition, without any of fixes included in bug mentioned above. On Thu, May 13, 2010 at 05:02:43PM +0000, Ian Walls wrote: > --- > C4/Auth_with_ldap.pm | 136 > ++++++++++++++++++++++++++---------------- > Makefile.PL | 1 + > about.pl | 1 + > install_misc/debian.packages | 1 + > 4 files changed, 87 insertions(+), 52 deletions(-) > > diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm > index b25697c..3b4d3ad 100644 > --- a/C4/Auth_with_ldap.pm > +++ b/C4/Auth_with_ldap.pm > @@ -18,7 +18,7 @@ package C4::Auth_with_ldap; > # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. > > use strict; > -#use warnings; FIXME - Bug 2505 > +# use warnings; almost? > use Digest::MD5 qw(md5_base64); > > use C4::Debug; > @@ -58,7 +58,7 @@ my $prefhost = $ldap->{hostname} or die > ldapserver_error('hostname'); > my $base = $ldap->{base} or die ldapserver_error('base'); > $ldapname = $ldap->{user} ; > $ldappassword = $ldap->{pass} ; > -our %mapping = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of > || (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9 > +our %mapping = %{$ldap->{mapping}} or die ldapserver_error('mapping'); > my @mapkeys = keys %mapping; > $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total > ): ", join ' ', @mapkeys, "\n"; > @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys; > @@ -80,68 +80,101 @@ sub description ($) { > sub search_method { > my $db = shift or return; > my $userid = shift or return; > - my $uid_field = $mapping{userid}->{is} or die ldapserver_error("mapping > for 'userid'"); > - my $filter = Net::LDAP::Filter->new("$uid_field=$userid") or die > "Failed to create new Net::LDAP::Filter"; > - my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, > password=>$ldappassword); > - if ($res->code) { # connection refused > - warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') > . ": " . description($res); > - return 0; > - } > - my $search = $db->search( > + my $uid_field = $mapping{userid}->{is} or die > ldapserver_error("mapping for 'userid'"); > + my $filter = Net::LDAP::Filter->new("$uid_field=$userid") or die > "Failed to create new Net::LDAP::Filter"; > + > + my $search = $db->search( > base => $base, > - filter => $filter, > - # attrs => ['*'], > - ) or die "LDAP search failed to return object."; > - my $count = $search->count; > - if ($search->code > 0) { > - warn sprintf("LDAP Auth rejected : %s gets %d hits\n", > $filter->as_string, $count) . description($search); > - return 0; > - } > - if ($count != 1) { > - warn sprintf("LDAP Auth rejected : %s gets %d hits\n", > $filter->as_string, $count); > - return 0; > - } > + filter => $filter, > + # attrs => ['*'], > + ) or die "LDAP search failed to return object."; > + my $count = $search->count; > + if ($search->code > 0) { > + warn sprintf("LDAP Auth rejected : %s gets %d hits\n", > $filter->as_string, $count) . description($search); > + return 0; > + } > + if ($count != 1) { > + warn sprintf("LDAP Auth rejected : %s gets %d hits\n", > $filter->as_string, $count); > + return 0; > + } > return $search; > } > > -sub checkpw_ldap { > - my ($dbh, $userid, $password) = @_; > - my @hosts = split(',', $prefhost); > - my $db = Net::LDAP->new(\...@hosts); > - #$debug and $db->debug(5); > - my $userldapentry; > - if ( $ldap->{auth_by_bind} ) { > - my $principal_name = $ldap->{principal_name}; > - if ($principal_name and $principal_name =~ /\%/) { > +sub bind_to_ldap { > + my $db = shift; > + my $userid = shift; > + my $password = shift; > + my $res; #error code capture > + > + # if auth_by_bind, bind by the supplied userid and password > + if ($ldap->{auth_by_bind} ) { > + my $principal_name = $ldap->{principal_name}; > + if ($principal_name and $principal_name =~ /\%/) { > $principal_name = sprintf($principal_name,$userid); > - } else { > + } else { > $principal_name = $userid; > - } > - my $res = $db->bind( $principal_name, password => $password ); > - if ( $res->code ) { > - $debug and warn "LDAP bind failed as kohauser $principal_name: > ". description($res); > + } > + $res = $db->bind( $principal_name, password => $password ); > + if ($res->code ) { # connection refused > + warn "LDAP bind failed as kohauser $principal_name: ". > description($res); > return 0; > } > + # otherwise, if no ldap user or password, do an anonymous bind > + } elsif ($config{anonymous}) { > + $res = $db->bind; > + if ($res->code) { # connection refused > + warn "LDAP bind failed as ANONYMOUS: " . description($res); > + return 0; > + } > + # otherwise, bind by the userid supplied in checkpw_ldap (normally) > + } else { > + $res = $db->bind($ldapname, password => $ldappassword); > + if ($res->code) { # connection refused > + warn "LDAP bind failed as ldapuser $ldapname: " . > description($res); > + return 0; > + } > + } > + #return the now bound $db > + return $db; > +} > > - # FIXME dpavlin -- we really need $userldapentry leater on even if > using auth_by_bind! > - my $search = search_method($db, $userid) or return 0; # warnings are > in the sub > - $userldapentry = $search->shift_entry; > - > - } else { > - my $search = search_method($db, $userid) or return 0; # warnings > are in the sub > - $userldapentry = $search->shift_entry; > - my $cmpmesg = $db->compare( $userldapentry, > attr=>'userpassword', value => $password ); > - if ($cmpmesg->code != 6) { > - warn "LDAP Auth rejected : invalid password for user > '$userid'. " . description($cmpmesg); > - return 0; > - } > - } > +sub checkpw_ldap { > + my ($dbh, $userid, $password) = @_; > + my @hosts = split(',', $prefhost); > + my $db = Net::LDAP->new(\...@hosts) or die "$@"; > + > + # start TLS connection if configured. Uses TLS default settings only > + if ($ldap->{tls}) { > + my $tls_msg = $db->start_tls(); > + if ($tls_msg->code) { # TLS error > + warn "TLS connection rejected: " . description($tls_msg); > + return 0; > + } > + } > + > + # Bind to the ldap in the appropriate manner > + $db = bind_to_ldap($db, $userid, $password); > + > + # search for the userid > + my $search = search_method($db, $userid) or return 0; # warnings are > in the sub > > + # dump the ldap information into userldapentry for processing > + my $userldapentry = $search->shift_entry; > + > + # if we didn't bind to the userid supplied, we need to do a > password compare > + unless ($ldap->{auth_by_bind}) { > + my $cmpmesg = $db->compare( $userldapentry, attr=>'userpassword', > value => $password ); > + if ($cmpmesg->code != 6) { > + warn "LDAP Auth rejected : invalid password for user > '$userid'. " . description($cmpmesg); > + return 0; > + } > + } > + > # To get here, LDAP has accepted our user's login attempt. > # But we still have work to do. See perldoc below for detailed > breakdown. > > my (%borrower); > - my ($borrowernumber,$cardnumber,$local_userid,$savedpw) = > exists_local($userid); > + my ($borrowernumber,$cardnumber,$local_userid,$savedpw) = > exists_local($userid); > > if (( $borrowernumber and $config{update} ) or > (!$borrowernumber and $config{replicate}) ) { > @@ -155,7 +188,6 @@ sub checkpw_ldap { > ($cardnumber eq $c2) or warn "update_local returned cardnumber > '$c2' instead of '$cardnumber'"; > } else { # C1, D1 > # maybe update just the password? > - return(1, $cardnumber); # FIXME dpavlin -- don't destroy > ExtendedPatronAttributes > } > } elsif ($config{replicate}) { # A2, C2 > $borrowernumber = AddMember(%borrower) or die "AddMember failed"; > @@ -166,7 +198,6 @@ sub checkpw_ldap { > my @types = C4::Members::AttributeTypes::GetAttributeTypes(); > my @attributes = grep{my $key=$_; any{$_ eq $k...@types;} keys > %borrower; > my $extended_patron_attributes = > map{{code=>$_,value=>$borrower{$_...@attributes; > - my $extended_patron_attributes = [] unless > $extended_patron_attributes; > my @errors; > #Check before add > for (my $i; $i< scalar(@$extended_patron_attributes)-1;$i++) { > @@ -385,6 +416,7 @@ Example XML stanza for LDAP configuration in KOHA_CONF. > password comparison, e.g., to use > Active Directory --> > <principal_name>%...@my_domain.com</principal_name> > <!-- optional, for auth_by_bind: a printf > format to make userPrincipalName from koha userid --> > + <tls>0</tls> <!-- set to 1 to use Transport Layer Security > (TLS) --> > <mapping> <!-- match koha SQL field names to your LDAP > record field names --> > <firstname is="givenname" ></firstname> > <surname is="sn" ></surname> > diff --git a/Makefile.PL b/Makefile.PL > index c88d5ea..e4f6897 100644 > --- a/Makefile.PL > +++ b/Makefile.PL > @@ -570,6 +570,7 @@ WriteMakefile( > 'HTTP::OAI' => 3.20, > 'HTTP::Request::Common' => 1.26, > 'IPC::Cmd' => 0.46, > + 'IO::Socket::SSL' => 1.33, > 'JSON' => 2.07, # > Needed by admin/item_circulation_alerts.pl > 'LWP::Simple' => 1.41, > 'LWP::UserAgent' => 2.033, > diff --git a/about.pl b/about.pl > index 04a9675..ecdfdc2 100755 > --- a/about.pl > +++ b/about.pl > @@ -94,6 +94,7 @@ HTTP::OAI > HTTP::Request::Common > HTML::Scrubber > IPC::Cmd > +IO::Socket::SSL > JSON > LWP::Simple > LWP::UserAgent > diff --git a/install_misc/debian.packages b/install_misc/debian.packages > index 11dfeb4..23a1af6 100644 > --- a/install_misc/debian.packages > +++ b/install_misc/debian.packages > @@ -39,6 +39,7 @@ libidzebra-2.0-mod-grs-xml install > libidzebra-2.0-mod-text install > libidzebra-2.0-modules install > libimage-magick-perl install > +libio-socket-ssl-perl install > libjson-perl install > liblingua-ispell-perl install > liblingua-stem-perl install > -- > 1.5.6.5 > > _______________________________________________ > Koha-patches mailing list > Koha-patches@lists.koha.org > http://lists.koha.org/mailman/listinfo/koha-patches -- Dobrica Pavlinusic 2share!2flame dpav...@rot13.org Unix addict. Internet consultant. http://www.rot13.org/~dpavlin _______________________________________________ Koha-patches mailing list Koha-patches@lists.koha.org http://lists.koha.org/mailman/listinfo/koha-patches