Auth_with_ldap - further revisions, better modularity.
authorJoe Atzberger <joe.atzberger@liblime.com>
Sun, 4 Nov 2007 22:24:08 +0000 (16:24 -0600)
committerJoshua Ferraro <jmf@liblime.com>
Sun, 4 Nov 2007 22:37:23 +0000 (16:37 -0600)
Signed-off-by: Chris Cormack <crc@liblime.com>
Signed-off-by: Joshua Ferraro <jmf@liblime.com>

C4/Auth_with_ldap.pm

index a4ff9ae..481d0a7 100644 (file)
@@ -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)