@@ -, +, @@ --- C4/Auth_with_ldap.pm | 742 ++++++++++++++++++++++++++-------------- C4/LDAPAuthMethodTutorial.pod | 91 +++++ 2 files changed, 573 insertions(+), 260 deletions(-) create mode 100644 C4/LDAPAuthMethodTutorial.pod --- a/C4/Auth_with_ldap.pm +++ a/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,110 +84,306 @@ $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} ) { - my $principal_name = $ldap->{principal_name}; - if ($principal_name and $principal_name =~ /\%/) { - $principal_name = sprintf($principal_name,$userid); - } else { - $principal_name = $userid; + + 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; + } + + $userldapentry = $$to_borrower{entry} or do { + debug_msg "no entry returned? weird ..."; + }; + + # 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; } - my $res = $db->bind( $principal_name, password => $password ); - if ( $res->code ) { - $debug and warn "LDAP bind failed as kohauser $principal_name: ". description($res); + debug_msg "congrats, you're one of us"; + } else { + # This is the old stuff: + 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; + } + 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; + } + + # 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 { + 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; + } } + } - # 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); - 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}; @@ -176,22 +391,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). @@ -200,65 +417,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 { @@ -266,40 +488,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; @@ -327,80 +549,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 --- a/C4/LDAPAuthMethodTutorial.pod +++ a/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 + + + --