From ebe649cbd56ff4df53b65c2c6aed99ab0774ddd1 Mon Sep 17 00:00:00 2001 From: Marc Chantreux Date: Tue, 30 Oct 2012 13:51:49 +0100 Subject: [PATCH] Bug 8993: LDAP authentication improvements 1) allow multiple branch authentication 2) allow to use a Perl module to transform ldap entry into a Koha borrower These improvements needs koha-conf.xml to be modified. However, the old authentication mechanism is still there, and if you do not change your configuration file, it must continue to work exactly the same way. There's a POD file describing new features C4/LDAPAuthMethodTutorial.pod --- C4/Auth_with_ldap.pm | 734 +++++++++++++++++++++++++++-------------- C4/LDAPAuthMethodTutorial.pod | 91 +++++ 2 files changed, 569 insertions(+), 256 deletions(-) create mode 100644 C4/LDAPAuthMethodTutorial.pod diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index 1f2f617..11ba426 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -1,5 +1,4 @@ package C4::Auth_with_ldap; - # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. @@ -17,10 +16,8 @@ package C4::Auth_with_ldap; # with Koha; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; use Digest::MD5 qw(md5_base64); - use C4::Debug; use C4::Context; use C4::Members qw(AddMember changepassword); @@ -30,34 +27,56 @@ use C4::Utils qw( :all ); use List::MoreUtils qw( any ); use Net::LDAP; use Net::LDAP::Filter; +use YAML; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug); BEGIN { - require Exporter; - $VERSION = 3.07.00.049; # set the version for version checking - @ISA = qw(Exporter); - @EXPORT = qw( checkpw_ldap ); + require Exporter; + $VERSION = 3.07.00.049; # set the version for version checking + @ISA = qw(Exporter); + @EXPORT = qw( checkpw_ldap ); +} + +# return the ref of the subroutine +sub load_subroutine { + require Package::Stash; + my ( $module, $sub ) = @_; + my $stash = Package::Stash->new($module); + unless ( %{ $stash->namespace } ) { + eval "require $module"; + $@ and die $@; + } + $stash->get_package_symbol('&'.$sub); } # Redefine checkpw_ldap: # connect to LDAP (named or anonymous) # ~ retrieves $userid from KOHA_CONF mapping -# ~ then compares $password with userPassword +# ~ then compares $password with userPassword # ~ then gets the LDAP entry # ~ and calls the memberadd if necessary sub ldapserver_error { - return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift); + return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift); } +sub debug_msg { $debug and say STDERR @_ } +sub logger { say STDERR YAML::Dump @_ } + use vars qw($mapping @ldaphosts $base $ldapname $ldappassword); -my $context = C4::Context->new() or die 'C4::Context->new failed'; +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}; -my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname'); -my $base = $ldap->{base} or die ldapserver_error('base'); -$ldapname = $ldap->{user} ; -$ldappassword = $ldap->{pass} ; + +my ( $prefhost, $base ) = ('')x2; +unless ( $$ldap{authmethod} ) { + say STDERR "deprecated ldap configuration, see documentation"; + $base = $$ldap{base} or die ldapserver_error('base'); + $prefhost = $$ldap{hostname} or die ldapserver_error('hostname'); +} + +$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"; @@ -65,107 +84,303 @@ $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n"; my %config = ( - anonymous => ($ldapname and $ldappassword) ? 0 : 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 + anonymous => ( $ldapname and $ldappassword ) ? 0 : 1, + # add from LDAP to Koha database for new user + replicate => defined( $ldap->{replicate} ) ? $ldap->{replicate} : 1, + # update from LDAP to Koha database for existing user + update => defined( $ldap->{update} ) ? $ldap->{update} : 1, ); sub description { - my $result = shift or return; - return "LDAP error #" . $result->code - . ": " . $result->error_name . "\n" - . "# " . $result->error_text . "\n"; + my $result = shift or return; + return "LDAP error #" . $result->code + . ": " . $result->error_name . "\n" + . "# " . $result->error_text . "\n"; } 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 $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; - } + 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 $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; + } return $search; } +# $cnx is an Net::LDAP object that dies when error occurs +# $search are params for the search method (default base is the one set in the config) +sub _anon_search { + my ( $cnx, $search ) = @_; + + my $entry; + for my $branch ( @{ $$ldap{branch} } ) { + debug_msg "search $$search{filter} at $$branch{dn}"; + + my $branch_search = { %$search, base => $$branch{dn}, search => "ObjectClass=*" }; + $entry = eval { + $cnx + ->search( %$branch_search ) + ->shift_entry + }; + + if ( $entry ) { + debug_msg "found ", $entry->dn; + return { entry => $entry, branch => $branch }; + } + elsif ( $@ ) { return { error => 'UNKNOWN', msg => $@ } } + else { $debug and logger { "failed search" => $branch_search } } + } +} + +sub set_xattr { + my ( $id, $borrower ) = @_; + if ( my $x = $$borrower{xattr} ) { + #SetBorrowerAttributes is not managing when being sent an Array ref + my $attrs = [ map { + my $key = $_; + my @listattributes; + if (ref ($x->{$key}) eq "ARRAY"){ + foreach my $value (@{$x->{$key}}){ + push @listattributes, { code => $key, value => $value } + } + } + else { + push @listattributes, { code => $key, value => $$x{$key} } + } + @listattributes; + } keys %$x ]; + $debug and logger { "creating $id" => $attrs }; + SetBorrowerAttributes( $id, $attrs ); + } +} + +sub accept_borrower { + my ($borrower,$userid) = @_; + for ( $$borrower{column}{userid} ) { + $userid ||= $_ or die; + unless ( $_ ) { + $_ = $userid; + next; + } + } + + my ($id) = exists_local( $userid ) or debug_msg "$userid is newcommer"; + + my $newcommer = not $id; + + if ( $newcommer ) { + return 0 unless $config{update}; + $debug and logger { Member => $$borrower{column} }; + $id = AddMember( %{ $$borrower{column} } ) or return 0; + } else { + if ( $config{replicate} ) { + delete $$borrower{column}{dateenrolled}; + delete $$borrower{column}{dateexpiry}; + my $cardnumber = update_local + ( $userid, $$borrower{column}{password}, $id, $$borrower{column} ); + if ( my $old_cardnumber = $$borrower{column}{cardnumber} ) { + if ( $old_cardnumber ne $cardnumber ) { + warn "update_local returned cardnumber '$cardnumber' instead of '$old_cardnumber'"; + return 0; + } + } + } + } + + if ( $newcommer || $config{'update'} ) { + $debug and logger { "changing attrs for $id" => $$borrower{xattr} }; + set_xattr $id, $borrower; + } + + return 1 +} + +sub cnx { + my $cnx = Net::LDAP->new( $ldap->{uri}, onerror => 'die' ) or do { + warn "ldap error: $!"; + }; + # bind MUST success + my $msg = eval { + $cnx->bind ($ldap->{manager}, password => $ldap->{password}) + }; + debug_msg "ldap $_:", $msg->$_ for qw/ error code /; + if ( $@ ) { + return { + error => 'LDAP_CANTBIND', + msg => $@ + }; + }; + return $cnx; +} + sub checkpw_ldap { my ($dbh, $userid, $password) = @_; my @hosts = split(',', $prefhost); my $db = Net::LDAP->new(\@hosts); - #$debug and $db->debug(5); + my $to_borrower = {}; + + my $uattr = $$ldap{userid_from} || $$ldap{mapping}{userid}{is} + or die "userid mapping not set"; + my $userldapentry; - if ( $ldap->{auth_by_bind} ) { - # Perform an anonymous bind - my $res = $db->bind; - if ( $res->code ) { - $debug and warn "Anonymous LDAP bind failed: ". description($res); - return 0; - } + if ( $$ldap{authmethod} ) { + for ( $$ldap{branch} ) { + $_ or die "no branch, no auth"; + ref $_ eq 'HASH' and $_ = [$_]; + } + + # This code is an attempt to introduce a new codebase that can be hookable + # and can mangage more cases than the old way + + # if the filter isn't set, userid mapping is used + $$ldap{filter} ||= "$uattr=%s"; + + my $cnx = cnx or return 0; + + # login can be either ... + my $login = do { + + # An Active Directory principal_name. Just replace the %s by the userid + # well ... don't try if not AD + if ( $$ldap{authmethod} ~~ [qw/ principal_name principalname principalName /] ) { + sprintf( $$ldap{principal_name}, $userid ) + } + + # for other LDAP implementation, the standard way is to + # A) Bind with the manager account and search for the DN of the user entry + # B) Bind with the user DN and password. + # Auth is completed if bind success. + # so in this code; + # - i fill $userldapentry for later use + # - i return the DN + + elsif ( $$ldap{authmethod} ~~ [qw/ searchdn searchDn search_dn /] ) { + $to_borrower = _anon_search($cnx, { + filter => sprintf($$ldap{filter}, $userid) + }) or do { + debug_msg "no answer from ldap"; + return 0; + }; + + if ( $$to_borrower{error} ) { + say STDERR $$to_borrower{msg}; + 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; + $userldapentry = $$to_borrower{entry} or do { + debug_msg "no entry returned? weird ..."; + }; - # Perform a LDAP bind for the given username using the matched DN - $res = $db->bind( $userldapentry->dn, password => $password ); - if ( $res->code ) { - $debug and warn "LDAP bind failed as kohauser $userid: ". description($res); - return 0; + # login is the dn of the entry + if ( $userldapentry ) { $userldapentry->dn } + else { + say STDERR "can't authenticate $userid"; + return 0; + } + } else { + say STDERR "$$ldap{authmethod} authmethod is invalid," + , "please check your ldap configuration in $ENV{KOHA_CONF}"; + return 0; + } + }; + + eval { $cnx->bind( $login, password => $password ) }; + if ( $@ ) { + say STDERR "ldap bind with $login failed: $@"; + return 0; + } + debug_msg "congrats, you're one of us"; + } else { + # This is the old stuff: + if ( $ldap->{auth_by_bind} ) { + # Perform an anonymous bind + my $res = $db->bind; + if ( $res->code ) { + $debug and 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; + + # Perform a LDAP bind for the given username using the matched DN + $res = $db->bind( $userldapentry->dn, password => $password ); + if ( $res->code ) { + $debug and warn "LDAP bind failed as kohauser $userid: ". description($res); + return 0; + } + } else { + say STDERR "deprecated kludge: use authmethod search_dn instead"; + 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; + } + } } - } 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; - } - } + if ( my $t = $$ldap{transformation} ) { + $$t{subroutine} ||= 'get_borrower'; + my $get_borrower = load_subroutine ( @$t{qw/ module subroutine /} ); + unless ( $get_borrower ) { + warn "no get_borrower $$t{subroutine} subroutine in $$t{module}"; + return 0; + } + debug_msg "$$t{subroutine} subroutine loaded from $$t{module}"; + if ( my $b = $get_borrower->( $$to_borrower{entry} ) ) { + return accept_borrower $b,$userid; + } + else { 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 %borrower; + my ($borrowernumber, $cardnumber, $local_userid, $savedpw) = exists_local($userid); - if (( $borrowernumber and $config{update} ) or - (!$borrowernumber and $config{replicate}) ) { - %borrower = ldap_entry_2_hash($userldapentry,$userid); + 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"; } if ($borrowernumber) { if ($config{update}) { # A1, B1 - my $c2 = &update_local($local_userid,$password,$borrowernumber,\%borrower) || ''; + my $c2 = &update_local($local_userid, $password, $borrowernumber, \%borrower) || ''; ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'"; } else { # C1, D1 # maybe update just the password? - return(1, $cardnumber, $local_userid); + return (1, $cardnumber, $local_userid); } } elsif ($config{replicate}) { # A2, C2 $borrowernumber = AddMember(%borrower) or die "AddMember failed"; - } else { - return 0; # B2, D2 + } else { + return 0; # B2, D2 } - if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} ||$config{replicate})) { + 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}; @@ -173,22 +388,24 @@ sub checkpw_ldap { push @$extended_patron_attributes, { code => $code, value => $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); + + 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); } # Pass LDAP entry object and local cardnumber (userid). @@ -197,65 +414,70 @@ return(1, $cardnumber, $userid); # Ensure that mandatory fields are correctly filled! # 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 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->{$_}); - } - } - my $x = $userldapentry->{attrs} or return; - foreach (keys %$x) { - $memberhash{$_} = join ' ', @{$x->{$_}}; - $debug and print STDERR 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"; - 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; - unless (defined $data) { - $data = $mapping{$key}->{content} || ''; # default or failsafe '' - } - $borrower{$key} = ($data ne '') ? $data : ' ' ; - } - $borrower{initials} = $memberhash{initials} || - ( substr($borrower{'firstname'},0,1) - . substr($borrower{ 'surname' },0,1) - . " "); - - # 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}; - $borrower{'categorycode'} = $default - } - - return %borrower; + 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 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->{$_}); + } + } + my $x = $userldapentry->{attrs} or return; + foreach (keys %$x) { + $memberhash{$_} = join ' ', @{$x->{$_}}; + $debug and print STDERR 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"; + 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; + unless (defined $data) { + $data = $mapping{$key}->{content} || ''; # default or failsafe '' + } + $borrower{$key} = ($data ne '') ? $data : ' '; + } + $borrower{initials} = $memberhash{initials} || + ( substr($borrower{'firstname'},0,1) + . substr($borrower{ 'surname' },0,1) + . " "); + + # 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}; + $borrower{'categorycode'} = $default + } + + return %borrower; } sub exists_local { - my $arg = shift; - my $dbh = C4::Context->dbh; - my $select = "SELECT borrowernumber,cardnumber,userid,password FROM borrowers "; - - my $sth = $dbh->prepare("$select WHERE userid=?"); # was cardnumber=? - $sth->execute($arg); - $debug and printf STDERR "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; - ($sth->rows == 1) and return $sth->fetchrow; - return 0; + my $arg = shift; + my $dbh = C4::Context->dbh; + my $select = "SELECT borrowers.borrowernumber,cardnumber,userid,borrowers.password FROM borrowers "; + + my $sth = $dbh->prepare("$select WHERE userid=?"); # was cardnumber=? + $sth->execute($arg); + $debug and printf STDERR "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; + ($sth->rows == 1) and return $sth->fetchrow; + + $sth = $dbh->prepare("$select JOIN borrower_attributes USING (borrowernumber) WHERE attribute=?"); + $sth->execute($arg); + $debug and printf STDERR "attribute '$arg' exists_local? %s\n", $sth->rows; + ($sth->rows == 1) and return $sth->fetchrow; + return 0; } sub _do_changepassword { @@ -263,40 +485,40 @@ sub _do_changepassword { $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; + # 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."; + warn "Password mismatch after update to cardnumber=$cardnum (borrowernumber=$borrowerid)"; + return; + } + die "Unexpected error after password update to userid/borrowernumber: $userid / $borrowerid."; } 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) - ); - - # MODIFY PASSWORD/LOGIN - _do_changepassword($userid, $borrowerid, $digest); + 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 + SET " . join( ',', map { "$_=?" } @keys ) . " + WHERE 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 ) ); + + # MODIFY PASSWORD/LOGIN + _do_changepassword($userid, $borrowerid, $digest); } 1; @@ -324,80 +546,80 @@ C4::Auth - Authenticates Koha users Make sure that ALL required fields are populated by your LDAP database (and mapped in KOHA_CONF). What are the required fields? Well, in mysql you can check the database table "borrowers" like this: - mysql> show COLUMNS from borrowers; - +---------------------+--------------+------+-----+---------+----------------+ - | Field | Type | Null | Key | Default | Extra | - +---------------------+--------------+------+-----+---------+----------------+ - | borrowernumber | int(11) | NO | PRI | NULL | auto_increment | - | cardnumber | varchar(16) | YES | UNI | NULL | | - | surname | mediumtext | NO | | NULL | | - | firstname | text | YES | | NULL | | - | title | mediumtext | YES | | NULL | | - | othernames | mediumtext | YES | | NULL | | - | initials | text | YES | | NULL | | - | streetnumber | varchar(10) | YES | | NULL | | - | streettype | varchar(50) | YES | | NULL | | - | address | mediumtext | NO | | NULL | | - | address2 | text | YES | | NULL | | - | city | mediumtext | NO | | NULL | | - | state | mediumtext | YES | | NULL | | - | zipcode | varchar(25) | YES | | NULL | | - | country | text | YES | | NULL | | - | email | mediumtext | YES | | NULL | | - | phone | text | YES | | NULL | | - | mobile | varchar(50) | YES | | NULL | | - | fax | mediumtext | YES | | NULL | | - | emailpro | text | YES | | NULL | | - | phonepro | text | YES | | NULL | | - | B_streetnumber | varchar(10) | YES | | NULL | | - | B_streettype | varchar(50) | YES | | NULL | | - | B_address | varchar(100) | YES | | NULL | | - | B_address2 | text | YES | | NULL | | - | B_city | mediumtext | YES | | NULL | | - | B_state | mediumtext | YES | | NULL | | - | B_zipcode | varchar(25) | YES | | NULL | | - | B_country | text | YES | | NULL | | - | B_email | text | YES | | NULL | | - | B_phone | mediumtext | YES | | NULL | | - | dateofbirth | date | YES | | NULL | | - | branchcode | varchar(10) | NO | MUL | | | - | categorycode | varchar(10) | NO | MUL | | | - | dateenrolled | date | YES | | NULL | | - | dateexpiry | date | YES | | NULL | | - | gonenoaddress | tinyint(1) | YES | | NULL | | - | lost | tinyint(1) | YES | | NULL | | - | debarred | date | YES | | NULL | | - | debarredcomment | varchar(255) | YES | | NULL | | - | 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 | | - | ethnotes | varchar(255) | YES | | NULL | | - | sex | varchar(1) | YES | | NULL | | - | password | varchar(30) | YES | | NULL | | - | flags | int(11) | YES | | NULL | | - | userid | varchar(30) | YES | MUL | NULL | | - | opacnote | mediumtext | YES | | NULL | | - | contactnote | varchar(255) | YES | | NULL | | - | sort1 | varchar(80) | YES | | NULL | | - | sort2 | varchar(80) | YES | | NULL | | - | altcontactfirstname | varchar(255) | YES | | NULL | | - | altcontactsurname | varchar(255) | YES | | NULL | | - | altcontactaddress1 | varchar(255) | YES | | NULL | | - | altcontactaddress2 | varchar(255) | YES | | NULL | | - | altcontactaddress3 | varchar(255) | YES | | NULL | | - | altcontactstate | mediumtext | YES | | NULL | | - | altcontactzipcode | varchar(50) | YES | | NULL | | - | altcontactcountry | text | YES | | NULL | | - | altcontactphone | varchar(50) | YES | | NULL | | - | smsalertnumber | varchar(50) | YES | | NULL | | - | privacy | int(11) | NO | | 1 | | - +---------------------+--------------+------+-----+---------+----------------+ - 66 rows in set (0.00 sec) - Where Null="NO", the field is required. + mysql> show COLUMNS from borrowers; + +---------------------+--------------+------+-----+---------+----------------+ + | Field | Type | Null | Key | Default | Extra | + +---------------------+--------------+------+-----+---------+----------------+ + | borrowernumber | int(11) | NO | PRI | NULL | auto_increment | + | cardnumber | varchar(16) | YES | UNI | NULL | | + | surname | mediumtext | NO | | NULL | | + | firstname | text | YES | | NULL | | + | title | mediumtext | YES | | NULL | | + | othernames | mediumtext | YES | | NULL | | + | initials | text | YES | | NULL | | + | streetnumber | varchar(10) | YES | | NULL | | + | streettype | varchar(50) | YES | | NULL | | + | address | mediumtext | NO | | NULL | | + | address2 | text | YES | | NULL | | + | city | mediumtext | NO | | NULL | | + | state | text | YES | | NULL | | + | zipcode | varchar(25) | YES | | NULL | | + | country | text | YES | | NULL | | + | email | mediumtext | YES | | NULL | | + | phone | text | YES | | NULL | | + | mobile | varchar(50) | YES | | NULL | | + | fax | mediumtext | YES | | NULL | | + | emailpro | text | YES | | NULL | | + | phonepro | text | YES | | NULL | | + | B_streetnumber | varchar(10) | YES | | NULL | | + | B_streettype | varchar(50) | YES | | NULL | | + | B_address | varchar(100) | YES | | NULL | | + | B_address2 | text | YES | | NULL | | + | B_city | mediumtext | YES | | NULL | | + | B_state | text | YES | | NULL | | + | B_zipcode | varchar(25) | YES | | NULL | | + | B_country | text | YES | | NULL | | + | B_email | text | YES | | NULL | | + | B_phone | mediumtext | YES | | NULL | | + | dateofbirth | date | YES | | NULL | | + | branchcode | varchar(10) | NO | MUL | | | + | categorycode | varchar(10) | NO | MUL | | | + | dateenrolled | date | YES | | NULL | | + | dateexpiry | date | YES | | NULL | | + | gonenoaddress | tinyint(1) | YES | | NULL | | + | lost | tinyint(1) | YES | | NULL | | + | debarred | date | YES | | NULL | | + | debarredcomment | varchar(255) | YES | | NULL | | + | 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 | | + | ethnotes | varchar(255) | YES | | NULL | | + | sex | varchar(1) | YES | | NULL | | + | password | varchar(30) | YES | | NULL | | + | flags | int(11) | YES | | NULL | | + | userid | varchar(75) | YES | MUL | NULL | | + | opacnote | mediumtext | YES | | NULL | | + | contactnote | varchar(255) | YES | | NULL | | + | sort1 | varchar(80) | YES | | NULL | | + | sort2 | varchar(80) | YES | | NULL | | + | altcontactfirstname | varchar(255) | YES | | NULL | | + | altcontactsurname | varchar(255) | YES | | NULL | | + | altcontactaddress1 | varchar(255) | YES | | NULL | | + | altcontactaddress2 | varchar(255) | YES | | NULL | | + | altcontactaddress3 | varchar(255) | YES | | NULL | | + | altcontactstate | text | YES | | NULL | | + | altcontactzipcode | varchar(50) | YES | | NULL | | + | altcontactcountry | text | YES | | NULL | | + | altcontactphone | varchar(50) | YES | | NULL | | + | smsalertnumber | varchar(50) | YES | | NULL | | + | privacy | int(11) | NO | | 1 | | + +---------------------+--------------+------+-----+---------+----------------+ + 67 rows in set (0.00 sec) + Where Null="NO", the field is required. =head1 KOHA_CONF and field mapping diff --git a/C4/LDAPAuthMethodTutorial.pod b/C4/LDAPAuthMethodTutorial.pod new file mode 100644 index 0000000..92cac6b --- /dev/null +++ b/C4/LDAPAuthMethodTutorial.pod @@ -0,0 +1,91 @@ +=head1 LDAP auth_method configuration + +This document is a step by step explaination for the new LDAP configuration +method. The old one (see C4::Auth_with_ldap) still exists and you should give it +a try if your needs of mappings and transformations are low. + +=head2 What do I have to ask to the directory administrator + +=head3 How to reach the service + +What we need is build the url of the ldap service we want to reach. So ask him +for the URL. If he don't know, ask for the scheme (or protocol), the hostname +and the port of the directory. Only hostname and scheme are mandatory. + +The scheme must be ldap or ldaps (ldaps is for crypted ldap, ldap over SSL). +The url construction is: + + scheme://hostname:port + scheme://hostname + +examples + + host=directory.example.com port=389 scheme=ldap + +gives you: + + ldap://directory.example.com:389 + +Also: Active Directory (the Microsoft implementation) is an LDAP alike directory +but Koha have to know it's active directory to use it, so please ask. + +=head3 What is the binding method ? + +Are anonymous allowed to make some searches on the server? If not, what is the +credentials for the koha account ? Credentials are a pair (DN, password) + + uid=koha,ou=people,dc=example,dc=com MYS3CRET + +in Active Directory, it can be a login@example.com with a password + + koha@example.com MYS3CRET + +=head3 Now configure koha + +This is a basic exemple of things you will add in the C part of +C. + +First of all, you need to tell koha that ldap authentication is now relevant + + 1 + +If you use anonymous method, you have to give credentials of koha account + + + +Also, you can set the values for replication and update (documented in legacy +pod): + + + +You must now tell koha the ldap branches where to find users + + 1 + + + + + +The best part of this new config is that you don't have to rely on simple +mappings anymore (but you still can): you can use a perl module to write much +sofisticated transformations directly in perl: + + + +This module only have to define a subroutine named get_borrower + + + -- 1.7.2.5