@@ -, +, @@ --- C4/Auth_with_ldap.pm | 367 ++++++++++++++++++++++++++++++++++-------- C4/LDAPAuthMethodTutorial.pod | 110 +++++++++++++ 2 files changed, 408 insertions(+), 69 deletions(-) create mode 100644 C4/LDAPAuthMethodTutorial.pod --- a/C4/Auth_with_ldap.pm +++ a/C4/Auth_with_ldap.pm @@ -17,14 +17,12 @@ 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 Carp; - use C4::Debug; use C4::Context; use C4::Members qw(AddMember changepassword); -use C4::Members::Attributes; +use C4::Members::Attributes qw(SetBorrowerAttributes); use C4::Members::AttributeTypes; use C4::Members::Messaging; use C4::Auth qw(checkpw_internal); @@ -32,6 +30,7 @@ use Koha::AuthUtils qw(hash_password); 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); @@ -42,6 +41,18 @@ BEGIN { @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 @@ -53,14 +64,23 @@ sub ldapserver_error { 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 $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} ; -our %mapping = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of || (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9 + +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}} if $ldap->{mapping}; my @mapkeys = keys %mapping; $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n"; @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys; @@ -103,82 +123,284 @@ sub search_method { 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, $cardnumber) = exists_local( $userid ) or debug_msg "$userid is newcommer"; + + my $newcommer = not $id; + + if ( $newcommer ) { + return 0 unless $config{replicate}; + $debug and logger { Member => $$borrower{column} }; + $id = AddMember( %{ $$borrower{column} } ) or return 0; + } else { + if ( $config{update} ) { + delete $$borrower{column}{dateenrolled}; + delete $$borrower{column}{dateexpiry}; + $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, $cardnumber, $userid ); +} + +sub cnx { + my $cnx = Net::LDAP->new( $ldap->{uri}, onerror => 'die' ) or do { + warn "ldap error: $!"; + }; + # bind MUST success + my $msg = eval { + if ( $ldap->{manager} ) { + $cnx->bind ($ldap->{manager}, password => $ldap->{password}) + } else { + $cnx->bind(); + } + }; + 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); - unless ( $db ) { - warn "LDAP connexion failed"; - return 0; - } - #$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; - if ( $ldap->{anonymous_bind} ) { + if ( $$ldap{authmethod} ) { + for ( $$ldap{branch} ) { + $_ or die "no branch, no auth"; + ref $_ eq 'HASH' and $_ = [$_]; + } - # Perform an anonymous bind - my $res = $db->bind; - if ( $res->code ) { - warn "Anonymous LDAP bind failed: " . description($res); + # 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; } + }; - # 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; + eval { $cnx->bind( $login, password => $password ) }; + if ( $@ ) { + say STDERR "ldap bind with $login failed: $@"; + return 0; } - else { - $principal_name = $ldap->{principal_name}; - if ( $principal_name and $principal_name =~ /\%/ ) { - $principal_name = sprintf( $principal_name, $userid ); + debug_msg "congrats, you're one of us"; + } else { + # This is the old stuff: + my @hosts = split(',', $prefhost); + my $db = Net::LDAP->new(\@hosts); + unless ( $db ) { + warn "LDAP connexion failed"; + return 0; + } + #$debug and $db->debug(5); + + if ( $ldap->{auth_by_bind} ) { + my $principal_name; + if ( $ldap->{anonymous_bind} ) { + + # 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; } else { - $principal_name = $userid; + $principal_name = $ldap->{principal_name}; + if ( $principal_name and $principal_name =~ /\%/ ) { + $principal_name = sprintf( $principal_name, $userid ); + } + else { + $principal_name = $userid; + } } - } - # Perform a LDAP bind for the given username using the matched DN - my $res = $db->bind( $principal_name, password => $password ); - if ( $res->code ) { - if ( $ldap->{anonymous_bind} ) { - # 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); + # Perform a LDAP bind for the given username using the matched DN + my $res = $db->bind( $principal_name, password => $password ); + if ( $res->code ) { + if ( $ldap->{anonymous_bind} ) { + # 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 { + 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; } - } - if ( !defined($userldapentry) - && ( $config{update} or $config{replicate} ) ) - { - my $search = search_method( $db, $userid ) or 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 -1; + } } - } 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 -1; - } - } + } + + 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; + } + + 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. @@ -290,6 +512,12 @@ sub exists_local { $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; } @@ -335,7 +563,6 @@ sub _do_changepassword { sub update_local { 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"; @@ -355,7 +582,9 @@ sub update_local { ); # MODIFY PASSWORD/LOGIN if password was mapped - _do_changepassword($userid, $borrowerid, $password) if $borrower->{'password'}; + if ($borrower->{password} and $password) { + _do_changepassword($userid, $borrowerid, $password); + } } 1; --- a/C4/LDAPAuthMethodTutorial.pod +++ a/C4/LDAPAuthMethodTutorial.pod @@ -0,0 +1,110 @@ +=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 uri 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 uri 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 are using anonymous method, you just omit LDAP credentials + + + +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 which will +receive C object and returns hash which corresponds to +fields in C table similar to: + + { + column => { + email => "test.user\\@example.com", + firstname => "Test", + surname => "User" + userid => "testuser", + } + } + +If you don't have section in your C you will have +to add additional attribute to your ldapserver directive to indicate which +field will be used to bind to LDAP using : + + + --