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::Debug;
  24 use C4::Context;
  25 use C4::Members qw(AddMember changepassword);
  26 use C4::Utils qw( :all );
  27 use Net::LDAP;
  28 use Net::LDAP::Filter;
  29
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
  31
  32 BEGIN {
  33         require Exporter;
  34         $VERSION = 3.03;        # set the version for version checking
  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 = C4::Context->config("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}           ;
  56 $ldappassword = $ldap->{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         if ( $ldap->{auth_by_bind} ) {
 104                 my $user_ldapname = $userldapentry->dn();
 105                 my $user_db = Net::LDAP->new( [$prefhost] );
 106                 $res = $user_db->bind( $user_ldapname, password => $password );
 107                 if ( $res->code ) {
 108                         $debug and warn "Bind as user failed ". description( $res );
 109                         return 0;
 110                 }
 111         } else {
 112                 my $cmpmesg = $db->compare( $userldapentry, attr=>'userpassword', value => $password );
 113                 if ($cmpmesg->code != 6) {
 114                         warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
 115                         return 0;
 116                 }
 117         }
 118         unless ($config{update} or $config{replicate}) {
 119                 return 1;
 120         }
 121         my %borrower = ldap_entry_2_hash($userldapentry,$userid);
 122         $debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
 123         my ($borrowernumber,$cardnumber,$savedpw);
 124         ($borrowernumber,$cardnumber,$userid,$savedpw) = exists_local($userid);
 125         if ($borrowernumber) {
 126                 ($config{update}   ) and my $c2 = &update_local($userid,$password,$borrowernumber,\%borrower) || '';
 127                 ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'";
 128         } else {
 129                 ($config{replicate}) and $borrowernumber = AddMember(%borrower);
 130         }
 131         return(1, $cardnumber);
 132 }
 133
 134 # Pass LDAP entry object and local cardnumber (userid).
 135 # Returns borrower hash.
 136 # Edit KOHA_CONF so $memberhash{'xxx'} fits your ldap structure.
 137 # Ensure that mandatory fields are correctly filled!
 138 #
 139 sub ldap_entry_2_hash ($$) {
 140         my $userldapentry = shift;
 141         my %borrower = ( cardnumber => shift );
 142         my %memberhash;
 143         $userldapentry->exists('uid');  # This is bad, but required!  By side-effect, this initializes the attrs hash.
 144         if ($debug) {
 145                 print STDERR "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump();
 146                 foreach (keys %$userldapentry) {
 147                         print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
 148                         hashdump("LDAP key: ",$userldapentry->{$_});
 149                 }
 150         }
 151         my $x = $userldapentry->{attrs} or return undef;
 152         my $key;
 153         foreach (keys %$x) {
 154                 $memberhash{$_} = join ' ', @{$x->{$_}};
 155                 $debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
 156         }
 157         $debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n",
 158                                         "Referencing \%mapping with ", scalar(keys %mapping), " keys\n";
 159         foreach my $key (keys %mapping) {
 160                 my  $data = $memberhash{$mapping{$key}->{is}};
 161                 $debug and print STDERR printf "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
 162                 unless (defined $data) {
 163                         $data = $mapping{$key}->{content} || '';        # default or failsafe ''
 164                 }
 165                 $borrower{$key} = ($data ne '') ? $data : ' ' ;
 166         }
 167         $borrower{initials} = $memberhash{initials} ||
 168                 ( substr($borrower{'firstname'},0,1)
 169                 . substr($borrower{ 'surname' },0,1)
 170                 . " ");
 171         return %borrower;
 172 }
 173
 174 sub exists_local($) {
 175         my $arg = shift;
 176         my $dbh = C4::Context->dbh;
 177         my $select = "SELECT borrowernumber,cardnumber,userid,password FROM borrowers ";
 178
 179         my $sth = $dbh->prepare("$select WHERE userid=?");      # was cardnumber=?
 180         $sth->execute($arg);
 181         $debug and print STDERR printf "Userid '$arg' exists_local? %s\n", $sth->rows;
 182         ($sth->rows == 1) and return $sth->fetchrow;
 183
 184         $sth = $dbh->prepare("$select WHERE cardnumber=?");
 185         $sth->execute($arg);
 186         $debug and print STDERR printf "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
 187         ($sth->rows == 1) and return $sth->fetchrow;
 188         return 0;
 189 }
 190
 191 sub update_local($$$$) {
 192         my   $userid   = shift             or return undef;
 193         my   $digest   = md5_base64(shift) or return undef;
 194         my $borrowerid = shift             or return undef;
 195         my $borrower   = shift             or return undef;
 196         my @keys = keys %$borrower;
 197         my $dbh = C4::Context->dbh;
 198         my $query = "UPDATE  borrowers\nSET     " .
 199                 join(',', map {"$_=?"} @keys) .
 200                 "\nWHERE   borrowernumber=? ";
 201         my $sth = $dbh->prepare($query);
 202         if ($debug) {
 203                 print STDERR $query, "\n",
 204                         join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys;
 205                 print STDERR "\nuserid = $userid\n";
 206         }
 207         $sth->execute(
 208                 ((map {$borrower->{$_}} @keys), $borrowerid)
 209         );
 210
 211         # MODIFY PASSWORD/LOGIN
 212         # search borrowerid
 213         $debug and print STDERR "changing local password for borrowernumber=$borrowerid to '$digest'\n";
 214         changepassword($userid, $borrowerid, $digest);
 215
 216         # Confirm changes
 217         $sth = $dbh->prepare("SELECT password,cardnumber FROM borrowers WHERE borrowernumber=? ");
 218         $sth->execute($borrowerid);
 219         if ($sth->rows) {
 220                 my ($md5password, $cardnum) = $sth->fetchrow;
 221         ($digest eq $md5password) and return $cardnum;
 222                 warn "Password mismatch after update to cardnumber=$cardnum (borrowernumber=$borrowerid)";
 223                 return undef;
 224         }
 225         die "Unexpected error after password update to userid/borrowernumber: $userid / $borrowerid.";
 226 }
 227
 228 1;
 229 __END__
 230
 231 =head1 NAME
 232
 233 C4::Auth - Authenticates Koha users
 234
 235 =head1 SYNOPSIS
 236
 237   use C4::Auth_with_ldap;
 238
 239 =head1 LDAP Configuration
 240
 241     This module is specific to LDAP authentification. It requires Net::LDAP package and one or more
 242         working LDAP servers.
 243         To use it :
 244            * Modify ldapserver element in KOHA_CONF
 245            * Establish field mapping in <mapping> element.
 246
 247         For example, if your user records are stored according to the inetOrgPerson schema, RFC#2798,
 248         the username would match the "uid" field, and the password should match the "userpassword" field.
 249
 250         Make sure that ALL required fields are populated by your LDAP database (and mapped in KOHA_CONF).
 251         What are the required fields?  Well, in mysql you can check the database table "borrowers" like this:
 252
 253         mysql> show COLUMNS from borrowers;
 254                 +------------------+--------------+------+-----+---------+----------------+
 255                 | Field            | Type         | Null | Key | Default | Extra          |
 256                 +------------------+--------------+------+-----+---------+----------------+
 257                 | borrowernumber   | int(11)      | NO   | PRI | NULL    | auto_increment |
 258                 | cardnumber       | varchar(16)  | YES  | UNI | NULL    |                |
 259                 | surname          | mediumtext   | NO   |     |         |                |
 260                 | firstname        | text         | YES  |     | NULL    |                |
 261                 | title            | mediumtext   | YES  |     | NULL    |                |
 262                 | othernames       | mediumtext   | YES  |     | NULL    |                |
 263                 | initials         | text         | YES  |     | NULL    |                |
 264                 | streetnumber     | varchar(10)  | YES  |     | NULL    |                |
 265                 | streettype       | varchar(50)  | YES  |     | NULL    |                |
 266                 | address          | mediumtext   | NO   |     |         |                |
 267                 | address2         | text         | YES  |     | NULL    |                |
 268                 | city             | mediumtext   | NO   |     |         |                |
 269                 | zipcode          | varchar(25)  | YES  |     | NULL    |                |
 270                 | email            | mediumtext   | YES  |     | NULL    |                |
 271                 | phone            | text         | YES  |     | NULL    |                |
 272                 | mobile           | varchar(50)  | YES  |     | NULL    |                |
 273                 | fax              | mediumtext   | YES  |     | NULL    |                |
 274                 | emailpro         | text         | YES  |     | NULL    |                |
 275                 | phonepro         | text         | YES  |     | NULL    |                |
 276                 | B_streetnumber   | varchar(10)  | YES  |     | NULL    |                |
 277                 | B_streettype     | varchar(50)  | YES  |     | NULL    |                |
 278                 | B_address        | varchar(100) | YES  |     | NULL    |                |
 279                 | B_city           | mediumtext   | YES  |     | NULL    |                |
 280                 | B_zipcode        | varchar(25)  | YES  |     | NULL    |                |
 281                 | B_email          | text         | YES  |     | NULL    |                |
 282                 | B_phone          | mediumtext   | YES  |     | NULL    |                |
 283                 | dateofbirth      | date         | YES  |     | NULL    |                |
 284                 | branchcode       | varchar(10)  | NO   | MUL |         |                |
 285                 | categorycode     | varchar(10)  | NO   | MUL |         |                |
 286                 | dateenrolled     | date         | YES  |     | NULL    |                |
 287                 | dateexpiry       | date         | YES  |     | NULL    |                |
 288                 | gonenoaddress    | tinyint(1)   | YES  |     | NULL    |                |
 289                 | lost             | tinyint(1)   | YES  |     | NULL    |                |
 290                 | debarred         | tinyint(1)   | YES  |     | NULL    |                |
 291                 | contactname      | mediumtext   | YES  |     | NULL    |                |
 292                 | contactfirstname | text         | YES  |     | NULL    |                |
 293                 | contacttitle     | text         | YES  |     | NULL    |                |
 294                 | guarantorid      | int(11)      | YES  |     | NULL    |                |
 295                 | borrowernotes    | mediumtext   | YES  |     | NULL    |                |
 296                 | relationship     | varchar(100) | YES  |     | NULL    |                |
 297                 | ethnicity        | varchar(50)  | YES  |     | NULL    |                |
 298                 | ethnotes         | varchar(255) | YES  |     | NULL    |                |
 299                 | sex              | varchar(1)   | YES  |     | NULL    |                |
 300                 | password         | varchar(30)  | YES  |     | NULL    |                |
 301                 | flags            | int(11)      | YES  |     | NULL    |                |
 302                 | userid           | varchar(30)  | YES  | MUL | NULL    |                |  # UNIQUE in next release.
 303                 | opacnote         | mediumtext   | YES  |     | NULL    |                |
 304                 | contactnote      | varchar(255) | YES  |     | NULL    |                |
 305                 | sort1            | varchar(80)  | YES  |     | NULL    |                |
 306                 | sort2            | varchar(80)  | YES  |     | NULL    |                |
 307                 +------------------+--------------+------+-----+---------+----------------+
 308                 50 rows in set (0.01 sec)
 309
 310                 Where Null="NO", the field is required.
 311
 312 =cut
 313
 314 =head1 KOHA_CONF and field mapping
 315
 316 Example XML stanza for LDAP configuration in KOHA_CONF.
 317
 318  <config>
 319   ...
 320   <useldapserver>1</useldapserver>
 321   <!-- LDAP SERVER (optional) -->
 322   <ldapserver id="ldapserver">
 323     <hostname>localhost</hostname>
 324     <base>dc=metavore,dc=com</base>
 325     <user>cn=Manager,dc=metavore,dc=com</user>             <!-- DN, if not anonymous -->
 326     <pass>metavore</pass>      <!-- password, if not anonymous -->
 327     <replicate>1</replicate>   <!-- add new users from LDAP to Koha database -->
 328     <update>1</update>         <!-- update existing users in Koha database -->
 329     <mapping>                  <!-- match koha SQL field names to your LDAP record field names -->
 330       <firstname    is="givenname"      ></firstname>
 331       <surname      is="sn"             ></surname>
 332       <address      is="postaladdress"  ></address>
 333       <city         is="l"              >Athens, OH</city>
 334       <zipcode      is="postalcode"     ></zipcode>
 335       <branchcode   is="branch"         >MAIN</branchcode>
 336       <userid       is="uid"            ></userid>
 337       <password     is="userpassword"   ></password>
 338       <email        is="mail"           ></email>
 339       <categorycode is="employeetype"   >PT</categorycode>
 340       <phone        is="telephonenumber"></phone>
 341     </mapping>
 342   </ldapserver>
 343  </config>
 344
 345 The <mapping> subelements establish the relationship between mysql fields and LDAP attributes. The element name
 346 is the column in mysql, with the "is" characteristic set to the LDAP attribute name.  Optionally, any content
 347 between the element tags is taken as the default value.  In this example, the default categorycode is "PT" (for
 348 patron).
 349
 350 =cut
 351
 352 # ========================================
 353 # Using attrs instead of {asn}->attributes
 354 # ========================================
 355 #
 356 #       LDAP key: ->{             cn} = ARRAY w/ 3 members.
 357 #       LDAP key: ->{             cn}->{           sss} = sss
 358 #       LDAP key: ->{             cn}->{   Steve Smith} = Steve Smith
 359 #       LDAP key: ->{             cn}->{Steve S. Smith} = Steve S. Smith
 360 #
 361 #       LDAP key: ->{      givenname} = ARRAY w/ 1 members.
 362 #       LDAP key: ->{      givenname}->{Steve} = Steve
 363 #
 364
 365 =head1 SEE ALSO
 366
 367 CGI(3)
 368
 369 Net::LDAP()
 370
 371 XML::Simple()
 372
 373 Digest::MD5(3)
 374
 375 =cut