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 );
  25
  26 use Net::LDAP;
  27 use Net::LDAP::Filter;
  28 # use Net::LDAP qw(:all);
  29
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31
  32 BEGIN {
  33         require Exporter;
  34         $VERSION = 3.01;        # set the version for version checking
  35         our $debug = $ENV{DEBUG} || 0;
  36         @ISA    = qw(Exporter C4::Auth);
  37         @EXPORT = qw( checkauth );
  38 }
  39
  40 =head1 NAME
  41
  42 C4::Auth - Authenticates Koha users
  43
  44 =head1 SYNOPSIS
  45
  46   use C4::Auth_with_ldap;
  47
  48 =head1 LDAP specific
  49
  50     This module is specific to LDAP authentification. It requires Net::LDAP package and one or more
  51         working LDAP servers.
  52         To use it :
  53            * modify the code between LOCAL and /LOCAL to fit your LDAP server parameters & fields.
  54
  55         It is assumed your user records are stored according to the inetOrgPerson schema, RFC#2798.
  56         Thus the username must match the "uid" field, and the password must match the "userPassword" field.
  57
  58 =cut
  59
  60 # Redefine checkauth:
  61 # connect to LDAP (named or anonymous)
  62 # ~ retrieves $userid from "uid"
  63 # ~ then compares $password with userPassword
  64 # ~ then gets the LDAP entry
  65 # ~ and calls the memberadd if necessary
  66
  67 my %mapping = (
  68         firstname     => 'givenName',
  69         surname       => 'sn',
  70         streetaddress => 'l',
  71         branchcode    => 'branch',
  72         emailaddress  => 'mail',
  73         categorycode  => 'employeeType',
  74         city          => 'null',
  75         phone         => 'telephoneNumber',
  76 );
  77
  78 my (@ldaphosts) = (qw(localhost));              # potentially multiple LDAP hosts!
  79 my $base = "dc=metavore,dc=com";
  80 my $ldapname = "cn=Manager,$base";              # The LDAP user.
  81 my $ldappassword = 'metavore';
  82
  83 my %config = (
  84         anonymous => ($ldapname and $ldappassword) ? 0 : 1,
  85         replicate => 0,         #    add from LDAP to Koha database for new user
  86            update => 0,         # update from LDAP to Koha database for existing user
  87 );
  88
  89 sub description ($) {
  90         my $result = shift or return undef;
  91         return "LDAP error #" . $result->code
  92                         . ": " . $result->error_name . "\n"
  93                         . "# " . $result->error_text . "\n";
  94 }
  95
  96 sub checkauth {
  97     my ($dbh, $userid, $password) = @_;
  98     if (   $userid   eq C4::Context->config('user')
  99         && $password eq C4::Context->config('pass') )
 100     {
 101         return 2;       # Koha superuser account
 102     }
 103     my $db = Net::LDAP->new(\@ldaphosts);
 104         #$debug and $db->debug(5);
 105         my $filter = Net::LDAP::Filter->new("uid=$userid") or die "Failed to create new Net::LDAP::Filter";
 106     my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
 107     if ($res->code) {           # connection refused
 108         warn "LDAP bind failed as $ldapname: " . description($res);
 109         return 0;
 110     }
 111         my $search = $db->search(
 112                   base => $base,
 113                 filter => $filter,
 114                 # attrs => ['*'],
 115         ) or die "LDAP search failed to return object.";
 116         my $count = $search->count;
 117         if ($search->code > 0) {
 118                 warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count) . description($search);
 119                 return 0;
 120         }
 121         if ($count != 1) {
 122                 warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count);
 123                 return 0;
 124         }
 125
 126         my $userldapentry = $search->shift_entry;
 127         my $cmpmesg = $db->compare( $userldapentry, attr=>'userPassword', value => $password );
 128         if($cmpmesg->code != 6) {
 129                 warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
 130                 return 0;
 131         }
 132         unless($config{update} or $config{replicate}) {
 133                 return 1;
 134         }
 135         my %borrower = ldap_entry_2_hash($userldapentry,$userid);
 136         if (exists_local($userid)) {
 137                 ($config{update}   ) and &update_local($userid,$password,%borrower);
 138         } else {
 139                 ($config{replicate}) and AddMember(%borrower);
 140         }
 141         return 1;
 142 }
 143
 144 # Pass LDAP entry object and local cardnumber (userid).
 145 # Returns borrower hash.
 146 # Edit %mapping so $memberhash{'xxx'} fits your ldap structure.
 147 # Ensure that mandatory fields are correctly filled!
 148 #
 149 sub ldap_entry_2_hash ($$) {
 150         my $userldapentry = shift;
 151         my %borrower = ( cardnumber => shift );
 152         my %memberhash;
 153         my $x = $userldapentry->{asn}{attributes} or return undef;
 154         my $key;
 155         foreach my $k (@$x) {
 156                 foreach my $k2 ( keys %$k ) {
 157                         if ($k2 eq 'type') {
 158                                 $key = $$k{$k2};
 159                         } else {
 160                                 $memberhash{$key} .= map {$_ . " "} @$k{$k2};
 161                         }
 162                 }
 163         }
 164         foreach my $key (%mapping) {
 165                 my $data = $memberhash{$mapping{$key}};
 166                 defined $data or $data = ' ';
 167                 $borrower{$key} = ($data ne '') ? $data : ' ' ;
 168         }
 169         $borrower{initials} = $memberhash{initials} ||
 170                 ( substr($borrower{'firstname'},0,1)
 171                 . substr($borrower{ 'surname' },0,1)
 172                 . "  ");
 173         return %borrower;
 174 }
 175
 176 sub exists_local($) {
 177         my $sth = C4::Context->dbh->prepare("SELECT password from borrowers WHERE cardnumber=?");
 178         $sth->execute(shift);
 179         return ($sth->rows) ? 1 : 0 ;
 180 }
 181
 182 sub update_local($$%) {
 183         # warn "MODIFY borrower";
 184         my   $userid = shift or return undef;
 185         my   $digest = md5_base64(shift) or return undef;
 186         my %borrower = shift or return undef;
 187         my $dbh = C4::Context->dbh;
 188         my $sth = $dbh->prepare("
 189 UPDATE  borrowers
 190 SET     firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=?
 191 WHERE   cardnumber=?
 192         ");
 193         $sth->execute(
 194                 $borrower{firstname},    $borrower{surname},
 195                 $borrower{initials},     $borrower{streetaddress},
 196                 $borrower{city},         $borrower{phone},
 197                 $borrower{categorycode}, $borrower{branchcode},
 198                 $borrower{emailaddress}, $borrower{sort1},
 199                 $userid
 200         );
 201
 202         # MODIFY PASSWORD/LOGIN
 203         # search borrowerid
 204         $sth = $dbh->prepare("SELECT borrowernumber from borrowers WHERE cardnumber=? ");
 205         $sth->execute($userid);
 206         my ($borrowerid) = $sth->fetchrow;
 207         # warn "change local password for $borrowerid setting $password";
 208         changepassword($userid, $borrowerid, $digest);
 209
 210         # Confirm changes
 211         my $cardnumber;
 212         $sth = $dbh->prepare("SELECT password,cardnumber from borrowers WHERE userid=? ");
 213         $cardnumber = confirmer($sth,$userid,$digest) and return $cardnumber;
 214     $sth = $dbh->prepare("SELECT password,cardnumber from borrowers WHERE cardnumber=? ");
 215         $cardnumber = confirmer($sth,$userid,$digest) and return $cardnumber;
 216         die "Unexpected error after password update to $userid / $cardnumber.";
 217 }
 218
 219 sub confirmer($$) {
 220         my    $sth = shift or return undef;
 221         my $userid = shift or return undef;
 222         my $digest = shift or return undef;
 223         $sth->execute($userid);
 224         if ($sth->rows) {
 225                 my ($md5password, $othernum) = $sth->fetchrow;
 226         ($digest eq $md5password) and return $othernum;
 227                 warn "Password mismatch after update to userid=$userid";
 228                 return undef;
 229     }
 230         warn "Could not recover record after updating password for userid=$userid";
 231         return 0;
 232 }
 233 1;
 234 __END__
 235
 236 =back
 237
 238 =head1 SEE ALSO
 239
 240 CGI(3)
 241
 242 Net::LDAP()
 243
 244 Digest::MD5(3)
 245
 246 =cut