---
C4/Auth_with_ldap.pm | 136 ++++++++++++++++++++++++++----------------
Makefile.PL | 1 +
about.pl | 1 +
install_misc/debian.packages | 1 +
4 files changed, 87 insertions(+), 52 deletions(-)
diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm
index b25697c..3b4d3ad 100644
--- a/C4/Auth_with_ldap.pm
+++ b/C4/Auth_with_ldap.pm
@@ -18,7 +18,7 @@ package C4::Auth_with_ldap;
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use strict;
-#use warnings; FIXME - Bug 2505
+# use warnings; almost?
use Digest::MD5 qw(md5_base64);
use C4::Debug;
@@ -58,7 +58,7 @@ my $prefhost = $ldap->{hostname} or die
ldapserver_error('hostname');
my $base = $ldap->{base} or die ldapserver_error('base');
$ldapname = $ldap->{user} ;
$ldappassword = $ldap->{pass} ;
-our %mapping = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of
|| (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9
+our %mapping = %{$ldap->{mapping}} or die ldapserver_error('mapping');
my @mapkeys = keys %mapping;
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ):
", join ' ', @mapkeys, "\n";
@mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
@@ -80,68 +80,101 @@ sub description ($) {
sub search_method {
my $db = shift or return;
my $userid = shift or return;
- my $uid_field = $mapping{userid}->{is} or die ldapserver_error("mapping
for 'userid'");
- my $filter = Net::LDAP::Filter->new("$uid_field=$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 ldapuser " . ($ldapname || '[ANONYMOUS]') .
": " . description($res);
- return 0;
- }
- my $search = $db->search(
+ my $uid_field = $mapping{userid}->{is} or die
ldapserver_error("mapping for 'userid'");
+ my $filter = Net::LDAP::Filter->new("$uid_field=$userid") or die
"Failed to create new Net::LDAP::Filter";
+
+ 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;
- }
+ 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;
+ }
return $search;
}
-sub checkpw_ldap {
- my ($dbh, $userid, $password) = @_;
- my @hosts = split(',', $prefhost);
- my $db = Net::LDAP->new(\...@hosts);
- #$debug and $db->debug(5);
- my $userldapentry;
- if ( $ldap->{auth_by_bind} ) {
- my $principal_name = $ldap->{principal_name};
- if ($principal_name and $principal_name =~ /\%/) {
+sub bind_to_ldap {
+ my $db = shift;
+ my $userid = shift;
+ my $password = shift;
+ my $res; #error code capture
+
+ # if auth_by_bind, bind by the supplied userid and password
+ if ($ldap->{auth_by_bind} ) {
+ my $principal_name = $ldap->{principal_name};
+ if ($principal_name and $principal_name =~ /\%/) {
$principal_name = sprintf($principal_name,$userid);
- } else {
+ } else {
$principal_name = $userid;
- }
- my $res = $db->bind( $principal_name, password => $password );
- if ( $res->code ) {
- $debug and warn "LDAP bind failed as kohauser $principal_name: ".
description($res);
+ }
+ $res = $db->bind( $principal_name, password => $password );
+ if ($res->code ) { # connection refused
+ warn "LDAP bind failed as kohauser $principal_name: ".
description($res);
return 0;
}
+ # otherwise, if no ldap user or password, do an anonymous bind
+ } elsif ($config{anonymous}) {
+ $res = $db->bind;
+ if ($res->code) { # connection refused
+ warn "LDAP bind failed as ANONYMOUS: " . description($res);
+ return 0;
+ }
+ # otherwise, bind by the userid supplied in checkpw_ldap (normally)
+ } else {
+ $res = $db->bind($ldapname, password => $ldappassword);
+ if ($res->code) { # connection refused
+ warn "LDAP bind failed as ldapuser $ldapname: " .
description($res);
+ return 0;
+ }
+ }
+ #return the now bound $db
+ return $db;
+}
- # FIXME dpavlin -- we really need $userldapentry leater on even if
using auth_by_bind!
- my $search = search_method($db, $userid) or return 0; # warnings are
in the sub
- $userldapentry = $search->shift_entry;
-
- } else {
- my $search = search_method($db, $userid) or return 0; # warnings are
in the sub
- $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;
- }
- }
+sub checkpw_ldap {
+ my ($dbh, $userid, $password) = @_;
+ my @hosts = split(',', $prefhost);
+ my $db = Net::LDAP->new(\...@hosts) or die "$@";
+
+ # start TLS connection if configured. Uses TLS default settings only
+ if ($ldap->{tls}) {
+ my $tls_msg = $db->start_tls();
+ if ($tls_msg->code) { # TLS error
+ warn "TLS connection rejected: " . description($tls_msg);
+ return 0;
+ }
+ }
+
+ # Bind to the ldap in the appropriate manner
+ $db = bind_to_ldap($db, $userid, $password);
+
+ # search for the userid
+ my $search = search_method($db, $userid) or return 0; # warnings are in
the sub
+ # dump the ldap information into userldapentry for processing
+ my $userldapentry = $search->shift_entry;
+
+ # if we didn't bind to the userid supplied, we need to do a
password compare
+ unless ($ldap->{auth_by_bind}) {
+ 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;
+ }
+ }
+
# To get here, LDAP has accepted our user's login attempt.
# But we still have work to do. See perldoc below for detailed breakdown.
my (%borrower);
- my ($borrowernumber,$cardnumber,$local_userid,$savedpw) =
exists_local($userid);
+ my ($borrowernumber,$cardnumber,$local_userid,$savedpw) =
exists_local($userid);
if (( $borrowernumber and $config{update} ) or
(!$borrowernumber and $config{replicate}) ) {
@@ -155,7 +188,6 @@ sub checkpw_ldap {
($cardnumber eq $c2) or warn "update_local returned cardnumber
'$c2' instead of '$cardnumber'";
} else { # C1, D1
# maybe update just the password?
- return(1, $cardnumber); # FIXME dpavlin -- don't destroy
ExtendedPatronAttributes
}
} elsif ($config{replicate}) { # A2, C2
$borrowernumber = AddMember(%borrower) or die "AddMember failed";
@@ -166,7 +198,6 @@ sub checkpw_ldap {
my @types = C4::Members::AttributeTypes::GetAttributeTypes();
my @attributes = grep{my $key=$_; any{$_ eq $k...@types;} keys
%borrower;
my $extended_patron_attributes =
map{{code=>$_,value=>$borrower{$_...@attributes;
- my $extended_patron_attributes = [] unless
$extended_patron_attributes;
my @errors;
#Check before add
for (my $i; $i< scalar(@$extended_patron_attributes)-1;$i++) {
@@ -385,6 +416,7 @@ Example XML stanza for LDAP configuration in KOHA_CONF.
password comparison, e.g., to use
Active Directory -->
<principal_name>%...@my_domain.com</principal_name>
<!-- optional, for auth_by_bind: a printf
format to make userPrincipalName from koha userid -->
+ <tls>0</tls> <!-- set to 1 to use Transport Layer Security
(TLS) -->
<mapping> <!-- match koha SQL field names to your LDAP
record field names -->
<firstname is="givenname" ></firstname>
<surname is="sn" ></surname>
diff --git a/Makefile.PL b/Makefile.PL
index c88d5ea..e4f6897 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -570,6 +570,7 @@ WriteMakefile(
'HTTP::OAI' => 3.20,
'HTTP::Request::Common' => 1.26,
'IPC::Cmd' => 0.46,
+ 'IO::Socket::SSL' => 1.33,
'JSON' => 2.07, #
Needed by admin/item_circulation_alerts.pl
'LWP::Simple' => 1.41,
'LWP::UserAgent' => 2.033,
diff --git a/about.pl b/about.pl
index 04a9675..ecdfdc2 100755
--- a/about.pl
+++ b/about.pl
@@ -94,6 +94,7 @@ HTTP::OAI
HTTP::Request::Common
HTML::Scrubber
IPC::Cmd
+IO::Socket::SSL
JSON
LWP::Simple
LWP::UserAgent
diff --git a/install_misc/debian.packages b/install_misc/debian.packages
index 11dfeb4..23a1af6 100644
--- a/install_misc/debian.packages
+++ b/install_misc/debian.packages
@@ -39,6 +39,7 @@ libidzebra-2.0-mod-grs-xml install
libidzebra-2.0-mod-text install
libidzebra-2.0-modules install
libimage-magick-perl install
+libio-socket-ssl-perl install
libjson-perl install
liblingua-ispell-perl install
liblingua-stem-perl install
--
1.5.6.5
_______________________________________________
Koha-patches mailing list
Koha-patches@lists.koha.org
http://lists.koha.org/mailman/listinfo/koha-patches
