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