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