1 package C4::Auth_with_ldap;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
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
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.
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
21 use Digest::MD5 qw(md5_base64);
24 use C4::Members qw(AddMember );
27 use Net::LDAP::Filter;
28 # use Net::LDAP qw(:all);
30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
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 );
42 C4::Auth - Authenticates Koha users
46 use C4::Auth_with_ldap;
50 This module is specific to LDAP authentification. It requires Net::LDAP package and one or more
53 * modify the code between LOCAL and /LOCAL to fit your LDAP server parameters & fields.
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.
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
68 firstname => 'givenName',
71 branchcode => 'branch',
72 emailaddress => 'mail',
73 categorycode => 'employeeType',
75 phone => 'telephoneNumber',
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';
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
90 my $result = shift or return undef;
91 return "LDAP error #" . $result->code
92 . ": " . $result->error_name . "\n"
93 . "# " . $result->error_text . "\n";
97 my ($dbh, $userid, $password) = @_;
98 if ( $userid eq C4::Context->config('user')
99 && $password eq C4::Context->config('pass') )
101 return 2; # Koha superuser account
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);
111 my $search = $db->search(
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);
122 warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count);
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);
132 unless($config{update} or $config{replicate}) {
135 my %borrower = ldap_entry_2_hash($userldapentry,$userid);
136 if (exists_local($userid)) {
137 ($config{update} ) and &update_local($userid,$password,%borrower);
139 ($config{replicate}) and AddMember(%borrower);
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!
149 sub ldap_entry_2_hash ($$) {
150 my $userldapentry = shift;
151 my %borrower = ( cardnumber => shift );
153 my $x = $userldapentry->{asn}{attributes} or return undef;
155 foreach my $k (@$x) {
156 foreach my $k2 ( keys %$k ) {
160 $memberhash{$key} .= map {$_ . " "} @$k{$k2};
164 foreach my $key (%mapping) {
165 my $data = $memberhash{$mapping{$key}};
166 defined $data or $data = ' ';
167 $borrower{$key} = ($data ne '') ? $data : ' ' ;
169 $borrower{initials} = $memberhash{initials} ||
170 ( substr($borrower{'firstname'},0,1)
171 . substr($borrower{ 'surname' },0,1)
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 ;
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("
190 SET firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=?
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},
202 # MODIFY PASSWORD/LOGIN
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);
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.";
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);
225 my ($md5password, $othernum) = $sth->fetchrow;
226 ($digest eq $md5password) and return $othernum;
227 warn "Password mismatch after update to userid=$userid";
230 warn "Could not recover record after updating password for userid=$userid";