BugFix 2726 Resending
[koha.git] / C4 / Auth_with_ldap.pm
index c061612..16573da 100644 (file)
@@ -18,6 +18,7 @@ package C4::Auth_with_ldap;
 # Suite 330, Boston, MA  02111-1307 USA
 
 use strict;
+# use warnings; almost?
 use Digest::MD5 qw(md5_base64);
 
 use C4::Debug;
@@ -31,7 +32,7 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
 
 BEGIN {
        require Exporter;
-       $VERSION = 3.03;        # set the version for version checking
+       $VERSION = 3.10;        # set the version for version checking
        @ISA    = qw(Exporter);
        @EXPORT = qw( checkpw_ldap );
 }
@@ -54,7 +55,7 @@ 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}}    or die ldapserver_error('mapping');
+our %mapping  = ($ldap->{mapping}?%{$ldap->{mapping}}:()); #   or die ldapserver_error('mapping');
 my @mapkeys = keys %mapping;
 $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (  total  ): ", join ' ', @mapkeys, "\n";
 @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
@@ -62,8 +63,8 @@ $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ",
 
 my %config = (
        anonymous => ($ldapname and $ldappassword) ? 0 : 1,
-       replicate => $ldap->{replicate} || 1,           #    add from LDAP to Koha database for new user
-          update => $ldap->{update}    || 1,           # update from LDAP to Koha database for existing user
+    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
 );
 
 sub description ($) {
@@ -73,15 +74,14 @@ sub description ($) {
                        . "# " . $result->error_text . "\n";
 }
 
-sub checkpw_ldap {
-    my ($dbh, $userid, $password) = @_;
-    my $db = Net::LDAP->new([$prefhost]);
-       #$debug and $db->debug(5);
+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 $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
     if ($res->code) {          # connection refused
-        warn "LDAP bind failed as $ldapname: " . description($res);
+        warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') . ": " . description($res);
         return 0;
     }
        my $search = $db->search(
@@ -98,26 +98,63 @@ sub checkpw_ldap {
                warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count);
                return 0;
        }
+    return $search;
+}
 
-       my $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;
-       }
-       unless ($config{update} or $config{replicate}) {
-               return 1;
-       }
-       my %borrower = ldap_entry_2_hash($userldapentry,$userid);
-       $debug and print "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
-       my ($borrowernumber,$cardnumber,$savedpw);
-       ($borrowernumber,$cardnumber,$userid,$savedpw) = exists_local($userid);
-       if ($borrowernumber) {
-               ($config{update}   ) and my $c2 = &update_local($userid,$password,$borrowernumber,\%borrower) || '';
-               ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'";
+sub checkpw_ldap {
+    my ($dbh, $userid, $password) = @_;
+    my @hosts = split(',', $prefhost);
+    my $db = Net::LDAP->new(\@hosts);
+       #$debug and $db->debug(5);
+    my $userldapentry;
+    my $search = search_method($db, $userid) or return 0;   # warnings are in the sub
+    $userldapentry = $search->shift_entry;
+       if ( $ldap->{auth_by_bind} ) {
+               my $userldapname;
+           if ($ldap->{principal_name} and $ldap->{principal_name} =~ /\%/) {
+                   $userldapname = sprintf($ldap->{principal_name},$userid);
+               }
+               else {
+                   $userldapname=$userldapentry->dn();
+               }
+       my $userdb = Net::LDAP->new(\@hosts);
+               my $res = $userdb->bind( $userldapname, password => $password );
+        if ( $res->code ) {
+            $debug and warn "LDAP bind failed as kohauser $userldapname: ". description($res);
+            return 0;
+        }
        } else {
-               ($config{replicate}) and $borrowernumber = AddMember(%borrower);
+               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;
+               }
        }
+
+    # 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);
+
+    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) || '';
+            ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'";
+        } else { # C1, D1
+            # maybe update just the password?
+        }
+    } elsif ($config{replicate}) { # A2, C2
+        $borrowernumber = AddMember(%borrower) or die "AddMember failed";
+    } else {
+        return 0;   # B2, D2
+    }
        return(1, $cardnumber);
 }
 
@@ -132,23 +169,22 @@ sub ldap_entry_2_hash ($$) {
        my %memberhash;
        $userldapentry->exists('uid');  # This is bad, but required!  By side-effect, this initializes the attrs hash. 
        if ($debug) {
-               print "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump();
+               print STDERR "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump();
                foreach (keys %$userldapentry) {
-                       print "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
+                       print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
                        hashdump("LDAP key: ",$userldapentry->{$_});
                }
        }
        my $x = $userldapentry->{attrs} or return undef;
-       my $key;
        foreach (keys %$x) {
                $memberhash{$_} = join ' ', @{$x->{$_}};        
-               $debug and print sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
+               $debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
        }
-       $debug and print "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\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{$mapping{$key}->{is}}; 
-               $debug and printf "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
+               $debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
                unless (defined $data) { 
                        $data = $mapping{$key}->{content} || '';        # default or failsafe ''
                }
@@ -168,16 +204,33 @@ sub exists_local($) {
 
        my $sth = $dbh->prepare("$select WHERE userid=?");      # was cardnumber=?
        $sth->execute($arg);
-       $debug and printf "Userid '$arg' exists_local? %s\n", $sth->rows;
+       $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 "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
+       $debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
        ($sth->rows == 1) and return $sth->fetchrow;
        return 0;
 }
 
+sub _do_changepassword {
+    my ($userid, $borrowerid, $digest) = @_;
+    $debug and print STDERR "changing local password for borrowernumber=$borrowerid to '$digest'\n";
+    changepassword($userid, $borrowerid, $digest);
+
+       # Confirm changes
+       my $sth = C4::Context->dbh->prepare("SELECT password,cardnumber FROM borrowers WHERE borrowernumber=? ");
+       $sth->execute($borrowerid);
+       if ($sth->rows) {
+               my ($md5password, $cardnum) = $sth->fetchrow;
+        ($digest eq $md5password) and return $cardnum;
+               warn "Password mismatch after update to cardnumber=$cardnum (borrowernumber=$borrowerid)";
+               return undef;
+       }
+       die "Unexpected error after password update to userid/borrowernumber: $userid / $borrowerid.";
+}
+
 sub update_local($$$$) {
        my   $userid   = shift             or return undef;
        my   $digest   = md5_base64(shift) or return undef;
@@ -199,20 +252,7 @@ sub update_local($$$$) {
        );
 
        # MODIFY PASSWORD/LOGIN
-       # search borrowerid
-       $debug and print "changing local password for borrowernumber=$borrowerid to '$digest'\n";
-       changepassword($userid, $borrowerid, $digest);
-
-       # Confirm changes
-       $sth = $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 undef;
-       }
-       die "Unexpected error after password update to userid/borrowernumber: $userid / $borrowerid.";
+       _do_changepassword($userid, $borrowerid, $digest);
 }
 
 1;
@@ -299,8 +339,6 @@ C4::Auth - Authenticates Koha users
        
                Where Null="NO", the field is required.
 
-=cut
-
 =head1 KOHA_CONF and field mapping
 
 Example XML stanza for LDAP configuration in KOHA_CONF.
@@ -313,9 +351,13 @@ Example XML stanza for LDAP configuration in KOHA_CONF.
     <hostname>localhost</hostname>
     <base>dc=metavore,dc=com</base>
     <user>cn=Manager,dc=metavore,dc=com</user>             <!-- DN, if not anonymous -->
-    <pass>metavore</pass>      <!-- password, if not anonymous -->
-    <replicate>1</replicate>   <!-- add new users from LDAP to Koha database -->
-    <update>1</update>         <!-- update existing users in Koha database -->
+    <pass>metavore</pass>          <!-- password, if not anonymous -->
+    <replicate>1</replicate>       <!-- add new users from LDAP to Koha database -->
+    <update>1</update>             <!-- update existing users in Koha database -->
+    <auth_by_bind>0</auth_by_bind> <!-- set to 1 to authenticate by binding instead of
+                                        password comparison, e.g., to use Active Directory -->
+    <principal_name>%s@my_domain.com</principal_name>
+                                   <!-- optional, for auth_by_bind: a printf format to make userPrincipalName from koha userid -->
     <mapping>                  <!-- match koha SQL field names to your LDAP record field names -->
       <firstname    is="givenname"      ></firstname>
       <surname      is="sn"             ></surname>
@@ -337,8 +379,84 @@ is the column in mysql, with the "is" characteristic set to the LDAP attribute n
 between the element tags is taken as the default value.  In this example, the default categorycode is "PT" (for
 patron).  
 
+=head1 CONFIGURATION
+
+Once a user has been accepted by the LDAP server, there are several possibilities for how Koha will behave, depending on 
+your configuration and the presence of a matching Koha user in your local DB:
+
+                         LOCAL_USER
+ OPTION UPDATE REPLICATE  EXISTS?  RESULT
+   A1      1       1        1      OK : We're updating them anyway.
+   A2      1       1        0      OK : We're adding them anyway.
+   B1      1       0        1      OK : We update them.
+   B2      1       0        0     FAIL: We cannot add new user.
+   C1      0       1        1      OK : We do nothing.  (maybe should update password?)
+   C2      0       1        0      OK : We add the new user.
+   D1      0       0        1      OK : We do nothing.  (maybe should update password?)
+   D2      0       0        0     FAIL: We cannot add new user.
+
+Note: failure here just means that Koha will fallback to checking the local DB.  That is, a given user could login with
+their LDAP password OR their local one.  If this is a problem, then you should enable update and supply a mapping for 
+password.  Then the local value will be updated at successful LDAP login and the passwords will be synced.
+
+If you choose NOT to update local users, the borrowers table will not be affected at all.
+Note that this means that patron passwords may appear to change if LDAP is ever disabled, because
+the local table never contained the LDAP values.  
+
+=head2 auth_by_bind
+
+Binds as the user instead of retrieving their record.  Recommended if update disabled.
+
+=head2 principal_name
+
+Provides an optional sprintf-style format for manipulating the userid before the bind.
+Even though the userPrincipalName is one intended target, any uniquely identifying
+attribute that the server allows to be used for binding could be used.
+
+Currently, principal_name only operates when auth_by_bind is enabled.
+
+=head2 Active Directory 
+
+The auth_by_bind and principal_name settings are recommended for Active Directory.
+
+Under default Active Directory rules, we cannot determine the distinguishedName attribute from the Koha userid as reliably as
+we would typically under openldap.  Instead of:
+
+    distinguishedName: CN=barnes.7,DC=my_company,DC=com
+
+We might get:
+
+    distinguishedName: CN=Barnes\, Jim,OU=Test Accounts,OU=User Accounts,DC=my_company,DC=com
+
+Matching that would require us to know more info about the account (firstname, surname) and to include punctuation and whitespace
+in Koha userids.  But the userPrincipalName should be consistent, something like:
+
+    userPrincipalName: barnes.7@my_company.com
+
+Therefore it is often easier to bind to Active Directory with userPrincipalName, effectively the
+canonical email address for that user, or what it would be if email were enabled for them.  If Koha userid values 
+will match the username portion of the userPrincipalName, and the domain suffix is the same for all users, then use principal_name
+like this:
+    <principal_name>%s@core.my_company.com</principal_name>
+
+The user of the previous example, barnes.7, would then attempt to bind as:
+    barnes.7@core.my_company.com
+
+=head1 SEE ALSO
+
+CGI(3)
+
+Net::LDAP()
+
+XML::Simple()
+
+Digest::MD5(3)
+
+sprintf()
+
 =cut
 
+# For reference, here's an important difference in the data structure we rely on.
 # ========================================
 # Using attrs instead of {asn}->attributes
 # ========================================
@@ -351,15 +469,3 @@ patron).
 #      LDAP key: ->{      givenname} = ARRAY w/ 1 members.
 #      LDAP key: ->{      givenname}->{Steve} = Steve
 #
-
-=head1 SEE ALSO
-
-CGI(3)
-
-Net::LDAP()
-
-XML::Simple()
-
-Digest::MD5(3)
-
-=cut