|
|
|
@ -1,7 +1,4 @@ |
|
|
|
# -*- tab-width: 8 -*- |
|
|
|
# NOTE: This file uses 8-character tabs; do not change the tab size! |
|
|
|
|
|
|
|
package C4::Auth; |
|
|
|
package C4::Auth_with_ldap; |
|
|
|
|
|
|
|
# Copyright 2000-2002 Katipo Communications |
|
|
|
# |
|
|
|
@ -23,20 +20,21 @@ package C4::Auth; |
|
|
|
use strict; |
|
|
|
use Digest::MD5 qw(md5_base64); |
|
|
|
|
|
|
|
require Exporter; |
|
|
|
use C4::Context; |
|
|
|
use C4::Output; # to get the template |
|
|
|
use C4::Members; |
|
|
|
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 &get_template_and_user); |
|
|
|
@EXPORT = qw( checkauth ); |
|
|
|
} |
|
|
|
|
|
|
|
=head1 NAME |
|
|
|
@ -45,45 +43,26 @@ C4::Auth - Authenticates Koha users |
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
|
|
|
|
|
|
use CGI; |
|
|
|
use C4::Auth; |
|
|
|
|
|
|
|
my $query = new CGI; |
|
|
|
|
|
|
|
my ($template, $borrowernumber, $cookie) |
|
|
|
= get_template_and_user({ |
|
|
|
template_name => "opac-main.tmpl", |
|
|
|
query => $query, |
|
|
|
type => "opac", |
|
|
|
authnotrequired => 1, |
|
|
|
flagsrequired => {circulate => 1}, |
|
|
|
}); |
|
|
|
|
|
|
|
print $query->header( |
|
|
|
-type => 'utf-8', |
|
|
|
-cookie => $cookie |
|
|
|
), $template->output; |
|
|
|
use C4::Auth_with_ldap; |
|
|
|
|
|
|
|
=head1 LDAP specific |
|
|
|
|
|
|
|
This module is specific to LDAP authentification. It requires Net::LDAP package and a working LDAP server. |
|
|
|
This module is specific to LDAP authentification. It requires Net::LDAP package and one or more |
|
|
|
working LDAP servers. |
|
|
|
To use it : |
|
|
|
* move initial Auth.pm elsewhere |
|
|
|
* Search the string LOCAL |
|
|
|
* modify the code between LOCAL and /LOCAL to fit your LDAP server parameters & fields |
|
|
|
* rename this module to Auth.pm |
|
|
|
That should be enough. |
|
|
|
* modify the code between LOCAL and /LOCAL to fit your LDAP server parameters & fields. |
|
|
|
|
|
|
|
=head1 FUNCTIONS |
|
|
|
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. |
|
|
|
|
|
|
|
=cut |
|
|
|
|
|
|
|
# Redefine checkpw |
|
|
|
# connects to LDAP (anonymous) |
|
|
|
# retrieves $userid a-login |
|
|
|
# then compares $password with a-weak |
|
|
|
# then gets the LDAP entry |
|
|
|
# and calls the memberadd if necessary |
|
|
|
# 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 |
|
|
|
|
|
|
|
my %mapping = ( |
|
|
|
firstname => 'givenName', |
|
|
|
@ -96,49 +75,82 @@ my %mapping = ( |
|
|
|
phone => 'telephoneNumber', |
|
|
|
); |
|
|
|
|
|
|
|
sub checkpw { |
|
|
|
my (@ldaphosts) = (qw(localhost)); # potentially multiple LDAP hosts! |
|
|
|
my $base = "dc=metavore,dc=com"; |
|
|
|
my $ldapname = "cn=Manager,$base"; # The LDAP user. |
|
|
|
my $ldappassword = 'metavore'; |
|
|
|
|
|
|
|
my %config = ( |
|
|
|
anonymous => ($ldapname and $ldappassword) ? 0 : 1, |
|
|
|
replicate => 0, # add from LDAP to Koha database for new user |
|
|
|
update => 0, # 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 |
|
|
|
} |
|
|
|
################################################## |
|
|
|
### LOCAL |
|
|
|
### Change the code below to match your own LDAP server. |
|
|
|
################################################## |
|
|
|
# LDAP connexion parameters |
|
|
|
my $ldapserver = 'localhost'; |
|
|
|
|
|
|
|
# Infos to do an anonymous bind |
|
|
|
my $name = "dc=metavore,dc=com"; |
|
|
|
my $db = Net::LDAP->new($ldapserver); |
|
|
|
|
|
|
|
# do an anonymous bind |
|
|
|
my $res = $db->bind(); |
|
|
|
if ($res->code) { # auth refused |
|
|
|
warn "LDAP Auth impossible : server not responding"; |
|
|
|
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 $userdnsearch = $db->search( |
|
|
|
base => $name, |
|
|
|
filter => "(a-login=$userid)", |
|
|
|
); |
|
|
|
if ( $userdnsearch->code || !( $userdnsearch->count eq 1 ) ) { |
|
|
|
warn "LDAP Auth rejected : user unknown in LDAP"; |
|
|
|
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 = $userdnsearch->shift_entry; |
|
|
|
my $cmpmesg = $db->compare( $userldapentry, attr => 'a-weak', value => $password ); |
|
|
|
my $userldapentry = $search->shift_entry; |
|
|
|
my $cmpmesg = $db->compare( $userldapentry, attr=>'userPassword', value => $password ); |
|
|
|
if($cmpmesg->code != 6) { |
|
|
|
warn "LDAP Auth rejected : wrong password"; |
|
|
|
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; |
|
|
|
} |
|
|
|
|
|
|
|
# build LDAP hash |
|
|
|
# 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}; |
|
|
|
my $x = $userldapentry->{asn}{attributes} or return undef; |
|
|
|
my $key; |
|
|
|
foreach my $k (@$x) { |
|
|
|
foreach my $k2 ( keys %$k ) { |
|
|
|
@ -149,79 +161,75 @@ sub checkpw { |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# BUILD %borrower to CREATE or MODIFY BORROWER |
|
|
|
# change $memberhash{'xxx'} to fit your ldap structure. |
|
|
|
# check twice that mandatory fields are correctly filled |
|
|
|
# |
|
|
|
my %borrower; |
|
|
|
$borrower{cardnumber} = $userid; |
|
|
|
foreach my $key (%mapping) { |
|
|
|
my $data = $memberhash{$mapping{$key}}; |
|
|
|
defined $data or $data = ' '; |
|
|
|
$borrower{$key} = ($data ne '') ? $data : ' ' ; |
|
|
|
} |
|
|
|
$borrower{initials} = |
|
|
|
substr( $borrower{firstname}, 0, 1 ) |
|
|
|
. substr( $borrower{surname}, 0, 1 ) |
|
|
|
. " "; # MANDATORY FIELD |
|
|
|
################################################## |
|
|
|
### /LOCAL |
|
|
|
################################################## |
|
|
|
# check if borrower exists (then modify, else add) |
|
|
|
my $sth = |
|
|
|
$dbh->prepare("select password from borrowers where cardnumber=?"); |
|
|
|
$sth->execute($userid); |
|
|
|
if ( $sth->rows ) { |
|
|
|
# warn "MODIFY borrower"; |
|
|
|
my $sth2 = $dbh->prepare(" |
|
|
|
UPDATE borrowers set firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=? |
|
|
|
WHERE cardnumber=? |
|
|
|
"); |
|
|
|
$sth2->execute( |
|
|
|
$borrower{firstname}, $borrower{surname}, |
|
|
|
$borrower{initials}, $borrower{streetaddress}, |
|
|
|
$borrower{city}, $borrower{phone}, |
|
|
|
$borrower{categorycode}, $borrower{branchcode}, |
|
|
|
$borrower{emailaddress}, $borrower{sort1}, |
|
|
|
$userid |
|
|
|
); |
|
|
|
} else { |
|
|
|
# warn "ADD borrower"; |
|
|
|
my $borrowerid = newmember(%borrower); |
|
|
|
} |
|
|
|
$borrower{initials} = $memberhash{initials} || |
|
|
|
( substr($borrower{'firstname'},0,1) |
|
|
|
. substr($borrower{ 'surname' },0,1) |
|
|
|
. " "); |
|
|
|
return %borrower; |
|
|
|
} |
|
|
|
|
|
|
|
# CREATE or MODIFY PASSWORD/LOGIN |
|
|
|
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 = $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."; |
|
|
|
} |
|
|
|
|
|
|
|
# warn "change password for $borrowerid setting $password"; |
|
|
|
my $digest = md5_base64($password); |
|
|
|
changepassword( $userid, $borrowerid, $digest ); |
|
|
|
|
|
|
|
# INTERNAL AUTH |
|
|
|
$sth = $dbh->prepare("SELECT password,cardnumber from borrowers WHERE userid=?"); |
|
|
|
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, $cardnumber ) = $sth->fetchrow; |
|
|
|
if ( md5_base64($password) eq $md5password ) { |
|
|
|
return 1, $cardnumber; |
|
|
|
} |
|
|
|
} |
|
|
|
$sth = $dbh->prepare("SELECT password from borrowers WHERE cardnumber=?"); |
|
|
|
$sth->execute($userid); |
|
|
|
if ($sth->rows) { |
|
|
|
my ($md5password) = $sth->fetchrow; |
|
|
|
if ( md5_base64($password) eq $md5password ) { |
|
|
|
return 1, $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; |
|
|
|
} |
|
|
|
return 0; |
|
|
|
warn "Could not recover record after updating password for userid=$userid"; |
|
|
|
return 0; |
|
|
|
} |
|
|
|
|
|
|
|
END { } # module clean-up code here (global destructor) |
|
|
|
1; |
|
|
|
__END__ |
|
|
|
|
|
|
|
@ -231,7 +239,7 @@ __END__ |
|
|
|
|
|
|
|
CGI(3) |
|
|
|
|
|
|
|
C4::Output(3) |
|
|
|
Net::LDAP() |
|
|
|
|
|
|
|
Digest::MD5(3) |
|
|
|
|
|
|
|
|
Joe Atzberger
17 years ago
Joshua Ferraro