d8237895cd
Signed-off-by: Chris Cormack <crc@liblime.com> Signed-off-by: Joshua Ferraro <jmf@liblime.com>
321 lines
12 KiB
Perl
321 lines
12 KiB
Perl
package C4::Auth_with_ldap;
|
|
|
|
# Copyright 2000-2002 Katipo Communications
|
|
#
|
|
# This file is part of Koha.
|
|
#
|
|
# Koha is free software; you can redistribute it and/or modify it under the
|
|
# terms of the GNU General Public License as published by the Free Software
|
|
# Foundation; either version 2 of the License, or (at your option) any later
|
|
# version.
|
|
#
|
|
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
|
|
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License along with
|
|
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
|
|
# Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
use strict;
|
|
use Digest::MD5 qw(md5_base64);
|
|
|
|
use C4::Context;
|
|
use C4::Members qw(AddMember );
|
|
|
|
use Net::LDAP;
|
|
use Net::LDAP::Filter;
|
|
# use Net::LDAP qw(:all);
|
|
|
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
|
|
|
BEGIN {
|
|
require Exporter;
|
|
$VERSION = 3.01; # set the version for version checking
|
|
our $debug = $ENV{DEBUG} || 0;
|
|
@ISA = qw(Exporter C4::Auth);
|
|
@EXPORT = qw( checkauth );
|
|
}
|
|
|
|
=head1 NAME
|
|
|
|
C4::Auth - Authenticates Koha users
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use C4::Auth_with_ldap;
|
|
|
|
=head1 LDAP specific
|
|
|
|
This module is specific to LDAP authentification. It requires Net::LDAP package and one or more
|
|
working LDAP servers.
|
|
To use it :
|
|
* Modify ldapserver and ldapinfos via web "Preferences".
|
|
* Modify the values (right side) of %mapping pairs, to match your LDAP fields.
|
|
* Modify $ldapname and $ldappassword, if required.
|
|
|
|
It is assumed your user records are stored according to the inetOrgPerson schema, RFC#2798.
|
|
Thus the username must match the "uid" field, and the password must match the "userPassword" field.
|
|
|
|
Make sure that the required fields are populated in your LDAP database. What are they? Well, in
|
|
mysql you can check the database table "borrowers" like this:
|
|
|
|
mysql> show COLUMNS from borrowers;
|
|
+------------------+--------------+------+-----+---------+----------------+
|
|
| Field | Type | Null | Key | Default | Extra |
|
|
+------------------+--------------+------+-----+---------+----------------+
|
|
| borrowernumber | int(11) | NO | PRI | NULL | auto_increment |
|
|
| cardnumber | varchar(16) | YES | UNI | NULL | |
|
|
| surname | mediumtext | NO | | | |
|
|
| firstname | text | YES | | NULL | |
|
|
| title | mediumtext | YES | | NULL | |
|
|
| othernames | mediumtext | YES | | NULL | |
|
|
| initials | text | YES | | NULL | |
|
|
| streetnumber | varchar(10) | YES | | NULL | |
|
|
| streettype | varchar(50) | YES | | NULL | |
|
|
| address | mediumtext | NO | | | |
|
|
| address2 | text | YES | | NULL | |
|
|
| city | mediumtext | NO | | | |
|
|
| zipcode | varchar(25) | YES | | NULL | |
|
|
| email | mediumtext | YES | | NULL | |
|
|
| phone | text | YES | | NULL | |
|
|
| mobile | varchar(50) | YES | | NULL | |
|
|
| fax | mediumtext | YES | | NULL | |
|
|
| emailpro | text | YES | | NULL | |
|
|
| phonepro | text | YES | | NULL | |
|
|
| B_streetnumber | varchar(10) | YES | | NULL | |
|
|
| B_streettype | varchar(50) | YES | | NULL | |
|
|
| B_address | varchar(100) | YES | | NULL | |
|
|
| B_city | mediumtext | YES | | NULL | |
|
|
| B_zipcode | varchar(25) | YES | | NULL | |
|
|
| B_email | text | YES | | NULL | |
|
|
| B_phone | mediumtext | YES | | NULL | |
|
|
| dateofbirth | date | YES | | NULL | |
|
|
| branchcode | varchar(10) | NO | MUL | | |
|
|
| categorycode | varchar(10) | NO | MUL | | |
|
|
| dateenrolled | date | YES | | NULL | |
|
|
| dateexpiry | date | YES | | NULL | |
|
|
| gonenoaddress | tinyint(1) | YES | | NULL | |
|
|
| lost | tinyint(1) | YES | | NULL | |
|
|
| debarred | tinyint(1) | YES | | NULL | |
|
|
| contactname | mediumtext | YES | | NULL | |
|
|
| contactfirstname | text | YES | | NULL | |
|
|
| contacttitle | text | YES | | NULL | |
|
|
| guarantorid | int(11) | YES | | NULL | |
|
|
| borrowernotes | mediumtext | YES | | NULL | |
|
|
| relationship | varchar(100) | YES | | NULL | |
|
|
| ethnicity | varchar(50) | YES | | NULL | |
|
|
| ethnotes | varchar(255) | YES | | NULL | |
|
|
| sex | varchar(1) | YES | | NULL | |
|
|
| password | varchar(30) | YES | | NULL | |
|
|
| flags | int(11) | YES | | NULL | |
|
|
| userid | varchar(30) | YES | MUL | NULL | |
|
|
| opacnote | mediumtext | YES | | NULL | |
|
|
| contactnote | varchar(255) | YES | | NULL | |
|
|
| sort1 | varchar(80) | YES | | NULL | |
|
|
| sort2 | varchar(80) | YES | | NULL | |
|
|
+------------------+--------------+------+-----+---------+----------------+
|
|
50 rows in set (0.01 sec)
|
|
|
|
Then %mappings establishes the relationship between mysql field and LDAP attribute.
|
|
|
|
=cut
|
|
|
|
# Redefine checkauth:
|
|
# connect to LDAP (named or anonymous)
|
|
# ~ retrieves $userid from "uid"
|
|
# ~ then compares $password with userPassword
|
|
# ~ then gets the LDAP entry
|
|
# ~ and calls the memberadd if necessary
|
|
|
|
use vars qw(%mapping @ldaphosts $base $ldapname $ldappassword);
|
|
|
|
%mapping = (
|
|
firstname => 'givenName',
|
|
surname => 'sn',
|
|
address => 'postalAddress',
|
|
city => 'l',
|
|
zipcode => 'postalCode',
|
|
branchcode => 'branch',
|
|
emailaddress => 'mail',
|
|
categorycode => 'employeeType',
|
|
phone => 'telephoneNumber',
|
|
);
|
|
|
|
my $prefhost;
|
|
if ($prefhost = C4::Context->preference('ldapserver')) { # assignment, not comparison
|
|
warn "Using preference from ldapserver: $prefhost";
|
|
(@ldaphosts) = split /\|/,$prefhost; # Potentially multiple LDAP hosts!
|
|
$base = C4::Context->preference('ldapinfos') || ''; # probably will fail w/o base
|
|
} else {
|
|
(@ldaphosts) = (qw(localhost)); # Potentially multiple LDAP hosts!
|
|
$base = "dc=metavore,dc=com"; # But only 1 base.
|
|
}
|
|
|
|
$ldapname = "cn=Manager,$base"; # Your LDAP user. EDIT THIS LINE.
|
|
$ldappassword = 'metavore'; # Your LDAP user's password. EDIT THIS LINE.
|
|
|
|
my %config = (
|
|
anonymous => ($ldapname and $ldappassword) ? 0 : 1,
|
|
replicate => 1, # add from LDAP to Koha database for new user
|
|
update => 1, # update from LDAP to Koha database for existing user
|
|
);
|
|
|
|
sub description ($) {
|
|
my $result = shift or return undef;
|
|
return "LDAP error #" . $result->code
|
|
. ": " . $result->error_name . "\n"
|
|
. "# " . $result->error_text . "\n";
|
|
}
|
|
|
|
sub checkauth {
|
|
my ($dbh, $userid, $password) = @_;
|
|
if ( $userid eq C4::Context->config('user')
|
|
&& $password eq C4::Context->config('pass') )
|
|
{
|
|
return 2; # Koha superuser account
|
|
}
|
|
my $db = Net::LDAP->new(\@ldaphosts);
|
|
#$debug and $db->debug(5);
|
|
my $filter = Net::LDAP::Filter->new("uid=$userid") or die "Failed to create new Net::LDAP::Filter";
|
|
my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
|
|
if ($res->code) { # connection refused
|
|
warn "LDAP bind failed as $ldapname: " . description($res);
|
|
return 0;
|
|
}
|
|
my $search = $db->search(
|
|
base => $base,
|
|
filter => $filter,
|
|
# attrs => ['*'],
|
|
) or die "LDAP search failed to return object.";
|
|
my $count = $search->count;
|
|
if ($search->code > 0) {
|
|
warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count) . description($search);
|
|
return 0;
|
|
}
|
|
if ($count != 1) {
|
|
warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count);
|
|
return 0;
|
|
}
|
|
|
|
my $userldapentry = $search->shift_entry;
|
|
my $cmpmesg = $db->compare( $userldapentry, attr=>'userPassword', value => $password );
|
|
if($cmpmesg->code != 6) {
|
|
warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
|
|
return 0;
|
|
}
|
|
unless($config{update} or $config{replicate}) {
|
|
return 1;
|
|
}
|
|
my %borrower = ldap_entry_2_hash($userldapentry,$userid);
|
|
if (exists_local($userid)) {
|
|
($config{update} ) and &update_local($userid,$password,%borrower);
|
|
} else {
|
|
($config{replicate}) and AddMember(%borrower);
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
# Pass LDAP entry object and local cardnumber (userid).
|
|
# Returns borrower hash.
|
|
# Edit %mapping so $memberhash{'xxx'} fits your ldap structure.
|
|
# Ensure that mandatory fields are correctly filled!
|
|
#
|
|
sub ldap_entry_2_hash ($$) {
|
|
my $userldapentry = shift;
|
|
my %borrower = ( cardnumber => shift );
|
|
my %memberhash;
|
|
my $x = $userldapentry->{asn}{attributes} or return undef;
|
|
my $key;
|
|
foreach my $k (@$x) {
|
|
foreach my $k2 ( keys %$k ) {
|
|
if ($k2 eq 'type') {
|
|
$key = $$k{$k2};
|
|
} else {
|
|
$memberhash{$key} .= map {$_ . " "} @$k{$k2};
|
|
}
|
|
}
|
|
}
|
|
foreach my $key (%mapping) {
|
|
my $data = $memberhash{$mapping{$key}};
|
|
defined $data or $data = ' ';
|
|
$borrower{$key} = ($data ne '') ? $data : ' ' ;
|
|
}
|
|
$borrower{initials} = $memberhash{initials} ||
|
|
( substr($borrower{'firstname'},0,1)
|
|
. substr($borrower{ 'surname' },0,1)
|
|
. " ");
|
|
return %borrower;
|
|
}
|
|
|
|
sub exists_local($) {
|
|
my $sth = C4::Context->dbh->prepare("SELECT password from borrowers WHERE cardnumber=?");
|
|
$sth->execute(shift);
|
|
return ($sth->rows) ? 1 : 0 ;
|
|
}
|
|
|
|
sub update_local($$%) {
|
|
# warn "MODIFY borrower";
|
|
my $userid = shift or return undef;
|
|
my $digest = md5_base64(shift) or return undef;
|
|
my %borrower = shift or return undef;
|
|
my $dbh = C4::Context->dbh;
|
|
my $sth = $dbh->prepare("
|
|
UPDATE borrowers
|
|
SET firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=?
|
|
WHERE cardnumber=?
|
|
");
|
|
$sth->execute(
|
|
$borrower{firstname}, $borrower{surname},
|
|
$borrower{initials}, $borrower{streetaddress},
|
|
$borrower{city}, $borrower{phone},
|
|
$borrower{categorycode}, $borrower{branchcode},
|
|
$borrower{emailaddress}, $borrower{sort1},
|
|
$userid
|
|
);
|
|
|
|
# MODIFY PASSWORD/LOGIN
|
|
# search borrowerid
|
|
$sth = $dbh->prepare("SELECT borrowernumber from borrowers WHERE cardnumber=? ");
|
|
$sth->execute($userid);
|
|
my ($borrowerid) = $sth->fetchrow;
|
|
# warn "change local password for $borrowerid setting $password";
|
|
changepassword($userid, $borrowerid, $digest);
|
|
|
|
# Confirm changes
|
|
my $cardnumber;
|
|
$sth = $dbh->prepare("SELECT password,cardnumber from borrowers WHERE userid=? ");
|
|
$cardnumber = confirmer($sth,$userid,$digest) and return $cardnumber;
|
|
$sth = $dbh->prepare("SELECT password,cardnumber from borrowers WHERE cardnumber=? ");
|
|
$cardnumber = confirmer($sth,$userid,$digest) and return $cardnumber;
|
|
die "Unexpected error after password update to $userid / $cardnumber.";
|
|
}
|
|
|
|
sub confirmer($$$) {
|
|
my $sth = shift or return undef;
|
|
my $userid = shift or return undef;
|
|
my $digest = shift or return undef;
|
|
$sth->execute($userid);
|
|
if ($sth->rows) {
|
|
my ($md5password, $othernum) = $sth->fetchrow;
|
|
($digest eq $md5password) and return $othernum;
|
|
warn "Password mismatch after update to userid=$userid";
|
|
return undef;
|
|
}
|
|
warn "Could not recover record after updating password for userid=$userid";
|
|
return 0;
|
|
}
|
|
1;
|
|
__END__
|
|
|
|
=back
|
|
|
|
=head1 SEE ALSO
|
|
|
|
CGI(3)
|
|
|
|
Net::LDAP()
|
|
|
|
Digest::MD5(3)
|
|
|
|
=cut
|