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( checkauth );
  37 }
  38
  39 =head1 NAME
  40
  41 C4::Auth - Authenticates Koha users
  42
  43 =head1 SYNOPSIS
  44
  45   use C4::Auth_with_ldap;
  46
  47 =head1 LDAP specific
  48
  49     This module is specific to LDAP authentification. It requires Net::LDAP package and one or more
  50         working LDAP servers.
  51         To use it :
  52            * Modify ldapserver and ldapinfos via web "Preferences".
  53            * Modify the values (right side) of %mapping pairs, to match your LDAP fields.
  54            * Modify $ldapname and $ldappassword, if required.
  55
  56         It is assumed your user records are stored according to the inetOrgPerson schema, RFC#2798.
  57         Thus the username must match the "uid" field, and the password must match the "userPassword" field.
  58
  59         Make sure that the required fields are populated in your LDAP database.  What are they?  Well, in
  60         mysql you can check the database table "borrowers" like this:
  61
  62         mysql> show COLUMNS from borrowers;
  63                 +------------------+--------------+------+-----+---------+----------------+
  64                 | Field            | Type         | Null | Key | Default | Extra          |
  65                 +------------------+--------------+------+-----+---------+----------------+
  66                 | borrowernumber   | int(11)      | NO   | PRI | NULL    | auto_increment |
  67                 | cardnumber       | varchar(16)  | YES  | UNI | NULL    |                |
  68                 | surname          | mediumtext   | NO   |     |         |                |
  69                 | firstname        | text         | YES  |     | NULL    |                |
  70                 | title            | mediumtext   | YES  |     | NULL    |                |
  71                 | othernames       | mediumtext   | YES  |     | NULL    |                |
  72                 | initials         | text         | YES  |     | NULL    |                |
  73                 | streetnumber     | varchar(10)  | YES  |     | NULL    |                |
  74                 | streettype       | varchar(50)  | YES  |     | NULL    |                |
  75                 | address          | mediumtext   | NO   |     |         |                |
  76                 | address2         | text         | YES  |     | NULL    |                |
  77                 | city             | mediumtext   | NO   |     |         |                |
  78                 | zipcode          | varchar(25)  | YES  |     | NULL    |                |
  79                 | email            | mediumtext   | YES  |     | NULL    |                |
  80                 | phone            | text         | YES  |     | NULL    |                |
  81                 | mobile           | varchar(50)  | YES  |     | NULL    |                |
  82                 | fax              | mediumtext   | YES  |     | NULL    |                |
  83                 | emailpro         | text         | YES  |     | NULL    |                |
  84                 | phonepro         | text         | YES  |     | NULL    |                |
  85                 | B_streetnumber   | varchar(10)  | YES  |     | NULL    |                |
  86                 | B_streettype     | varchar(50)  | YES  |     | NULL    |                |
  87                 | B_address        | varchar(100) | YES  |     | NULL    |                |
  88                 | B_city           | mediumtext   | YES  |     | NULL    |                |
  89                 | B_zipcode        | varchar(25)  | YES  |     | NULL    |                |
  90                 | B_email          | text         | YES  |     | NULL    |                |
  91                 | B_phone          | mediumtext   | YES  |     | NULL    |                |
  92                 | dateofbirth      | date         | YES  |     | NULL    |                |
  93                 | branchcode       | varchar(10)  | NO   | MUL |         |                |
  94                 | categorycode     | varchar(10)  | NO   | MUL |         |                |
  95                 | dateenrolled     | date         | YES  |     | NULL    |                |
  96                 | dateexpiry       | date         | YES  |     | NULL    |                |
  97                 | gonenoaddress    | tinyint(1)   | YES  |     | NULL    |                |
  98                 | lost             | tinyint(1)   | YES  |     | NULL    |                |
  99                 | debarred         | tinyint(1)   | YES  |     | NULL    |                |
 100                 | contactname      | mediumtext   | YES  |     | NULL    |                |
 101                 | contactfirstname | text         | YES  |     | NULL    |                |
 102                 | contacttitle     | text         | YES  |     | NULL    |                |
 103                 | guarantorid      | int(11)      | YES  |     | NULL    |                |
 104                 | borrowernotes    | mediumtext   | YES  |     | NULL    |                |
 105                 | relationship     | varchar(100) | YES  |     | NULL    |                |
 106                 | ethnicity        | varchar(50)  | YES  |     | NULL    |                |
 107                 | ethnotes         | varchar(255) | YES  |     | NULL    |                |
 108                 | sex              | varchar(1)   | YES  |     | NULL    |                |
 109                 | password         | varchar(30)  | YES  |     | NULL    |                |
 110                 | flags            | int(11)      | YES  |     | NULL    |                |
 111                 | userid           | varchar(30)  | YES  | MUL | NULL    |                |
 112                 | opacnote         | mediumtext   | YES  |     | NULL    |                |
 113                 | contactnote      | varchar(255) | YES  |     | NULL    |                |
 114                 | sort1            | varchar(80)  | YES  |     | NULL    |                |
 115                 | sort2            | varchar(80)  | YES  |     | NULL    |                |
 116                 +------------------+--------------+------+-----+---------+----------------+
 117                 50 rows in set (0.01 sec)
 118
 119                 Then %mappings establishes the relationship between mysql field and LDAP attribute.
 120
 121 =cut
 122
 123 # Redefine checkauth:
 124 # connect to LDAP (named or anonymous)
 125 # ~ retrieves $userid from "uid"
 126 # ~ then compares $password with userPassword
 127 # ~ then gets the LDAP entry
 128 # ~ and calls the memberadd if necessary
 129
 130 sub ldapserver_error ($) {
 131         return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
 132 }
 133
 134 use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
 135 my $context = C4::Context->new()        or die 'C4::Context->new failed';
 136 my $ldap = $context->{server}->{ldapserver}     or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
 137 my $prefhost  = $ldap->{hostname}       or die ldapserver_error('hostname');
 138 my $base      = $ldap->{base}           or die ldapserver_error('base');
 139 $ldapname     = $ldap->{user}           or die ldapserver_error('user');
 140 $ldappassword = $ldap->{pass}           or die ldapserver_error('pass');
 141 our %mapping  = %{$ldap->{mapping}}     or die ldapserver_error('mapping');
 142 my @mapkeys = keys %mapping;
 143 print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (  total  ): ", join ' ', @mapkeys, "\n";
 144 @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
 145 print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n";
 146
 147 my %config = (
 148         anonymous => ($ldapname and $ldappassword) ? 0 : 1,
 149         replicate => $ldap->{replicate} || 1,           #    add from LDAP to Koha database for new user
 150            update => $ldap->{update}    || 1,           # update from LDAP to Koha database for existing user
 151 );
 152
 153 sub description ($) {
 154         my $result = shift or return undef;
 155         return "LDAP error #" . $result->code
 156                         . ": " . $result->error_name . "\n"
 157                         . "# " . $result->error_text . "\n";
 158 }
 159
 160 sub checkauth {
 161     my ($dbh, $userid, $password) = @_;
 162     if (   $userid   eq C4::Context->config('user')
 163         && $password eq C4::Context->config('pass') )
 164     {
 165         return 2;       # Koha superuser account
 166     }
 167     my $db = Net::LDAP->new([$prefhost]);
 168         #$debug and $db->debug(5);
 169         my $filter = Net::LDAP::Filter->new("uid=$userid") or die "Failed to create new Net::LDAP::Filter";
 170     my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
 171     if ($res->code) {           # connection refused
 172         warn "LDAP bind failed as $ldapname: " . description($res);
 173         return 0;
 174     }
 175         my $search = $db->search(
 176                   base => $base,
 177                 filter => $filter,
 178                 # attrs => ['*'],
 179         ) or die "LDAP search failed to return object.";
 180         my $count = $search->count;
 181         if ($search->code > 0) {
 182                 warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count) . description($search);
 183                 return 0;
 184         }
 185         if ($count != 1) {
 186                 warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count);
 187                 return 0;
 188         }
 189
 190         my $userldapentry = $search->shift_entry;
 191         my $cmpmesg = $db->compare( $userldapentry, attr=>'userPassword', value => $password );
 192         if($cmpmesg->code != 6) {
 193                 warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
 194                 return 0;
 195         }
 196         unless($config{update} or $config{replicate}) {
 197                 return 1;
 198         }
 199         my %borrower = ldap_entry_2_hash($userldapentry,$userid);
 200         if (exists_local($userid)) {
 201                 ($config{update}   ) and &update_local($userid,$password,%borrower);
 202         } else {
 203                 ($config{replicate}) and warn "Replicating!!" and AddMember(%borrower);
 204         }
 205         return 1;
 206 }
 207
 208 # Pass LDAP entry object and local cardnumber (userid).
 209 # Returns borrower hash.
 210 # Edit KOHA_CONF so $memberhash{'xxx'} fits your ldap structure.
 211 # Ensure that mandatory fields are correctly filled!
 212 #
 213 sub ldap_entry_2_hash ($$) {
 214         my $userldapentry = shift;
 215         my %borrower = ( cardnumber => shift );
 216         my %memberhash;
 217         print "keys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n";
 218         print $userldapentry->dump();
 219         foreach (keys %$userldapentry) {
 220                 print "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
 221                 hashdump("LDAP key: ",$userldapentry->{$_});
 222         }
 223         warn "->{asn}->{attributes} : " . $userldapentry->{asn}->{attributes} ;
 224         my $x = $userldapentry->{asn}->{attributes} or return undef;
 225         my $key;
 226
 227 # asn   (HASH)
 228 # LDAP key: ->{attributes} = ARRAY w/ 17 members.
 229 # LDAP key: ->{attributes}->{HASH(0x9234290)} = HASH w/ 2 keys.
 230 # LDAP key: ->{attributes}->{HASH(0x9234290)}->{type} = cn
 231 # LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals} = ARRAY w/ 3 members.
 232 # LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{           sss} = sss
 233 # LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{   Steve Smith} = Steve Smith
 234 # LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{Steve S. Smith} = Steve S. Smith
 235 #                                       $x                              $anon
 236 # LDAP key: ->{attributes}->{HASH(0x9234490)} = HASH w/ 2 keys.
 237 # LDAP key: ->{attributes}->{HASH(0x9234490)}->{type} = o
 238 # LDAP key: ->{attributes}->{HASH(0x9234490)}->{vals} = ARRAY w/ 1 members.
 239 # LDAP key: ->{attributes}->{HASH(0x9234490)}->{vals}->{metavore} = metavore
 240 #                        $x=([ cn=>['sss','Steve Smith','Steve S. Smith'], sss, o=>['metavore'], ])
 241 # . . . . .
 242
 243         foreach my $anon (@$x) {
 244                 $key = $anon->{type} or next;
 245                 $memberhash{$key} = join " ", @{$anon->{vals}};
 246         }
 247         foreach my $key (keys %mapping) {
 248                 my  $data = $memberhash{$mapping{$key}->{is}};
 249                 unless (defined $data) {
 250                         $data = $mapping{$key}->{content} || '';        # default or failsafe ''
 251                 }
 252                 $borrower{$key} = ($data ne '') ? $data : ' ' ;
 253         }
 254         $borrower{initials} = $memberhash{initials} ||
 255                 ( substr($borrower{'firstname'},0,1)
 256                 . substr($borrower{ 'surname' },0,1)
 257                 . "  ");
 258         return %borrower;
 259 }
 260
 261 sub exists_local($) {
 262         my $sth = C4::Context->dbh->prepare("SELECT password from borrowers WHERE cardnumber=?");
 263         $sth->execute(shift);
 264         return ($sth->rows) ? 1 : 0 ;
 265 }
 266
 267 sub update_local($$%) {
 268         # warn "MODIFY borrower";
 269         my   $userid = shift or return undef;
 270         my   $digest = md5_base64(shift) or return undef;
 271         my %borrower = shift or return undef;
 272         my $dbh = C4::Context->dbh;
 273         my $sth = $dbh->prepare("
 274 UPDATE  borrowers
 275 SET     firstname=?,surname=?,initials=?,address=?,city=?,phone=?, categorycode=?,branchcode=?,email=?,sort1=?
 276 WHERE   cardnumber=?
 277         ");
 278         $sth->execute(
 279                 $borrower{firstname},    $borrower{surname},
 280                 $borrower{initials},     $borrower{address},
 281                 $borrower{city},         $borrower{phone},
 282                 $borrower{categorycode}, $borrower{branchcode},
 283                 $borrower{email},                $borrower{sort1},
 284                 $userid
 285         );
 286
 287         # MODIFY PASSWORD/LOGIN
 288         # search borrowerid
 289         $sth = $dbh->prepare("SELECT borrowernumber from borrowers WHERE cardnumber=? ");
 290         $sth->execute($userid);
 291         my ($borrowerid) = $sth->fetchrow;
 292         # warn "change local password for $borrowerid setting $password";
 293         changepassword($userid, $borrowerid, $digest);
 294
 295         # Confirm changes
 296         my $cardnumber;
 297         $sth = $dbh->prepare("SELECT password,cardnumber from borrowers WHERE userid=? ");
 298         $cardnumber = confirmer($sth,$userid,$digest) and return $cardnumber;
 299     $sth = $dbh->prepare("SELECT password,cardnumber from borrowers WHERE cardnumber=? ");
 300         $cardnumber = confirmer($sth,$userid,$digest) and return $cardnumber;
 301         die "Unexpected error after password update to $userid / $cardnumber.";
 302 }
 303
 304 sub confirmer($$$) {
 305         my    $sth = shift or return undef;
 306         my $userid = shift or return undef;
 307         my $digest = shift or return undef;
 308         $sth->execute($userid);
 309         if ($sth->rows) {
 310                 my ($md5password, $othernum) = $sth->fetchrow;
 311         ($digest eq $md5password) and return $othernum;
 312                 warn "Password mismatch after update to userid=$userid";
 313                 return undef;
 314     }
 315         warn "Could not recover record after updating password for userid=$userid";
 316         return 0;
 317 }
 318 1;
 319 __END__
 320
 321 =back
 322
 323 =head1 SEE ALSO
 324
 325 CGI(3)
 326
 327 Net::LDAP()
 328
 329 Digest::MD5(3)
 330
 331 =cut