C4/Auth_with_ldap.pm

   1 package C4::Auth_with_ldap;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 use Digest::MD5 qw(md5_base64);
  22
  23 use C4::Context;
  24 use C4::Members qw(AddMember changepassword);
  25 use C4::Utils qw( :all );
  26 use Net::LDAP;
  27 use Net::LDAP::Filter;
  28
  29 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
  30
  31 BEGIN {
  32         require Exporter;
  33         $VERSION = 3.02;        # set the version for version checking
  34         $debug = $ENV{DEBUG} || 0;
  35         @ISA    = qw(Exporter);
  36         @EXPORT = qw( checkpw_ldap );
  37 }
  38
  39 # Redefine checkpw_ldap:
  40 # connect to LDAP (named or anonymous)
  41 # ~ retrieves $userid from KOHA_CONF mapping
  42 # ~ then compares $password with userPassword
  43 # ~ then gets the LDAP entry
  44 # ~ and calls the memberadd if necessary
  45
  46 sub ldapserver_error ($) {
  47         return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
  48 }
  49
  50 use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
  51 my $context = C4::Context->new()        or die 'C4::Context->new failed';
  52 my $ldap = $context->{server}->{ldapserver}     or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
  53 my $prefhost  = $ldap->{hostname}       or die ldapserver_error('hostname');
  54 my $base      = $ldap->{base}           or die ldapserver_error('base');
  55 $ldapname     = $ldap->{user}           or die ldapserver_error('user');
  56 $ldappassword = $ldap->{pass}           or die ldapserver_error('pass');
  57 our %mapping  = %{$ldap->{mapping}}     or die ldapserver_error('mapping');
  58 my @mapkeys = keys %mapping;
  59 $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (  total  ): ", join ' ', @mapkeys, "\n";
  60 @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
  61 $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n";
  62
  63 my %config = (
  64         anonymous => ($ldapname and $ldappassword) ? 0 : 1,
  65         replicate => $ldap->{replicate} || 1,           #    add from LDAP to Koha database for new user
  66            update => $ldap->{update}    || 1,           # update from LDAP to Koha database for existing user
  67 );
  68
  69 sub description ($) {
  70         my $result = shift or return undef;
  71         return "LDAP error #" . $result->code
  72                         . ": " . $result->error_name . "\n"
  73                         . "# " . $result->error_text . "\n";
  74 }
  75
  76 sub checkpw_ldap {
  77     my ($dbh, $userid, $password) = @_;
  78     my $db = Net::LDAP->new([$prefhost]);
  79         #$debug and $db->debug(5);
  80         my $uid_field = $mapping{userid}->{is} or die ldapserver_error("mapping for 'userid'");
  81         my $filter = Net::LDAP::Filter->new("$uid_field=$userid") or die "Failed to create new Net::LDAP::Filter";
  82     my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
  83     if ($res->code) {           # connection refused
  84         warn "LDAP bind failed as $ldapname: " . description($res);
  85         return 0;
  86     }
  87         my $search = $db->search(
  88                   base => $base,
  89                 filter => $filter,
  90                 # attrs => ['*'],
  91         ) or die "LDAP search failed to return object.";
  92         my $count = $search->count;
  93         if ($search->code > 0) {
  94                 warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count) . description($search);
  95                 return 0;
  96         }
  97         if ($count != 1) {
  98                 warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count);
  99                 return 0;
 100         }
 101
 102         my $userldapentry = $search->shift_entry;
 103         my $cmpmesg = $db->compare( $userldapentry, attr=>'userpassword', value => $password );
 104         if ($cmpmesg->code != 6) {
 105                 warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
 106                 return 0;
 107         }
 108         unless ($config{update} or $config{replicate}) {
 109                 return 1;
 110         }
 111         my %borrower = ldap_entry_2_hash($userldapentry,$userid);
 112         $debug and print "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
 113         my ($borrowernumber,$cardnumber,$savedpw);
 114         ($borrowernumber,$cardnumber,$userid,$savedpw) = exists_local($userid);
 115         if ($borrowernumber) {
 116                 ($config{update}   ) and my $c2 = &update_local($userid,$password,$borrowernumber,\%borrower) || '';
 117                 ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'";
 118         } else {
 119                 ($config{replicate}) and $borrowernumber = AddMember(%borrower);
 120         }
 121         return(1, $cardnumber);
 122 }
 123
 124 # Pass LDAP entry object and local cardnumber (userid).
 125 # Returns borrower hash.
 126 # Edit KOHA_CONF so $memberhash{'xxx'} fits your ldap structure.
 127 # Ensure that mandatory fields are correctly filled!
 128 #
 129 sub ldap_entry_2_hash ($$) {
 130         my $userldapentry = shift;
 131         my %borrower = ( cardnumber => shift );
 132         my %memberhash;
 133         $userldapentry->exists('uid');  # This is bad, but required!  By side-effect, this initializes the attrs hash.
 134         if ($debug) {
 135                 print "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump();
 136                 foreach (keys %$userldapentry) {
 137                         print "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
 138                         hashdump("LDAP key: ",$userldapentry->{$_});
 139                 }
 140         }
 141         my $x = $userldapentry->{attrs} or return undef;
 142         my $key;
 143         foreach (keys %$x) {
 144                 $memberhash{$_} = join ' ', @{$x->{$_}};
 145                 $debug and print sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
 146         }
 147         $debug and print "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n",
 148                                         "Referencing \%mapping with ", scalar(keys %mapping), " keys\n";
 149         foreach my $key (keys %mapping) {
 150                 my  $data = $memberhash{$mapping{$key}->{is}};
 151                 $debug and printf "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
 152                 unless (defined $data) {
 153                         $data = $mapping{$key}->{content} || '';        # default or failsafe ''
 154                 }
 155                 $borrower{$key} = ($data ne '') ? $data : ' ' ;
 156         }
 157         $borrower{initials} = $memberhash{initials} ||
 158                 ( substr($borrower{'firstname'},0,1)
 159                 . substr($borrower{ 'surname' },0,1)
 160                 . " ");
 161         return %borrower;
 162 }
 163
 164 sub exists_local($) {
 165         my $arg = shift;
 166         my $dbh = C4::Context->dbh;
 167         my $select = "SELECT borrowernumber,cardnumber,userid,password FROM borrowers ";
 168
 169         my $sth = $dbh->prepare("$select WHERE userid=?");      # was cardnumber=?
 170         $sth->execute($arg);
 171         $debug and printf "Userid '$arg' exists_local? %s\n", $sth->rows;
 172         ($sth->rows == 1) and return $sth->fetchrow;
 173
 174         $sth = $dbh->prepare("$select WHERE cardnumber=?");
 175         $sth->execute($arg);
 176         $debug and printf "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
 177         ($sth->rows == 1) and return $sth->fetchrow;
 178         return 0;
 179 }
 180
 181 sub update_local($$$$) {
 182         my   $userid   = shift             or return undef;
 183         my   $digest   = md5_base64(shift) or return undef;
 184         my $borrowerid = shift             or return undef;
 185         my $borrower   = shift             or return undef;
 186         my @keys = keys %$borrower;
 187         my $dbh = C4::Context->dbh;
 188         my $query = "UPDATE  borrowers\nSET     " .
 189                 join(',', map {"$_=?"} @keys) .
 190                 "\nWHERE   borrowernumber=? ";
 191         my $sth = $dbh->prepare($query);
 192         if ($debug) {
 193                 print STDERR $query, "\n",
 194                         join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys;
 195                 print STDERR "\nuserid = $userid\n";
 196         }
 197         $sth->execute(
 198                 ((map {$borrower->{$_}} @keys), $borrowerid)
 199         );
 200
 201         # MODIFY PASSWORD/LOGIN
 202         # search borrowerid
 203         $debug and print "changing local password for borrowernumber=$borrowerid to '$digest'\n";
 204         changepassword($userid, $borrowerid, $digest);
 205
 206         # Confirm changes
 207         $sth = $dbh->prepare("SELECT password,cardnumber FROM borrowers WHERE borrowernumber=? ");
 208         $sth->execute($borrowerid);
 209         if ($sth->rows) {
 210                 my ($md5password, $cardnum) = $sth->fetchrow;
 211         ($digest eq $md5password) and return $cardnum;
 212                 warn "Password mismatch after update to cardnumber=$cardnum (borrowernumber=$borrowerid)";
 213                 return undef;
 214         }
 215         die "Unexpected error after password update to userid/borrowernumber: $userid / $borrowerid.";
 216 }
 217
 218 1;
 219 __END__
 220
 221 =head1 NAME
 222
 223 C4::Auth - Authenticates Koha users
 224
 225 =head1 SYNOPSIS
 226
 227   use C4::Auth_with_ldap;
 228
 229 =head1 LDAP Configuration
 230
 231     This module is specific to LDAP authentification. It requires Net::LDAP package and one or more
 232         working LDAP servers.
 233         To use it :
 234            * Modify ldapserver element in KOHA_CONF
 235            * Establish field mapping in <mapping> element.
 236
 237         For example, if your user records are stored according to the inetOrgPerson schema, RFC#2798,
 238         the username would match the "uid" field, and the password should match the "userpassword" field.
 239
 240         Make sure that ALL required fields are populated by your LDAP database (and mapped in KOHA_CONF).
 241         What are the required fields?  Well, in mysql you can check the database table "borrowers" like this:
 242
 243         mysql> show COLUMNS from borrowers;
 244                 +------------------+--------------+------+-----+---------+----------------+
 245                 | Field            | Type         | Null | Key | Default | Extra          |
 246                 +------------------+--------------+------+-----+---------+----------------+
 247                 | borrowernumber   | int(11)      | NO   | PRI | NULL    | auto_increment |
 248                 | cardnumber       | varchar(16)  | YES  | UNI | NULL    |                |
 249                 | surname          | mediumtext   | NO   |     |         |                |
 250                 | firstname        | text         | YES  |     | NULL    |                |
 251                 | title            | mediumtext   | YES  |     | NULL    |                |
 252                 | othernames       | mediumtext   | YES  |     | NULL    |                |
 253                 | initials         | text         | YES  |     | NULL    |                |
 254                 | streetnumber     | varchar(10)  | YES  |     | NULL    |                |
 255                 | streettype       | varchar(50)  | YES  |     | NULL    |                |
 256                 | address          | mediumtext   | NO   |     |         |                |
 257                 | address2         | text         | YES  |     | NULL    |                |
 258                 | city             | mediumtext   | NO   |     |         |                |
 259                 | zipcode          | varchar(25)  | YES  |     | NULL    |                |
 260                 | email            | mediumtext   | YES  |     | NULL    |                |
 261                 | phone            | text         | YES  |     | NULL    |                |
 262                 | mobile           | varchar(50)  | YES  |     | NULL    |                |
 263                 | fax              | mediumtext   | YES  |     | NULL    |                |
 264                 | emailpro         | text         | YES  |     | NULL    |                |
 265                 | phonepro         | text         | YES  |     | NULL    |                |
 266                 | B_streetnumber   | varchar(10)  | YES  |     | NULL    |                |
 267                 | B_streettype     | varchar(50)  | YES  |     | NULL    |                |
 268                 | B_address        | varchar(100) | YES  |     | NULL    |                |
 269                 | B_city           | mediumtext   | YES  |     | NULL    |                |
 270                 | B_zipcode        | varchar(25)  | YES  |     | NULL    |                |
 271                 | B_email          | text         | YES  |     | NULL    |                |
 272                 | B_phone          | mediumtext   | YES  |     | NULL    |                |
 273                 | dateofbirth      | date         | YES  |     | NULL    |                |
 274                 | branchcode       | varchar(10)  | NO   | MUL |         |                |
 275                 | categorycode     | varchar(10)  | NO   | MUL |         |                |
 276                 | dateenrolled     | date         | YES  |     | NULL    |                |
 277                 | dateexpiry       | date         | YES  |     | NULL    |                |
 278                 | gonenoaddress    | tinyint(1)   | YES  |     | NULL    |                |
 279                 | lost             | tinyint(1)   | YES  |     | NULL    |                |
 280                 | debarred         | tinyint(1)   | YES  |     | NULL    |                |
 281                 | contactname      | mediumtext   | YES  |     | NULL    |                |
 282                 | contactfirstname | text         | YES  |     | NULL    |                |
 283                 | contacttitle     | text         | YES  |     | NULL    |                |
 284                 | guarantorid      | int(11)      | YES  |     | NULL    |                |
 285                 | borrowernotes    | mediumtext   | YES  |     | NULL    |                |
 286                 | relationship     | varchar(100) | YES  |     | NULL    |                |
 287                 | ethnicity        | varchar(50)  | YES  |     | NULL    |                |
 288                 | ethnotes         | varchar(255) | YES  |     | NULL    |                |
 289                 | sex              | varchar(1)   | YES  |     | NULL    |                |
 290                 | password         | varchar(30)  | YES  |     | NULL    |                |
 291                 | flags            | int(11)      | YES  |     | NULL    |                |
 292                 | userid           | varchar(30)  | YES  | MUL | NULL    |                |  # UNIQUE in next release.
 293                 | opacnote         | mediumtext   | YES  |     | NULL    |                |
 294                 | contactnote      | varchar(255) | YES  |     | NULL    |                |
 295                 | sort1            | varchar(80)  | YES  |     | NULL    |                |
 296                 | sort2            | varchar(80)  | YES  |     | NULL    |                |
 297                 +------------------+--------------+------+-----+---------+----------------+
 298                 50 rows in set (0.01 sec)
 299
 300                 Where Null="NO", the field is required.
 301
 302 =cut
 303
 304 =head1 KOHA_CONF and field mapping
 305
 306 Example XML stanza for LDAP configuration in KOHA_CONF:
 307
 308         <!-- LDAP SERVER (optional) -->
 309         <server id="ldapserver"  listenref="ldapserver">
 310                 <hostname>localhost</hostname>
 311                 <base>dc=metavore,dc=com</base>
 312                 <user>cn=Manager,dc=metavore,dc=com</user>             <!-- DN, if not anonymous -->
 313                 <pass>metavore</pass>      <!-- password, if not anonymous -->
 314                 <replicate>1</replicate>   <!-- add new users from LDAP to Koha database -->
 315                 <update>1</update>         <!-- update existing users in Koha database -->
 316                 <mapping>                  <!-- match koha SQL field names to your LDAP record field names -->
 317                 <firstname    is="givenname"      ></firstname>
 318                 <surname      is="sn"             ></surname>
 319                 <address      is="postaladdress"  ></address>
 320                 <city         is="l"              >Athens, OH</city>
 321                 <zipcode      is="postalcode"     ></zipcode>
 322                 <branchcode   is="branch"         >MAIN</branchcode>
 323                 <userid       is="uid"            ></userid>
 324                 <password     is="userpassword"   ></password>
 325                 <email        is="mail"           ></email>
 326                 <categorycode is="employeetype"   >PT</categorycode>
 327                 <phone        is="telephonenumber"></phone>
 328                 </mapping>
 329         </server>
 330
 331 The <mapping> subelements establish the relationship between mysql fields and LDAP attributes. The element name
 332 is the column in mysql, with the "is" characteristic set to the LDAP attribute name.  Optionally, any content
 333 between the element tags is taken as the default value.  In this example, the default categorycode is "PT" (for
 334 patron).
 335
 336 =cut
 337
 338 # ========================================
 339 # Using attrs instead of {asn}->attributes
 340 # ========================================
 341 #
 342 #       LDAP key: ->{             cn} = ARRAY w/ 3 members.
 343 #       LDAP key: ->{             cn}->{           sss} = sss
 344 #       LDAP key: ->{             cn}->{   Steve Smith} = Steve Smith
 345 #       LDAP key: ->{             cn}->{Steve S. Smith} = Steve S. Smith
 346 #
 347 #       LDAP key: ->{      givenname} = ARRAY w/ 1 members.
 348 #       LDAP key: ->{      givenname}->{Steve} = Steve
 349 #
 350
 351 =head1 SEE ALSO
 352
 353 CGI(3)
 354
 355 Net::LDAP()
 356
 357 XML::Simple()
 358
 359 Digest::MD5(3)
 360
 361 =cut