diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index 2798da33d6..9c3e98743f 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -32,11 +32,11 @@ BEGIN { require Exporter; $VERSION = 3.01; # set the version for version checking $debug = $ENV{DEBUG} || 0; - @ISA = qw(Exporter C4::Auth); - @EXPORT = qw( checkpw ); + @ISA = qw(Exporter); + @EXPORT = qw( checkpw_ldap ); } -# Redefine checkpw: +# Redefine checkpw_ldap: # connect to LDAP (named or anonymous) # ~ retrieves $userid from "uid" # ~ then compares $password with userPassword @@ -73,13 +73,8 @@ sub description ($) { . "# " . $result->error_text . "\n"; } -sub checkpw { +sub checkpw_ldap { my ($dbh, $userid, $password) = @_; - if ( $userid eq C4::Context->config('user') - && $password eq C4::Context->config('pass') ) - { - return 2; # Koha superuser account - } my $db = Net::LDAP->new([$prefhost]); #$debug and $db->debug(5); my $filter = Net::LDAP::Filter->new("uid=$userid") or die "Failed to create new Net::LDAP::Filter"; @@ -113,8 +108,9 @@ sub checkpw { return 1; } my %borrower = ldap_entry_2_hash($userldapentry,$userid); - $debug and print "checkpw received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n"; - my ($borrowernumber,$cardnumber,$userid,$savedpw) = exists_local($userid); + $debug and print "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n"; + my ($borrowernumber,$cardnumber,$savedpw); + ($borrowernumber,$cardnumber,$userid,$savedpw) = exists_local($userid); if ($borrowernumber) { ($config{update} ) and my $c2 = &update_local($userid,$password,$borrowernumber,\%borrower) || ''; ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'"; @@ -133,8 +129,9 @@ sub ldap_entry_2_hash ($$) { my $userldapentry = shift; my %borrower = ( cardnumber => shift ); my %memberhash; + $userldapentry->exists('uid'); # This is bad, but required! By side-effect, this initializes the attrs hash. if ($debug) { - print "keys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump(); + print "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump(); foreach (keys %$userldapentry) { print "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n"; hashdump("LDAP key: ",$userldapentry->{$_}); @@ -144,13 +141,13 @@ sub ldap_entry_2_hash ($$) { my $key; foreach (keys %$x) { $memberhash{$_} = join ' ', @{$x->{$_}}; - $debug and print sprintf("building \$memberhash{%s} = ", $_), join ' ', @{$x->{$_}}, "\n"; + $debug and print sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n"; } $debug and print "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n", "Referencing \%mapping with ", scalar(keys %mapping), " keys\n"; foreach my $key (keys %mapping) { my $data = $memberhash{$mapping{$key}->{is}}; - $debug and printf "mapping %20s ==> %-20s ($data)\n", $key, $mapping{$key}->{is}; + $debug and printf "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data; unless (defined $data) { $data = $mapping{$key}->{content} || ''; # default or failsafe '' } @@ -166,7 +163,7 @@ sub ldap_entry_2_hash ($$) { sub exists_local($) { my $arg = shift; my $dbh = C4::Context->dbh; - my $select = "SELECT borrowernumber,cardnumber,userid,password from borrowers "; + my $select = "SELECT borrowernumber,cardnumber,userid,password FROM borrowers "; my $sth = $dbh->prepare("$select WHERE userid=?"); # was cardnumber=? $sth->execute($arg); @@ -185,19 +182,19 @@ sub update_local($$$$) { my $digest = md5_base64(shift) or return undef; my $borrowerid = shift or return undef; my $borrower = shift or return undef; + my @keys = keys %$borrower; my $dbh = C4::Context->dbh; my $query = "UPDATE borrowers\nSET " . - join(',', map {"$_=?"} keys %$borrower) . # don't need to sort: keys order is deterministic + join(',', map {"$_=?"} @keys) . "\nWHERE borrowernumber=? "; my $sth = $dbh->prepare($query); if ($debug) { print STDERR $query, "\n", - join "\n", map {"$_ = " . $borrower->{$_}} - keys %$borrower; + join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys; print STDERR "\nuserid = $userid\n"; } $sth->execute( - (map {$borrower->{$_}} keys %$borrower), $borrowerid # relies on deterministic keys order to match above + ((map {$borrower->{$_}} @keys), $borrowerid) ); # MODIFY PASSWORD/LOGIN diff --git a/t/Auth_with_ldap.t b/t/Auth_with_ldap.t index 9e8587bfe8..2f1874c725 100755 --- a/t/Auth_with_ldap.t +++ b/t/Auth_with_ldap.t @@ -17,14 +17,14 @@ BEGIN { ); plan tests => 7 + scalar(keys %cases); use_ok('C4::Context'); - use_ok('C4::Auth_with_ldap', qw(checkpw)); + use_ok('C4::Auth_with_ldap', qw(checkpw_ldap)); } -sub do_checkpw (;$$) { +sub do_checkpw_ldap (;$$) { my ($user,$pass) = (shift,shift); diag "($user,$pass)"; my $ret; - return ($ret = checkpw($dbh,$user,$pass), sprintf("(%s,%s) returns '%s'",$user,$pass,$ret)); + return ($ret = checkpw_ldap($dbh,$user,$pass), sprintf("(%s,%s) returns '%s'",$user,$pass,$ret)); } ok($context= C4::Context->new(), "Getting new C4::Context object"); @@ -34,12 +34,12 @@ ok($dbh = $context->dbh(), "Getting dbh from \$context object"); diag("The basis of Authentication is that we don't auth everybody."); diag("Let's make sure we reject on bad calls."); my $ret; -ok(!($ret = checkpw($dbh)), "should reject ( no arguments) returns '$ret'"); -ok(!($ret = checkpw($dbh,'','')), "should reject (empty arguments) returns '$ret'"); +ok(!($ret = checkpw_ldap($dbh)), "should reject ( no arguments) returns '$ret'"); +ok(!($ret = checkpw_ldap($dbh,'','')), "should reject (empty arguments) returns '$ret'"); print "\n"; diag("Now let's check " . scalar(keys %cases) . " test cases: "); foreach (sort keys %cases) { - ok do_checkpw($_, $cases{$_}); + ok do_checkpw_ldap($_, $cases{$_}); } 1;