View | Details | Raw Unified | Return to bug 8993
Collapse All | Expand All

(-)a/C4/Auth_with_ldap.pm (-226 / +451 lines)
Lines 1-5 Link Here
1
package C4::Auth_with_ldap;
1
package C4::Auth_with_ldap;
2
3
# Copyright 2000-2002 Katipo Communications
2
# Copyright 2000-2002 Katipo Communications
4
#
3
#
5
# This file is part of Koha.
4
# This file is part of Koha.
Lines 17-26 package C4::Auth_with_ldap; Link Here
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
18
20
use strict;
19
use Modern::Perl;
21
#use warnings; FIXME - Bug 2505
22
use Carp;
20
use Carp;
23
24
use C4::Debug;
21
use C4::Debug;
25
use C4::Context;
22
use C4::Context;
26
use C4::Members qw(AddMember changepassword);
23
use C4::Members qw(AddMember changepassword);
Lines 31-64 use Koha::AuthUtils qw(hash_password); Link Here
31
use List::MoreUtils qw( any );
28
use List::MoreUtils qw( any );
32
use Net::LDAP;
29
use Net::LDAP;
33
use Net::LDAP::Filter;
30
use Net::LDAP::Filter;
31
use YAML;
34
32
35
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
33
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
36
34
37
BEGIN {
35
BEGIN {
38
	require Exporter;
36
    require Exporter;
39
    $VERSION = 3.07.00.049;	# set the version for version checking
37
    $VERSION = 3.07.00.049; # set the version for version checking
40
	@ISA    = qw(Exporter);
38
    @ISA     = qw(Exporter);
41
	@EXPORT = qw( checkpw_ldap );
39
    @EXPORT  = qw( checkpw_ldap );
40
}
41
42
# return the ref of the subroutine
43
sub load_subroutine {
44
    require Package::Stash;
45
    my ( $module, $sub ) = @_;
46
    my $stash = Package::Stash->new($module);
47
    unless ( %{ $stash->namespace } ) {
48
        eval "require $module";
49
        $@ and die $@;
50
    }
51
    $stash->get_package_symbol('&'.$sub);
42
}
52
}
43
53
44
# Redefine checkpw_ldap:
54
# Redefine checkpw_ldap:
45
# connect to LDAP (named or anonymous)
55
# connect to LDAP (named or anonymous)
46
# ~ retrieves $userid from KOHA_CONF mapping
56
# ~ retrieves $userid from KOHA_CONF mapping
47
# ~ then compares $password with userPassword 
57
# ~ then compares $password with userPassword
48
# ~ then gets the LDAP entry
58
# ~ then gets the LDAP entry
49
# ~ and calls the memberadd if necessary
59
# ~ and calls the memberadd if necessary
50
60
51
sub ldapserver_error {
61
sub ldapserver_error {
52
	return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
62
    return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
53
}
63
}
54
64
65
sub debug_msg { $debug and say STDERR @_ }
66
sub logger { say STDERR YAML::Dump @_ }
67
55
use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
68
use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
56
my $context = C4::Context->new() 	or die 'C4::Context->new failed';
69
my $context = C4::Context->new() or die 'C4::Context->new failed';
57
my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
70
my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
58
my $prefhost  = $ldap->{hostname}	or die ldapserver_error('hostname');
71
59
my $base      = $ldap->{base}		or die ldapserver_error('base');
72
my ( $prefhost, $base ) = ('')x2;
60
$ldapname     = $ldap->{user}		;
73
unless ( $$ldap{authmethod} ) {
61
$ldappassword = $ldap->{pass}		;
74
    say STDERR "deprecated ldap configuration, see documentation";
75
    $base = $$ldap{base} or die ldapserver_error('base');
76
    $prefhost = $$ldap{hostname} or die ldapserver_error('hostname');
77
}
78
79
$ldapname     = $ldap->{user};
80
$ldappassword = $ldap->{pass};
62
our %mapping  = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of || (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9
81
our %mapping  = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of || (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9
63
my @mapkeys = keys %mapping;
82
my @mapkeys = keys %mapping;
64
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (  total  ): ", join ' ', @mapkeys, "\n";
83
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (  total  ): ", join ' ', @mapkeys, "\n";
Lines 66-197 $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", Link Here
66
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n";
85
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n";
67
86
68
my %config = (
87
my %config = (
69
	anonymous => ($ldapname and $ldappassword) ? 0 : 1,
88
    anonymous => ( $ldapname and $ldappassword ) ? 0 : 1,
70
    replicate => defined($ldap->{replicate}) ? $ldap->{replicate} : 1,  #    add from LDAP to Koha database for new user
89
    # add from LDAP to Koha database for new user
71
       update => defined($ldap->{update}   ) ? $ldap->{update}    : 1,  # update from LDAP to Koha database for existing user
90
    replicate => defined( $ldap->{replicate} ) ? $ldap->{replicate} : 1,
91
    # update from LDAP to Koha database for existing user
92
    update    => defined( $ldap->{update} )    ? $ldap->{update}    : 1,
72
);
93
);
73
94
74
sub description {
95
sub description {
75
	my $result = shift or return;
96
    my $result = shift or return;
76
	return "LDAP error #" . $result->code
97
    return "LDAP error #" . $result->code
77
			. ": " . $result->error_name . "\n"
98
        . ": " . $result->error_name . "\n"
78
			. "# " . $result->error_text . "\n";
99
        . "# " . $result->error_text . "\n";
79
}
100
}
80
101
81
sub search_method {
102
sub search_method {
82
    my $db     = shift or return;
103
    my $db        = shift or return;
83
    my $userid = shift or return;
104
    my $userid    = shift or return;
84
	my $uid_field = $mapping{userid}->{is} or die ldapserver_error("mapping for 'userid'");
105
    my $uid_field = $mapping{userid}->{is} or die ldapserver_error("mapping for 'userid'");
85
	my $filter = Net::LDAP::Filter->new("$uid_field=$userid") or die "Failed to create new Net::LDAP::Filter";
106
    my $filter    = Net::LDAP::Filter->new("$uid_field=$userid") or die "Failed to create new Net::LDAP::Filter";
86
	my $search = $db->search(
107
    my $search = $db->search(
87
		  base => $base,
108
        base   => $base,
88
	 	filter => $filter,
109
        filter => $filter,
89
		# attrs => ['*'],
110
        # attrs => ['*'],
90
	) or die "LDAP search failed to return object.";
111
    ) or die "LDAP search failed to return object.";
91
	my $count = $search->count;
112
    my $count = $search->count;
92
	if ($search->code > 0) {
113
    if ($search->code > 0) {
93
		warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count) . description($search);
114
        warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count) . description($search);
94
		return 0;
115
        return 0;
95
	}
116
    }
96
	if ($count != 1) {
117
    if ($count != 1) {
97
		warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count);
118
        warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count);
98
		return 0;
119
        return 0;
99
	}
120
    }
100
    return $search;
121
    return $search;
101
}
122
}
102
123
124
# $cnx is an Net::LDAP object that dies when error occurs
125
# $search are params for the search method (default base is the one set in the config)
126
sub _anon_search {
127
    my ( $cnx, $search ) = @_;
128
129
    my $entry;
130
    for my $branch ( @{ $$ldap{branch} } ) {
131
        debug_msg "search $$search{filter} at $$branch{dn}";
132
133
        my $branch_search = { %$search, base => $$branch{dn}, search => "ObjectClass=*" };
134
        $entry = eval {
135
            $cnx
136
            ->search( %$branch_search )
137
            ->shift_entry
138
        };
139
140
        if ( $entry ) {
141
            debug_msg "found ", $entry->dn;
142
            return { entry => $entry, branch => $branch };
143
        }
144
        elsif ( $@ ) { return { error => 'UNKNOWN', msg => $@ } }
145
        else { $debug and logger { "failed search" => $branch_search } }
146
    }
147
}
148
149
sub set_xattr {
150
    my ( $id, $borrower ) = @_;
151
    if ( my $x = $$borrower{xattr} ) {
152
        #SetBorrowerAttributes is not managing when being sent an Array ref
153
        my $attrs = [ map {
154
            my $key = $_;
155
            my @listattributes;
156
            if (ref ($x->{$key}) eq "ARRAY"){
157
                foreach my $value (@{$x->{$key}}){
158
                  push @listattributes, { code => $key, value => $value }
159
                }
160
            }
161
            else {
162
                push @listattributes, { code => $key, value => $$x{$key} }
163
            }
164
            @listattributes;
165
        } keys %$x ];
166
        $debug and logger { "creating $id" => $attrs };
167
        SetBorrowerAttributes( $id, $attrs );
168
    }
169
}
170
171
sub accept_borrower {
172
    my ($borrower,$userid) = @_;
173
    for ( $$borrower{column}{userid} ) {
174
        $userid ||= $_ or die;
175
        unless ( $_ ) {
176
            $_ = $userid;
177
            next;
178
        }
179
    }
180
181
    my ($id) = exists_local( $userid ) or debug_msg "$userid is newcommer";
182
183
    my $newcommer = not $id;
184
185
    if ( $newcommer ) {
186
        return 0 unless $config{update};
187
        $debug and logger { Member => $$borrower{column} };
188
        $id = AddMember( %{ $$borrower{column} } ) or return 0;
189
    } else {
190
        if ( $config{replicate} ) {
191
            delete $$borrower{column}{dateenrolled};
192
            delete $$borrower{column}{dateexpiry};
193
            my $cardnumber = update_local
194
            ( $userid, $$borrower{column}{password}, $id, $$borrower{column} ); 
195
            if ( my $old_cardnumber = $$borrower{column}{cardnumber} ) {
196
                if ( $old_cardnumber ne $cardnumber ) {
197
                    warn "update_local returned cardnumber '$cardnumber' instead of '$old_cardnumber'";
198
                    return 0;
199
                }
200
            }
201
        }
202
    }
203
204
    if ( $newcommer || $config{'update'} ) {
205
        $debug and logger { "changing attrs for $id" => $$borrower{xattr} };
206
        set_xattr $id, $borrower;
207
    }
208
209
    return 1
210
}
211
212
sub cnx {
213
    my $cnx = Net::LDAP->new( $ldap->{uri}, onerror => 'die' ) or do {
214
        warn "ldap error: $!";
215
    };
216
    # bind MUST success
217
    my $msg = eval {
218
        $cnx->bind ($ldap->{manager}, password => $ldap->{password})
219
    };
220
    debug_msg "ldap $_:", $msg->$_ for qw/ error code /;
221
    if ( $@ ) {
222
        return {
223
            error => 'LDAP_CANTBIND',
224
            msg => $@
225
        };
226
    };
227
    return $cnx;
228
}
229
103
sub checkpw_ldap {
230
sub checkpw_ldap {
104
    my ($dbh, $userid, $password) = @_;
231
    my ($dbh, $userid, $password) = @_;
105
    my @hosts = split(',', $prefhost);
106
    my $db = Net::LDAP->new(\@hosts);
107
    unless ( $db ) {
108
        warn "LDAP connexion failed";
109
        return 0;
110
    }
111
232
112
	#$debug and $db->debug(5);
233
    my $to_borrower = {};
234
235
    my $uattr = $$ldap{userid_from} || $$ldap{mapping}{userid}{is}
236
      or die "userid mapping not set";
237
113
    my $userldapentry;
238
    my $userldapentry;
114
239
115
    if ( $ldap->{auth_by_bind} ) {
240
    if ( $$ldap{authmethod} ) {
116
        my $principal_name;
241
        for ( $$ldap{branch} ) {
117
        if ( $ldap->{anonymous_bind} ) {
242
            $_ or die "no branch, no auth";
243
            ref $_ eq 'HASH' and $_ = [$_];
244
        }
245
246
        # This code is an attempt to introduce a new codebase that can be hookable
247
        # and can mangage more cases than the old way
118
248
119
            # Perform an anonymous bind
249
        # if the filter isn't set, userid mapping is used
120
            my $res = $db->bind;
250
        $$ldap{filter} ||= "$uattr=%s";
121
            if ( $res->code ) {
251
122
                warn "Anonymous LDAP bind failed: " . description($res);
252
        my $cnx = cnx or return 0;
253
254
        # login can be either ...
255
        my $login = do {
256
257
            # An Active Directory principal_name. Just replace the %s by the userid
258
            # well ... don't try if not AD
259
            if ( $$ldap{authmethod} ~~ [qw/ principal_name principalname principalName /] ) {
260
                sprintf( $$ldap{principal_name}, $userid )
261
            }
262
263
            # for other LDAP implementation, the standard way is to
264
            # A) Bind with the manager account and search for the DN of the user entry
265
            # B) Bind with the user DN and password.
266
            # Auth is completed if bind success.
267
            # so in this code;
268
            # - i fill $userldapentry for later use
269
            # - i return the DN
270
271
            elsif ( $$ldap{authmethod} ~~ [qw/ searchdn searchDn search_dn /] ) {
272
                $to_borrower = _anon_search($cnx, {
273
                    filter => sprintf($$ldap{filter}, $userid)
274
                }) or do {
275
                    debug_msg "no answer from ldap";
276
                    return 0;
277
                };
278
279
                if ( $$to_borrower{error} ) {
280
                    say STDERR $$to_borrower{msg};
281
                    return 0;
282
                }
283
284
                $userldapentry = $$to_borrower{entry} or do {
285
                    debug_msg "no entry returned? weird ...";
286
                };
287
288
                # login is the dn of the entry
289
                if ( $userldapentry ) { $userldapentry->dn }
290
                else {
291
                    say STDERR "can't authenticate $userid";
292
                    return 0;
293
                }
294
            } else {
295
                say STDERR "$$ldap{authmethod} authmethod is invalid,"
296
                , "please check your ldap configuration in $ENV{KOHA_CONF}";
123
                return 0;
297
                return 0;
124
            }
298
            }
299
        };
125
300
126
            # Perform a LDAP search for the given username
301
        eval { $cnx->bind( $login, password => $password ) };
127
            my $search = search_method( $db, $userid )
302
        if ( $@ ) {
128
              or return 0;    # warnings are in the sub
303
            say STDERR "ldap bind with $login failed: $@";
129
            $userldapentry = $search->shift_entry;
304
            return 0;
130
            $principal_name = $userldapentry->dn;
305
        }
306
        debug_msg "congrats, you're one of us";
307
    } else {
308
        # This is the old stuff:
309
        my @hosts = split(',', $prefhost);
310
        my $db = Net::LDAP->new(\@hosts);
311
        unless ( $db ) {
312
            warn "LDAP connexion failed";
313
            return 0;
131
        }
314
        }
132
        else {
315
        #$debug and $db->debug(5);
133
            $principal_name = $ldap->{principal_name};
316
134
            if ( $principal_name and $principal_name =~ /\%/ ) {
317
        if ( $ldap->{auth_by_bind} ) {
135
                $principal_name = sprintf( $principal_name, $userid );
318
            my $principal_name;
319
            if ( $ldap->{anonymous_bind} ) {
320
321
                # Perform an anonymous bind
322
                my $res = $db->bind;
323
                if ( $res->code ) {
324
                    warn "Anonymous LDAP bind failed: " . description($res);
325
                    return 0;
326
                }
327
328
                # Perform a LDAP search for the given username
329
                my $search = search_method( $db, $userid )
330
                  or return 0;    # warnings are in the sub
331
                $userldapentry = $search->shift_entry;
332
                $principal_name = $userldapentry->dn;
136
            }
333
            }
137
            else {
334
            else {
138
                $principal_name = $userid;
335
                $principal_name = $ldap->{principal_name};
336
                if ( $principal_name and $principal_name =~ /\%/ ) {
337
                    $principal_name = sprintf( $principal_name, $userid );
338
                }
339
                else {
340
                    $principal_name = $userid;
341
                }
342
            }
343
344
            # Perform a LDAP bind for the given username using the matched DN
345
            my $res = $db->bind( $principal_name, password => $password );
346
            if ( $res->code ) {
347
                warn "LDAP bind failed as kohauser $userid: " . description($res);
348
                return 0;
349
            }
350
            if ( !defined($userldapentry)
351
                && ( $config{update} or $config{replicate} ) )
352
            {
353
                my $search = search_method( $db, $userid ) or return 0;
354
                $userldapentry = $search->shift_entry;
355
            }
356
        } else {
357
            say STDERR "deprecated kludge: use authmethod search_dn instead";
358
            my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
359
            if ($res->code) {		# connection refused
360
                warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') . ": " . description($res);
361
                return 0;
362
            }
363
            my $search = search_method($db, $userid) or return 0;    # warnings are in the sub
364
            $userldapentry = $search->shift_entry;
365
            my $cmpmesg = $db->compare( $userldapentry, attr => 'userpassword', value => $password );
366
            if ($cmpmesg->code != 6) {
367
                warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
368
            return 0;
139
            }
369
            }
140
        }
370
        }
371
    }
141
372
142
        # Perform a LDAP bind for the given username using the matched DN
373
    if ( my $t = $$ldap{transformation} ) {
143
        my $res = $db->bind( $principal_name, password => $password );
374
        $$t{subroutine} ||= 'get_borrower';
144
        if ( $res->code ) {
375
        my $get_borrower = load_subroutine ( @$t{qw/ module subroutine /} );
145
            warn "LDAP bind failed as kohauser $userid: " . description($res);
376
        unless ( $get_borrower ) {
377
            warn "no get_borrower $$t{subroutine} subroutine in $$t{module}";
146
            return 0;
378
            return 0;
147
        }
379
        }
148
        if ( !defined($userldapentry)
380
        debug_msg "$$t{subroutine} subroutine loaded from $$t{module}";
149
            && ( $config{update} or $config{replicate} ) )
381
        if ( my $b = $get_borrower->( $$to_borrower{entry} ) ) {
150
        {
382
            return accept_borrower $b,$userid;
151
            my $search = search_method( $db, $userid ) or return 0;
152
            $userldapentry = $search->shift_entry;
153
        }
383
        }
154
    } else {
384
        else { return 0 }
155
		my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
385
    }
156
		if ($res->code) {		# connection refused
157
			warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') . ": " . description($res);
158
			return 0;
159
		}
160
        my $search = search_method($db, $userid) or return 0;   # warnings are in the sub
161
        $userldapentry = $search->shift_entry;
162
		my $cmpmesg = $db->compare( $userldapentry, attr=>'userpassword', value => $password );
163
		if ($cmpmesg->code != 6) {
164
			warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
165
			return 0;
166
		}
167
	}
168
386
169
    # To get here, LDAP has accepted our user's login attempt.
387
    # To get here, LDAP has accepted our user's login attempt.
170
    # But we still have work to do.  See perldoc below for detailed breakdown.
388
    # But we still have work to do.  See perldoc below for detailed breakdown.
171
389
172
    my (%borrower);
390
    my %borrower;
173
	my ($borrowernumber,$cardnumber,$local_userid,$savedpw) = exists_local($userid);
391
    my ($borrowernumber, $cardnumber, $local_userid, $savedpw) = exists_local($userid);
174
392
175
    if (( $borrowernumber and $config{update}   ) or
393
    if (  ( $borrowernumber and $config{update} )
176
        (!$borrowernumber and $config{replicate})   ) {
394
        or ( !$borrowernumber and $config{replicate} ) ) {
177
        %borrower = ldap_entry_2_hash($userldapentry,$userid);
395
        %borrower = ldap_entry_2_hash( $userldapentry, $userid );
178
        $debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
396
        $debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
179
    }
397
    }
180
398
181
    if ($borrowernumber) {
399
    if ($borrowernumber) {
182
        if ($config{update}) { # A1, B1
400
        if ($config{update}) { # A1, B1
183
            my $c2 = &update_local($local_userid,$password,$borrowernumber,\%borrower) || '';
401
            my $c2 = &update_local($local_userid, $password, $borrowernumber, \%borrower) || '';
184
            ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'";
402
            ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'";
185
        } else { # C1, D1
403
        } else { # C1, D1
186
            # maybe update just the password?
404
            # maybe update just the password?
187
		return(1, $cardnumber, $local_userid);
405
            return (1, $cardnumber, $local_userid);
188
        }
406
        }
189
    } elsif ($config{replicate}) { # A2, C2
407
    } elsif ($config{replicate}) { # A2, C2
190
        $borrowernumber = AddMember(%borrower) or die "AddMember failed";
408
        $borrowernumber = AddMember(%borrower) or die "AddMember failed";
191
   } else {
409
    } else {
192
        return 0;   # B2, D2
410
        return 0;                       # B2, D2
193
    }
411
    }
194
    if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} ||$config{replicate})) {
412
    if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} || $config{replicate})) {
195
        my @extended_patron_attributes;
413
        my @extended_patron_attributes;
196
        foreach my $attribute_type ( C4::Members::AttributeTypes::GetAttributeTypes() ) {
414
        foreach my $attribute_type ( C4::Members::AttributeTypes::GetAttributeTypes() ) {
197
            my $code = $attribute_type->{code};
415
            my $code = $attribute_type->{code};
Lines 210-216 sub checkpw_ldap { Link Here
210
        }
428
        }
211
        C4::Members::Attributes::SetBorrowerAttributes($borrowernumber, \@unique_attr);
429
        C4::Members::Attributes::SetBorrowerAttributes($borrowernumber, \@unique_attr);
212
    }
430
    }
213
return(1, $cardnumber, $userid);
431
    return(1, $cardnumber, $userid);
214
}
432
}
215
433
216
# Pass LDAP entry object and local cardnumber (userid).
434
# Pass LDAP entry object and local cardnumber (userid).
Lines 219-281 return(1, $cardnumber, $userid); Link Here
219
# Ensure that mandatory fields are correctly filled!
437
# Ensure that mandatory fields are correctly filled!
220
#
438
#
221
sub ldap_entry_2_hash {
439
sub ldap_entry_2_hash {
222
	my $userldapentry = shift;
440
    my $userldapentry = shift;
223
	my %borrower = ( cardnumber => shift );
441
    my %borrower = ( cardnumber => shift );
224
	my %memberhash;
442
    my %memberhash;
225
	$userldapentry->exists('uid');	# This is bad, but required!  By side-effect, this initializes the attrs hash. 
443
    $userldapentry->exists('uid');    # This is bad, but required!  By side-effect, this initializes the attrs hash.
226
	if ($debug) {
444
    if ($debug) {
227
		foreach (keys %$userldapentry) {
445
        print STDERR "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump();
228
			print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
446
        foreach (keys %$userldapentry) {
229
		}
447
            print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
230
	}
448
            hashdump("LDAP key: ",$userldapentry->{$_});
231
	my $x = $userldapentry->{attrs} or return;
449
        }
232
	foreach (keys %$x) {
450
    }
233
		$memberhash{$_} = join ' ', @{$x->{$_}};	
451
    my $x = $userldapentry->{attrs} or return;
234
		$debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
452
    foreach (keys %$x) {
235
	}
453
        $memberhash{$_} = join ' ', @{$x->{$_}};
236
	$debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n",
454
        $debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
237
					"Referencing \%mapping with ", scalar(keys %mapping), " keys\n";
455
    }
238
	foreach my $key (keys %mapping) {
456
    $debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n",
239
		my  $data = $memberhash{ lc($mapping{$key}->{is}) }; # Net::LDAP returns all names in lowercase
457
                    "Referencing \%mapping with ", scalar(keys %mapping), " keys\n";
240
		$debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
458
    foreach my $key (keys %mapping) {
241
		unless (defined $data) { 
459
        my  $data = $memberhash{ lc($mapping{$key}->{is}) }; # Net::LDAP returns all names in lowercase
242
			$data = $mapping{$key}->{content} || '';	# default or failsafe ''
460
        $debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
243
		}
461
        unless (defined $data) {
244
		$borrower{$key} = ($data ne '') ? $data : ' ' ;
462
            $data = $mapping{$key}->{content} || '';    # default or failsafe ''
245
	}
463
        }
246
	$borrower{initials} = $memberhash{initials} || 
464
        $borrower{$key} = ($data ne '') ? $data : ' ';
247
		( substr($borrower{'firstname'},0,1)
465
    }
248
  		. substr($borrower{ 'surname' },0,1)
466
    $borrower{initials} = $memberhash{initials} || 
249
  		. " ");
467
        ( substr($borrower{'firstname'},0,1)
250
468
          . substr($borrower{ 'surname' },0,1)
251
	# check if categorycode exists, if not, fallback to default from koha-conf.xml
469
          . " ");
252
	my $dbh = C4::Context->dbh;
470
253
	my $sth = $dbh->prepare("SELECT categorycode FROM categories WHERE categorycode = ?");
471
    # check if categorycode exists, if not, fallback to default from koha-conf.xml
254
	$sth->execute( uc($borrower{'categorycode'}) );
472
    my $dbh = C4::Context->dbh;
255
	unless ( my $row = $sth->fetchrow_hashref ) {
473
    my $sth = $dbh->prepare("SELECT categorycode FROM categories WHERE categorycode = ?");
256
		my $default = $mapping{'categorycode'}->{content};
474
    $sth->execute( uc($borrower{'categorycode'}) );
257
		$debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid};
475
    unless ( my $row = $sth->fetchrow_hashref ) {
258
		$borrower{'categorycode'} = $default
476
        my $default = $mapping{'categorycode'}->{content};
259
	}
477
        $debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid};
260
478
        $borrower{'categorycode'} = $default
261
	return %borrower;
479
    }
480
481
    return %borrower;
262
}
482
}
263
483
264
sub exists_local {
484
sub exists_local {
265
	my $arg = shift;
485
    my $arg    = shift;
266
	my $dbh = C4::Context->dbh;
486
    my $dbh    = C4::Context->dbh;
267
	my $select = "SELECT borrowernumber,cardnumber,userid,password FROM borrowers ";
487
    my $select = "SELECT borrowers.borrowernumber,cardnumber,userid,borrowers.password FROM borrowers ";
268
488
269
	my $sth = $dbh->prepare("$select WHERE userid=?");	# was cardnumber=?
489
    my $sth = $dbh->prepare("$select WHERE userid=?");    # was cardnumber=?
270
	$sth->execute($arg);
490
    $sth->execute($arg);
271
	$debug and printf STDERR "Userid '$arg' exists_local? %s\n", $sth->rows;
491
    $debug and printf STDERR "Userid '$arg' exists_local? %s\n", $sth->rows;
272
	($sth->rows == 1) and return $sth->fetchrow;
492
    ($sth->rows == 1) and return $sth->fetchrow;
273
493
274
	$sth = $dbh->prepare("$select WHERE cardnumber=?");
494
    $sth = $dbh->prepare("$select WHERE cardnumber=?");
275
	$sth->execute($arg);
495
    $sth->execute($arg);
276
	$debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
496
    $debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
277
	($sth->rows == 1) and return $sth->fetchrow;
497
    ($sth->rows == 1) and return $sth->fetchrow;
278
	return 0;
498
499
    $sth = $dbh->prepare("$select JOIN borrower_attributes USING (borrowernumber) WHERE attribute=?");
500
    $sth->execute($arg);
501
    $debug and printf STDERR "attribute '$arg' exists_local? %s\n", $sth->rows;
502
    ($sth->rows == 1) and return $sth->fetchrow;
503
    return 0;
279
}
504
}
280
505
281
sub _do_changepassword {
506
sub _do_changepassword {
Lines 343-422 C4::Auth - Authenticates Koha users Link Here
343
	Make sure that ALL required fields are populated by your LDAP database (and mapped in KOHA_CONF).  
568
	Make sure that ALL required fields are populated by your LDAP database (and mapped in KOHA_CONF).  
344
	What are the required fields?  Well, in mysql you can check the database table "borrowers" like this:
569
	What are the required fields?  Well, in mysql you can check the database table "borrowers" like this:
345
570
346
	mysql> show COLUMNS from borrowers;
571
    mysql> show COLUMNS from borrowers;
347
		+---------------------+--------------+------+-----+---------+----------------+
572
        +---------------------+--------------+------+-----+---------+----------------+
348
		| Field               | Type         | Null | Key | Default | Extra          |
573
        | Field               | Type         | Null | Key | Default | Extra          |
349
		+---------------------+--------------+------+-----+---------+----------------+
574
        +---------------------+--------------+------+-----+---------+----------------+
350
		| borrowernumber      | int(11)      | NO   | PRI | NULL    | auto_increment |
575
        | borrowernumber      | int(11)      | NO   | PRI | NULL    | auto_increment |
351
		| cardnumber          | varchar(16)  | YES  | UNI | NULL    |                |
576
        | cardnumber          | varchar(16)  | YES  | UNI | NULL    |                |
352
		| surname             | mediumtext   | NO   |     | NULL    |                |
577
        | surname             | mediumtext   | NO   |     | NULL    |                |
353
		| firstname           | text         | YES  |     | NULL    |                |
578
        | firstname           | text         | YES  |     | NULL    |                |
354
		| title               | mediumtext   | YES  |     | NULL    |                |
579
        | title               | mediumtext   | YES  |     | NULL    |                |
355
		| othernames          | mediumtext   | YES  |     | NULL    |                |
580
        | othernames          | mediumtext   | YES  |     | NULL    |                |
356
		| initials            | text         | YES  |     | NULL    |                |
581
        | initials            | text         | YES  |     | NULL    |                |
357
		| streetnumber        | varchar(10)  | YES  |     | NULL    |                |
582
        | streetnumber        | varchar(10)  | YES  |     | NULL    |                |
358
		| streettype          | varchar(50)  | YES  |     | NULL    |                |
583
        | streettype          | varchar(50)  | YES  |     | NULL    |                |
359
		| address             | mediumtext   | NO   |     | NULL    |                |
584
        | address             | mediumtext   | NO   |     | NULL    |                |
360
		| address2            | text         | YES  |     | NULL    |                |
585
        | address2            | text         | YES  |     | NULL    |                |
361
		| city                | mediumtext   | NO   |     | NULL    |                |
586
        | city                | mediumtext   | NO   |     | NULL    |                |
362
		| state               | mediumtext   | YES  |     | NULL    |                |
587
        | state               | text         | YES  |     | NULL    |                |
363
		| zipcode             | varchar(25)  | YES  |     | NULL    |                |
588
        | zipcode             | varchar(25)  | YES  |     | NULL    |                |
364
		| country             | text         | YES  |     | NULL    |                |
589
        | country             | text         | YES  |     | NULL    |                |
365
		| email               | mediumtext   | YES  |     | NULL    |                |
590
        | email               | mediumtext   | YES  |     | NULL    |                |
366
		| phone               | text         | YES  |     | NULL    |                |
591
        | phone               | text         | YES  |     | NULL    |                |
367
		| mobile              | varchar(50)  | YES  |     | NULL    |                |
592
        | mobile              | varchar(50)  | YES  |     | NULL    |                |
368
		| fax                 | mediumtext   | YES  |     | NULL    |                |
593
        | fax                 | mediumtext   | YES  |     | NULL    |                |
369
		| emailpro            | text         | YES  |     | NULL    |                |
594
        | emailpro            | text         | YES  |     | NULL    |                |
370
		| phonepro            | text         | YES  |     | NULL    |                |
595
        | phonepro            | text         | YES  |     | NULL    |                |
371
		| B_streetnumber      | varchar(10)  | YES  |     | NULL    |                |
596
        | B_streetnumber      | varchar(10)  | YES  |     | NULL    |                |
372
		| B_streettype        | varchar(50)  | YES  |     | NULL    |                |
597
        | B_streettype        | varchar(50)  | YES  |     | NULL    |                |
373
		| B_address           | varchar(100) | YES  |     | NULL    |                |
598
        | B_address           | varchar(100) | YES  |     | NULL    |                |
374
		| B_address2          | text         | YES  |     | NULL    |                |
599
        | B_address2          | text         | YES  |     | NULL    |                |
375
		| B_city              | mediumtext   | YES  |     | NULL    |                |
600
        | B_city              | mediumtext   | YES  |     | NULL    |                |
376
		| B_state             | mediumtext   | YES  |     | NULL    |                |
601
        | B_state             | text         | YES  |     | NULL    |                |
377
		| B_zipcode           | varchar(25)  | YES  |     | NULL    |                |
602
        | B_zipcode           | varchar(25)  | YES  |     | NULL    |                |
378
		| B_country           | text         | YES  |     | NULL    |                |
603
        | B_country           | text         | YES  |     | NULL    |                |
379
		| B_email             | text         | YES  |     | NULL    |                |
604
        | B_email             | text         | YES  |     | NULL    |                |
380
		| B_phone             | mediumtext   | YES  |     | NULL    |                |
605
        | B_phone             | mediumtext   | YES  |     | NULL    |                |
381
		| dateofbirth         | date         | YES  |     | NULL    |                |
606
        | dateofbirth         | date         | YES  |     | NULL    |                |
382
		| branchcode          | varchar(10)  | NO   | MUL |         |                |
607
        | branchcode          | varchar(10)  | NO   | MUL |         |                |
383
		| categorycode        | varchar(10)  | NO   | MUL |         |                |
608
        | categorycode        | varchar(10)  | NO   | MUL |         |                |
384
		| dateenrolled        | date         | YES  |     | NULL    |                |
609
        | dateenrolled        | date         | YES  |     | NULL    |                |
385
		| dateexpiry          | date         | YES  |     | NULL    |                |
610
        | dateexpiry          | date         | YES  |     | NULL    |                |
386
		| gonenoaddress       | tinyint(1)   | YES  |     | NULL    |                |
611
        | gonenoaddress       | tinyint(1)   | YES  |     | NULL    |                |
387
		| lost                | tinyint(1)   | YES  |     | NULL    |                |
612
        | lost                | tinyint(1)   | YES  |     | NULL    |                |
388
		| debarred            | date         | YES  |     | NULL    |                |
613
        | debarred            | date         | YES  |     | NULL    |                |
389
		| debarredcomment     | varchar(255) | YES  |     | NULL    |                |
614
        | debarredcomment     | varchar(255) | YES  |     | NULL    |                |
390
		| contactname         | mediumtext   | YES  |     | NULL    |                |
615
        | contactname         | mediumtext   | YES  |     | NULL    |                |
391
		| contactfirstname    | text         | YES  |     | NULL    |                |
616
        | contactfirstname    | text         | YES  |     | NULL    |                |
392
		| contacttitle        | text         | YES  |     | NULL    |                |
617
        | contacttitle        | text         | YES  |     | NULL    |                |
393
		| guarantorid         | int(11)      | YES  | MUL | NULL    |                |
618
        | guarantorid         | int(11)      | YES  | MUL | NULL    |                |
394
		| borrowernotes       | mediumtext   | YES  |     | NULL    |                |
619
        | borrowernotes       | mediumtext   | YES  |     | NULL    |                |
395
		| relationship        | varchar(100) | YES  |     | NULL    |                |
620
        | relationship        | varchar(100) | YES  |     | NULL    |                |
396
		| ethnicity           | varchar(50)  | YES  |     | NULL    |                |
621
        | ethnicity           | varchar(50)  | YES  |     | NULL    |                |
397
		| ethnotes            | varchar(255) | YES  |     | NULL    |                |
622
        | ethnotes            | varchar(255) | YES  |     | NULL    |                |
398
		| sex                 | varchar(1)   | YES  |     | NULL    |                |
623
        | sex                 | varchar(1)   | YES  |     | NULL    |                |
399
		| password            | varchar(30)  | YES  |     | NULL    |                |
624
        | password            | varchar(30)  | YES  |     | NULL    |                |
400
		| flags               | int(11)      | YES  |     | NULL    |                |
625
        | flags               | int(11)      | YES  |     | NULL    |                |
401
		| userid              | varchar(30)  | YES  | MUL | NULL    |                |
626
        | userid              | varchar(75)  | YES  | MUL | NULL    |                |
402
		| opacnote            | mediumtext   | YES  |     | NULL    |                |
627
        | opacnote            | mediumtext   | YES  |     | NULL    |                |
403
		| contactnote         | varchar(255) | YES  |     | NULL    |                |
628
        | contactnote         | varchar(255) | YES  |     | NULL    |                |
404
		| sort1               | varchar(80)  | YES  |     | NULL    |                |
629
        | sort1               | varchar(80)  | YES  |     | NULL    |                |
405
		| sort2               | varchar(80)  | YES  |     | NULL    |                |
630
        | sort2               | varchar(80)  | YES  |     | NULL    |                |
406
		| altcontactfirstname | varchar(255) | YES  |     | NULL    |                |
631
        | altcontactfirstname | varchar(255) | YES  |     | NULL    |                |
407
		| altcontactsurname   | varchar(255) | YES  |     | NULL    |                |
632
        | altcontactsurname   | varchar(255) | YES  |     | NULL    |                |
408
		| altcontactaddress1  | varchar(255) | YES  |     | NULL    |                |
633
        | altcontactaddress1  | varchar(255) | YES  |     | NULL    |                |
409
		| altcontactaddress2  | varchar(255) | YES  |     | NULL    |                |
634
        | altcontactaddress2  | varchar(255) | YES  |     | NULL    |                |
410
		| altcontactaddress3  | varchar(255) | YES  |     | NULL    |                |
635
        | altcontactaddress3  | varchar(255) | YES  |     | NULL    |                |
411
		| altcontactstate     | mediumtext   | YES  |     | NULL    |                |
636
        | altcontactstate     | text         | YES  |     | NULL    |                |
412
		| altcontactzipcode   | varchar(50)  | YES  |     | NULL    |                |
637
        | altcontactzipcode   | varchar(50)  | YES  |     | NULL    |                |
413
		| altcontactcountry   | text         | YES  |     | NULL    |                |
638
        | altcontactcountry   | text         | YES  |     | NULL    |                |
414
		| altcontactphone     | varchar(50)  | YES  |     | NULL    |                |
639
        | altcontactphone     | varchar(50)  | YES  |     | NULL    |                |
415
		| smsalertnumber      | varchar(50)  | YES  |     | NULL    |                |
640
        | smsalertnumber      | varchar(50)  | YES  |     | NULL    |                |
416
		| privacy             | int(11)      | NO   |     | 1       |                |
641
        | privacy             | int(11)      | NO   |     | 1       |                |
417
		+---------------------+--------------+------+-----+---------+----------------+
642
        +---------------------+--------------+------+-----+---------+----------------+
418
		66 rows in set (0.00 sec)
643
        67 rows in set (0.00 sec)
419
		Where Null="NO", the field is required.
644
        Where Null="NO", the field is required.
420
645
421
=head1 KOHA_CONF and field mapping
646
=head1 KOHA_CONF and field mapping
422
647
(-)a/C4/LDAPAuthMethodTutorial.pod (-1 / +91 lines)
Line 0 Link Here
0
- 
1
=head1 LDAP auth_method configuration
2
3
This document is a step by step explaination for the new LDAP configuration
4
method. The old one (see C4::Auth_with_ldap) still exists and you should give it
5
a try if your needs of mappings and transformations are low.
6
7
=head2 What do I have to ask to the directory administrator
8
9
=head3 How to reach the service
10
11
What we need is build the url of the ldap service we want to reach. So ask him
12
for the URL. If he don't know, ask for the scheme (or protocol), the hostname
13
and the port of the directory. Only hostname and scheme are mandatory.
14
15
The scheme must be ldap or ldaps (ldaps is for crypted ldap, ldap over SSL).
16
The url construction is:
17
18
    scheme://hostname:port
19
    scheme://hostname
20
21
examples
22
23
    host=directory.example.com port=389 scheme=ldap
24
25
gives you:
26
27
    ldap://directory.example.com:389
28
29
Also: Active Directory (the Microsoft implementation) is an LDAP alike directory
30
but Koha have to know it's active directory to use it, so please ask.
31
32
=head3 What is the binding method ?
33
34
Are anonymous allowed to make some searches on the server? If not, what is the
35
credentials for the koha account ? Credentials are a pair (DN, password)
36
37
    uid=koha,ou=people,dc=example,dc=com MYS3CRET
38
39
in Active Directory, it can be a login@example.com with a password
40
41
    koha@example.com MYS3CRET
42
43
=head3 Now configure koha
44
45
This is a basic exemple of things you will add in the C</config> part of
46
C<koha-conf.xml>.
47
48
First of all, you need to tell koha that ldap authentication is now relevant
49
50
    <useldapserver>1</useldapserver>
51
52
If you use anonymous method, you have to give credentials of koha account
53
54
    <ldapserver url="ldap://directory.example.com"
55
          manager="uid=koha,ou=people,dc=example,dc=com"
56
          password="MYS3CRET"
57
          authmethod="search_dn" >
58
59
Also, you can set the values for replication and update (documented in legacy
60
pod):
61
62
    <ldapserver url="ldap://directory.example.com"
63
          manager="uid=koha,ou=people,dc=example,dc=com"
64
          password="MYS3CRET"
65
          authmethod="search_dn"
66
          replicate="1" update="1"
67
    >
68
69
You must now tell koha the ldap branches where to find users
70
71
    <useldapserver>1</useldapserver>
72
    <ldapserver url="ldap://directory.example.com"
73
          manager="uid=koha,ou=people,dc=example,dc=com"
74
          password="MYS3CRET"
75
          authmethod="search_dn"
76
          replicate="1" update="1"
77
    >
78
      <branch dn="ou=people,dc=site1,dc=example,dc=com" />
79
      <branch dn="ou=people,dc=site2,dc=example,dc=com" />
80
      <branch dn="ou=people,dc=site4,dc=example,dc=com" />
81
82
The best part of this new config is that you don't have to rely on simple
83
mappings anymore (but you still can): you can use a perl module to write much
84
sofisticated transformations directly in perl:
85
86
      <transformation module="C4::LDAPTransform::CustomTransform" />
87
88
This module only have to define a subroutine named get_borrower
89
90
91

Return to bug 8993