X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FAuth_with_ldap.pm;h=296f4099eb43580a6313a7b2f420bbd660ce8979;hb=41a8005d1013815d312089c00e9e5464768e1332;hp=f3c1f7f39dd006298cc25f69e746f5eec8361748;hpb=239a5f76cb9082c0b7653e37449f5ea5a13ed3ad;p=srvgit diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index f3c1f7f39d..296f4099eb 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -4,38 +4,35 @@ package C4::Auth_with_ldap; # # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . -use strict; -#use warnings; FIXME - Bug 2505 -use Digest::MD5 qw(md5_base64); +use Modern::Perl; +use Carp; -use C4::Debug; use C4::Context; -use C4::Members qw(AddMember changepassword); -use C4::Members::Attributes; -use C4::Members::AttributeTypes; -use C4::Utils qw( :all ); +use C4::Members::Messaging; +use C4::Auth qw(checkpw_internal); +use Koha::Patrons; +use Koha::AuthUtils qw(hash_password); use List::MoreUtils qw( any ); use Net::LDAP; use Net::LDAP::Filter; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug); +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); BEGIN { require Exporter; - $VERSION = 3.07.00.049; # set the version for version checking @ISA = qw(Exporter); @EXPORT = qw( checkpw_ldap ); } @@ -52,20 +49,32 @@ sub ldapserver_error { } use vars qw($mapping @ldaphosts $base $ldapname $ldappassword); -my $context = C4::Context->new() or die 'C4::Context->new failed'; my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF}; +# since Bug 28278 we need to skip id in which generates additional hash level +if ( exists $ldap->{ldapserver} ) { + $ldap = $ldap->{ldapserver} or die ldapserver_error('id="ldapserver"'); +} 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 my @mapkeys = keys %mapping; -$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n"; +#warn "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n"; @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys; -$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n"; +#warn "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n"; + +my %categorycode_conversions; +my $default_categorycode; +if(defined $ldap->{categorycode_mapping}) { + $default_categorycode = $ldap->{categorycode_mapping}->{default}; + foreach my $cat (@{$ldap->{categorycode_mapping}->{categorycode}}) { + $categorycode_conversions{$cat->{value}} = $cat->{content}; + } +} my %config = ( - anonymous => ($ldapname and $ldappassword) ? 0 : 1, + anonymous => defined ($ldap->{anonymous_bind}) ? $ldap->{anonymous_bind} : 1, replicate => defined($ldap->{replicate}) ? $ldap->{replicate} : 1, # add from LDAP to Koha database for new user update => defined($ldap->{update} ) ? $ldap->{update} : 1, # update from LDAP to Koha database for existing user ); @@ -86,16 +95,18 @@ sub search_method { base => $base, filter => $filter, # attrs => ['*'], - ) or die "LDAP search failed to return object."; + ); + die "LDAP search failed to return object : " . $search->error if $search->code; + 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; - } + if ($count == 0) { + warn sprintf("LDAP Auth rejected : search with filter '%s' returns no hit\n", $filter->as_string); + return 0; + } return $search; } @@ -103,45 +114,89 @@ sub checkpw_ldap { my ($dbh, $userid, $password) = @_; my @hosts = split(',', $prefhost); my $db = Net::LDAP->new(\@hosts); - #$debug and $db->debug(5); + unless ( $db ) { + warn "LDAP connexion failed"; + return 0; + } + my $userldapentry; - if ( $ldap->{auth_by_bind} ) { - my $principal_name = $ldap->{principal_name}; - if ($principal_name and $principal_name =~ /\%/) { - $principal_name = sprintf($principal_name,$userid); - } else { - $principal_name = $userid; + + # first, LDAP authentication + if ( $ldap->{auth_by_bind} ) { + my $principal_name; + if ( $config{anonymous} ) { + + # Perform an anonymous bind + my $res = $db->bind; + if ( $res->code ) { + warn "Anonymous LDAP bind failed: " . description($res); + return 0; + } + + # Perform a LDAP search for the given username + my $search = search_method( $db, $userid ) + or return 0; # warnings are in the sub + $userldapentry = $search->shift_entry; + $principal_name = $userldapentry->dn; } - my $res = $db->bind( $principal_name, password => $password ); - if ( $res->code ) { - $debug and warn "LDAP bind failed as kohauser $principal_name: ". description($res); - return 0; + else { + $principal_name = $ldap->{principal_name}; + if ( $principal_name and $principal_name =~ /\%/ ) { + $principal_name = sprintf( $principal_name, $userid ); + } + else { + $principal_name = $userid; + } } - # FIXME dpavlin -- we really need $userldapentry leater on even if using auth_by_bind! - - # BUG #5094 - # 2010-08-04 JeremyC - # a $userldapentry is only needed if either updating or replicating are enabled - if($config{update} or $config{replicate}) { - my $search = search_method($db, $userid) or return 0; # warnings are in the sub - $userldapentry = $search->shift_entry; - } - - } else { - my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword); + # Perform a LDAP bind for the given username using the matched DN + my $res = $db->bind( $principal_name, password => $password ); + if ( $res->code ) { + if ( $config{anonymous} ) { + # With anonymous_bind approach we can be sure we have found the correct user + # and that any 'code' response indicates a 'bad' user (be that blocked, banned + # or password changed). We should not fall back to local accounts in this case. + warn "LDAP bind failed as kohauser $userid: " . description($res); + return -1; + } else { + # Without a anonymous_bind, we cannot be sure we are looking at a valid ldap user + # at all, and thus we should fall back to local logins to restore previous behaviour + # see bug 12831 + warn "LDAP bind failed as kohauser $userid: " . description($res); + return 0; + } + } + if ( !defined($userldapentry) + && ( $config{update} or $config{replicate} ) ) + { + my $search = search_method( $db, $userid ) or return 0; + $userldapentry = $search->shift_entry; + } + } else { + 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 = 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; - } - } + # Handle multiple branches. Same login exists several times in different branches. + my $bind_ok = 0; + while (my $entry = $search->shift_entry) { + my $user_ldap_bind_ret = $db->bind($entry->dn, password => $password); + unless ($user_ldap_bind_ret->code) { + $userldapentry = $entry; + $bind_ok = 1; + last; + } + } + + unless ($bind_ok) { + warn "LDAP Auth rejected : invalid password for user '$userid'."; + return -1; + } + + + } # To get here, LDAP has accepted our user's login attempt. # But we still have work to do. See perldoc below for detailed breakdown. @@ -152,7 +207,7 @@ sub checkpw_ldap { if (( $borrowernumber and $config{update} ) or (!$borrowernumber and $config{replicate}) ) { %borrower = ldap_entry_2_hash($userldapentry,$userid); - $debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n"; + #warn "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n"; } if ($borrowernumber) { @@ -164,34 +219,39 @@ sub checkpw_ldap { return(1, $cardnumber, $local_userid); } } elsif ($config{replicate}) { # A2, C2 - $borrowernumber = AddMember(%borrower) or die "AddMember failed"; + my @columns = Koha::Patrons->columns; + my $patron = Koha::Patron->new( + { + map { exists( $borrower{$_} ) ? ( $_ => $borrower{$_} ) : () } @columns + } + )->store; + die "Insert of new patron failed" unless $patron; + $borrowernumber = $patron->borrowernumber; + C4::Members::Messaging::SetMessagingPreferencesFromDefaults( { borrowernumber => $borrowernumber, categorycode => $borrower{'categorycode'} } ); } else { return 0; # B2, D2 } - if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} ||$config{replicate})) { - my $extended_patron_attributes; - foreach my $attribute_type ( C4::Members::AttributeTypes::GetAttributeTypes() ) { - my $code = $attribute_type->{code}; - if ( exists($borrower{$code}) && $borrower{$code} !~ m/^\s*$/ ) { # skip empty values - push @$extended_patron_attributes, { code => $code, value => $borrower{$code} }; + if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} ||$config{replicate})) { + my $library_id = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef; + my $attribute_types = Koha::Patron::Attribute::Types->search_with_library_limits({}, {}, $library_id); + while ( my $attribute_type = $attribute_types->next ) { + my $code = $attribute_type->code; + unless (exists($borrower{$code}) && $borrower{$code} !~ m/^\s*$/ ) { + next; + } + my $patron = Koha::Patrons->find($borrowernumber); + if ( $patron ) { # Should not be needed, but we are in C4::Auth LDAP... + eval { + my $attribute = Koha::Patron::Attribute->new({code => $code, attribute => $borrower{$code}}); + $patron->extended_attributes([$attribute->unblessed]); + }; + if ($@) { # FIXME Test if Koha::Exceptions::Patron::Attribute::NonRepeatable + warn "ERROR_extended_unique_id_failed $code $borrower{$code}"; } + } } - my @errors; - #Check before add - for (my $i; $i< scalar(@$extended_patron_attributes)-1;$i++) { - my $attr=$extended_patron_attributes->[$i]; - unless (C4::Members::Attributes::CheckUniqueness($attr->{code}, $attr->{value}, $borrowernumber)) { - unshift @errors, $i; - warn "ERROR_extended_unique_id_failed $attr->{code} $attr->{value}"; - } - } - #Removing erroneous attributes - foreach my $index (@errors){ - @$extended_patron_attributes=splice(@$extended_patron_attributes,$index,1); - } - C4::Members::Attributes::SetBorrowerAttributes($borrowernumber, $extended_patron_attributes); - } -return(1, $cardnumber, $userid); + } + return(1, $cardnumber, $userid); } # Pass LDAP entry object and local cardnumber (userid). @@ -204,40 +264,43 @@ sub ldap_entry_2_hash { 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 STDERR "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump(); - foreach (keys %$userldapentry) { - print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n"; - hashdump("LDAP key: ",$userldapentry->{$_}); - } - } + #foreach (keys %$userldapentry) { + # print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n"; + #} my $x = $userldapentry->{attrs} or return; foreach (keys %$x) { $memberhash{$_} = join ' ', @{$x->{$_}}; - $debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n"; + #warn sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n"; } - $debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n", - "Referencing \%mapping with ", scalar(keys %mapping), " keys\n"; + #warn "Finished \%memberhash has ", scalar(keys %memberhash), " keys\n", "Referencing \%mapping with ", scalar(keys %mapping), " keys\n"; foreach my $key (keys %mapping) { my $data = $memberhash{ lc($mapping{$key}->{is}) }; # Net::LDAP returns all names in lowercase - $debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data; + #warn "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data; unless (defined $data) { - $data = $mapping{$key}->{content} || ''; # default or failsafe '' + $data = $mapping{$key}->{content} || undef; } - $borrower{$key} = ($data ne '') ? $data : ' ' ; + $borrower{$key} = $data; } $borrower{initials} = $memberhash{initials} || ( substr($borrower{'firstname'},0,1) . substr($borrower{ 'surname' },0,1) . " "); + # categorycode conversions + if(defined $categorycode_conversions{$borrower{categorycode}}) { + $borrower{categorycode} = $categorycode_conversions{$borrower{categorycode}}; + } + elsif($default_categorycode) { + $borrower{categorycode} = $default_categorycode; + } + # check if categorycode exists, if not, fallback to default from koha-conf.xml my $dbh = C4::Context->dbh; my $sth = $dbh->prepare("SELECT categorycode FROM categories WHERE categorycode = ?"); $sth->execute( uc($borrower{'categorycode'}) ); unless ( my $row = $sth->fetchrow_hashref ) { my $default = $mapping{'categorycode'}->{content}; - $debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid}; + #warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid}; $borrower{'categorycode'} = $default } @@ -251,55 +314,87 @@ sub exists_local { my $sth = $dbh->prepare("$select WHERE userid=?"); # was cardnumber=? $sth->execute($arg); - $debug and printf STDERR "Userid '$arg' exists_local? %s\n", $sth->rows; + #warn "Userid '$arg' exists_local? %s\n", $sth->rows; ($sth->rows == 1) and return $sth->fetchrow; $sth = $dbh->prepare("$select WHERE cardnumber=?"); $sth->execute($arg); - $debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows; + #warn "Cardnumber '$arg' exists_local? %s\n", $sth->rows; ($sth->rows == 1) and return $sth->fetchrow; return 0; } +# This function performs a password update, given the userid, borrowerid, +# and digested password. It will verify that things are correct and return the +# borrowers cardnumber. The idea is that it is used to keep the local +# passwords in sync with the LDAP passwords. +# +# $cardnum = _do_changepassword($userid, $borrowerid, $digest) +# +# Note: if the LDAP config has the update_password tag set to a false value, +# then this will not update the password, it will simply return the cardnumber. sub _do_changepassword { - my ($userid, $borrowerid, $digest) = @_; - $debug and print STDERR "changing local password for borrowernumber=$borrowerid to '$digest'\n"; - changepassword($userid, $borrowerid, $digest); - - # Confirm changes - my $sth = C4::Context->dbh->prepare("SELECT password,cardnumber FROM borrowers WHERE borrowernumber=? "); - $sth->execute($borrowerid); - if ($sth->rows) { - my ($md5password, $cardnum) = $sth->fetchrow; - ($digest eq $md5password) and return $cardnum; - warn "Password mismatch after update to cardnumber=$cardnum (borrowernumber=$borrowerid)"; - return; - } - die "Unexpected error after password update to userid/borrowernumber: $userid / $borrowerid."; + my ($userid, $borrowerid, $password) = @_; + + if ( exists( $ldap->{update_password} ) && !$ldap->{update_password} ) { + + # We don't store the password in the database + my $sth = C4::Context->dbh->prepare( + 'SELECT cardnumber FROM borrowers WHERE borrowernumber=?'); + $sth->execute($borrowerid); + die "Unable to access borrowernumber " + . "with userid=$userid, " + . "borrowernumber=$borrowerid" + if !$sth->rows; + my ($cardnum) = $sth->fetchrow; + $sth = C4::Context->dbh->prepare( + 'UPDATE borrowers SET password = null WHERE borrowernumber=?'); + $sth->execute($borrowerid); + return $cardnum; + } + + my $digest = hash_password($password); + #warn "changing local password for borrowernumber=$borrowerid to '$digest'\n"; + Koha::Patrons->find($borrowerid)->set_password({ password => $password, skip_validation => 1 }); + + my ($ok, $cardnum) = checkpw_internal(C4::Context->dbh, $userid, $password); + return $cardnum if $ok; + + warn "Password mismatch after update to borrowernumber=$borrowerid"; + return; } sub update_local { - my $userid = shift or return; - my $digest = md5_base64(shift) or return; - my $borrowerid = shift or return; - my $borrower = shift or return; - my @keys = keys %$borrower; - my $dbh = C4::Context->dbh; - my $query = "UPDATE borrowers\nSET " . - join(',', map {"$_=?"} @keys) . - "\nWHERE borrowernumber=? "; - my $sth = $dbh->prepare($query); - if ($debug) { - print STDERR $query, "\n", - join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys; - print STDERR "\nuserid = $userid\n"; - } - $sth->execute( - ((map {$borrower->{$_}} @keys), $borrowerid) - ); + my $userid = shift or croak "No userid"; + my $password = shift or croak "No password"; + my $borrowerid = shift or croak "No borrowerid"; + my $borrower = shift or croak "No borrower record"; + + # skip extended patron attributes in 'borrowers' attribute update + my @keys = keys %$borrower; + if (C4::Context->preference('ExtendedPatronAttributes')) { + my $library_id = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef; + my $attribute_types = Koha::Patron::Attribute::Types->search_with_library_limits({}, {}, $library_id); + while ( my $attribute_type = $attribute_types->next ) { + my $code = $attribute_type->code; + @keys = grep { $_ ne $code } @keys; + #warn "ignoring extended patron attribute '%s' in update_local()\n", $code; + } + } - # MODIFY PASSWORD/LOGIN - _do_changepassword($userid, $borrowerid, $digest); + my $dbh = C4::Context->dbh; + my $query = "UPDATE borrowers\nSET " . + join(',', map {"$_=?"} @keys) . + "\nWHERE borrowernumber=? "; + my $sth = $dbh->prepare($query); + #warn $query, "\n", join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys; + #warn "\nuserid = $userid\n"; + $sth->execute( + ((map {$borrower->{$_}} @keys), $borrowerid) + ); + + # MODIFY PASSWORD/LOGIN if password was mapped + _do_changepassword($userid, $borrowerid, $password) if exists( $borrower->{'password'} ); } 1; @@ -374,7 +469,6 @@ C4::Auth - Authenticates Koha users | contactname | mediumtext | YES | | NULL | | | contactfirstname | text | YES | | NULL | | | contacttitle | text | YES | | NULL | | - | guarantorid | int(11) | YES | MUL | NULL | | | borrowernotes | mediumtext | YES | | NULL | | | relationship | varchar(100) | YES | | NULL | | | ethnicity | varchar(50) | YES | | NULL | | @@ -419,8 +513,13 @@ Example XML stanza for LDAP configuration in KOHA_CONF. 1 0 + 0 %s@my_domain.com - + + 1 @@ -478,6 +577,14 @@ attribute that the server allows to be used for binding could be used. Currently, principal_name only operates when auth_by_bind is enabled. +=head2 update_password + +If this tag is left out or set to a true value, then the user's LDAP password +will be stored (hashed) in the local Koha database. If you don't want this +to happen, then set the value of this to '0'. Note that if passwords are not +stored locally, and the connection to the LDAP system fails, then the users +will not be able to log in at all. + =head2 Active Directory The auth_by_bind and principal_name settings are recommended for Active Directory.