From 91b3df89e2915b414d9bf9c054c5fef793bd4fc1 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 | 368 ++++++++++++++++++++++++++++++++++-------- C4/LDAPAuthMethodTutorial.pod | 110 +++++++++++++ 2 files changed, 409 insertions(+), 69 deletions(-) create mode 100644 C4/LDAPAuthMethodTutorial.pod diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index a929c04..04c97a4 100644 --- a/C4/Auth_with_ldap.pm +++ b/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,285 @@ 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} ) ) { + $b->{column}->{password} = $password; + 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 +513,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 +564,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 +583,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; diff --git a/C4/LDAPAuthMethodTutorial.pod b/C4/LDAPAuthMethodTutorial.pod new file mode 100644 index 0000000..440c110 --- /dev/null +++ b/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 : + + + -- 1.9.1