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

(-)a/C4/Auth_with_ldap.pm (-215 / +439 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-177 $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
    # Perform an anonymous bind
241
        for ( $$ldap{branch} ) {
117
    my $res = $db->bind;
242
            $_ or die "no branch, no auth";
118
    if ( $res->code ) {
243
            ref $_ eq 'HASH' and $_ = [$_];
119
      $debug and warn "Anonymous LDAP bind failed: ". description($res);
244
        }
120
      return 0;
245
121
    }
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
248
249
        # if the filter isn't set, userid mapping is used
250
        $$ldap{filter} ||= "$uattr=%s";
251
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}";
297
                return 0;
298
            }
299
        };
300
301
        eval { $cnx->bind( $login, password => $password ) };
302
        if ( $@ ) {
303
            say STDERR "ldap bind with $login failed: $@";
304
            return 0;
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;
314
        }
315
        #$debug and $db->debug(5);
316
317
        if ( $ldap->{auth_by_bind} ) {
318
            # Perform an anonymous bind
319
            my $res = $db->bind;
320
            if ( $res->code ) {
321
              $debug and warn "Anonymous LDAP bind failed: ". description($res);
322
              return 0;
323
            }
122
324
123
    # Perform a LDAP search for the given username
325
            # Perform a LDAP search for the given username
124
    my $search = search_method($db, $userid) or return 0;   # warnings are in the sub
326
            my $search = search_method($db, $userid) or return 0;   # warnings are in the sub
125
    $userldapentry = $search->shift_entry;
327
            $userldapentry = $search->shift_entry;
126
328
127
    # Perform a LDAP bind for the given username using the matched DN
329
            # Perform a LDAP bind for the given username using the matched DN
128
    $res = $db->bind( $userldapentry->dn, password => $password );
330
            $res = $db->bind( $userldapentry->dn, password => $password );
129
    if ( $res->code ) {
331
            if ( $res->code ) {
130
      $debug and warn "LDAP bind failed as kohauser $userid: ". description($res);
332
              $debug and warn "LDAP bind failed as kohauser $userid: ". description($res);
131
      return 0;
333
              return 0;
334
            }
335
        } else {
336
            say STDERR "deprecated kludge: use authmethod search_dn instead";
337
            my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
338
            if ($res->code) {		# connection refused
339
                warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') . ": " . description($res);
340
                return 0;
341
            }
342
            my $search = search_method($db, $userid) or return 0;    # warnings are in the sub
343
            $userldapentry = $search->shift_entry;
344
            my $cmpmesg = $db->compare( $userldapentry, attr => 'userpassword', value => $password );
345
            if ($cmpmesg->code != 6) {
346
                warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
347
            return 0;
348
            }
349
        }
132
    }
350
    }
133
351
134
  } else {
352
    if ( my $t = $$ldap{transformation} ) {
135
		my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
353
        $$t{subroutine} ||= 'get_borrower';
136
		if ($res->code) {		# connection refused
354
        my $get_borrower = load_subroutine ( @$t{qw/ module subroutine /} );
137
			warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') . ": " . description($res);
355
        unless ( $get_borrower ) {
138
			return 0;
356
            warn "no get_borrower $$t{subroutine} subroutine in $$t{module}";
139
		}
357
            return 0;
140
        my $search = search_method($db, $userid) or return 0;   # warnings are in the sub
358
        }
141
        $userldapentry = $search->shift_entry;
359
        debug_msg "$$t{subroutine} subroutine loaded from $$t{module}";
142
		my $cmpmesg = $db->compare( $userldapentry, attr=>'userpassword', value => $password );
360
        if ( my $b = $get_borrower->( $$to_borrower{entry} ) ) {
143
		if ($cmpmesg->code != 6) {
361
            return accept_borrower $b,$userid;
144
			warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
362
        }
145
			return 0;
363
        else { return 0 }
146
		}
364
    }
147
	}
148
365
149
    # To get here, LDAP has accepted our user's login attempt.
366
    # To get here, LDAP has accepted our user's login attempt.
150
    # But we still have work to do.  See perldoc below for detailed breakdown.
367
    # But we still have work to do.  See perldoc below for detailed breakdown.
151
368
152
    my (%borrower);
369
    my %borrower;
153
	my ($borrowernumber,$cardnumber,$local_userid,$savedpw) = exists_local($userid);
370
    my ($borrowernumber, $cardnumber, $local_userid, $savedpw) = exists_local($userid);
154
371
155
    if (( $borrowernumber and $config{update}   ) or
372
    if (  ( $borrowernumber and $config{update} )
156
        (!$borrowernumber and $config{replicate})   ) {
373
        or ( !$borrowernumber and $config{replicate} ) ) {
157
        %borrower = ldap_entry_2_hash($userldapentry,$userid);
374
        %borrower = ldap_entry_2_hash( $userldapentry, $userid );
158
        $debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
375
        $debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
159
    }
376
    }
160
377
161
    if ($borrowernumber) {
378
    if ($borrowernumber) {
162
        if ($config{update}) { # A1, B1
379
        if ($config{update}) { # A1, B1
163
            my $c2 = &update_local($local_userid,$password,$borrowernumber,\%borrower) || '';
380
            my $c2 = &update_local($local_userid, $password, $borrowernumber, \%borrower) || '';
164
            ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'";
381
            ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'";
165
        } else { # C1, D1
382
        } else { # C1, D1
166
            # maybe update just the password?
383
            # maybe update just the password?
167
		return(1, $cardnumber, $local_userid);
384
            return (1, $cardnumber, $local_userid);
168
        }
385
        }
169
    } elsif ($config{replicate}) { # A2, C2
386
    } elsif ($config{replicate}) { # A2, C2
170
        $borrowernumber = AddMember(%borrower) or die "AddMember failed";
387
        $borrowernumber = AddMember(%borrower) or die "AddMember failed";
171
   } else {
388
    } else {
172
        return 0;   # B2, D2
389
        return 0;                       # B2, D2
173
    }
390
    }
174
    if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} ||$config{replicate})) {
391
    if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} || $config{replicate})) {
175
        my @extended_patron_attributes;
392
        my @extended_patron_attributes;
176
        foreach my $attribute_type ( C4::Members::AttributeTypes::GetAttributeTypes() ) {
393
        foreach my $attribute_type ( C4::Members::AttributeTypes::GetAttributeTypes() ) {
177
            my $code = $attribute_type->{code};
394
            my $code = $attribute_type->{code};
Lines 190-196 sub checkpw_ldap { Link Here
190
        }
407
        }
191
        C4::Members::Attributes::SetBorrowerAttributes($borrowernumber, \@unique_attr);
408
        C4::Members::Attributes::SetBorrowerAttributes($borrowernumber, \@unique_attr);
192
    }
409
    }
193
return(1, $cardnumber, $userid);
410
    return(1, $cardnumber, $userid);
194
}
411
}
195
412
196
# Pass LDAP entry object and local cardnumber (userid).
413
# Pass LDAP entry object and local cardnumber (userid).
Lines 199-261 return(1, $cardnumber, $userid); Link Here
199
# Ensure that mandatory fields are correctly filled!
416
# Ensure that mandatory fields are correctly filled!
200
#
417
#
201
sub ldap_entry_2_hash {
418
sub ldap_entry_2_hash {
202
	my $userldapentry = shift;
419
    my $userldapentry = shift;
203
	my %borrower = ( cardnumber => shift );
420
    my %borrower = ( cardnumber => shift );
204
	my %memberhash;
421
    my %memberhash;
205
	$userldapentry->exists('uid');	# This is bad, but required!  By side-effect, this initializes the attrs hash. 
422
    $userldapentry->exists('uid');    # This is bad, but required!  By side-effect, this initializes the attrs hash.
206
	if ($debug) {
423
    if ($debug) {
207
		foreach (keys %$userldapentry) {
424
        print STDERR "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump();
208
			print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
425
        foreach (keys %$userldapentry) {
209
		}
426
            print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
210
	}
427
            hashdump("LDAP key: ",$userldapentry->{$_});
211
	my $x = $userldapentry->{attrs} or return;
428
        }
212
	foreach (keys %$x) {
429
    }
213
		$memberhash{$_} = join ' ', @{$x->{$_}};	
430
    my $x = $userldapentry->{attrs} or return;
214
		$debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
431
    foreach (keys %$x) {
215
	}
432
        $memberhash{$_} = join ' ', @{$x->{$_}};
216
	$debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n",
433
        $debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
217
					"Referencing \%mapping with ", scalar(keys %mapping), " keys\n";
434
    }
218
	foreach my $key (keys %mapping) {
435
    $debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n",
219
		my  $data = $memberhash{ lc($mapping{$key}->{is}) }; # Net::LDAP returns all names in lowercase
436
                    "Referencing \%mapping with ", scalar(keys %mapping), " keys\n";
220
		$debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
437
    foreach my $key (keys %mapping) {
221
		unless (defined $data) { 
438
        my  $data = $memberhash{ lc($mapping{$key}->{is}) }; # Net::LDAP returns all names in lowercase
222
			$data = $mapping{$key}->{content} || '';	# default or failsafe ''
439
        $debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
223
		}
440
        unless (defined $data) {
224
		$borrower{$key} = ($data ne '') ? $data : ' ' ;
441
            $data = $mapping{$key}->{content} || '';    # default or failsafe ''
225
	}
442
        }
226
	$borrower{initials} = $memberhash{initials} || 
443
        $borrower{$key} = ($data ne '') ? $data : ' ';
227
		( substr($borrower{'firstname'},0,1)
444
    }
228
  		. substr($borrower{ 'surname' },0,1)
445
    $borrower{initials} = $memberhash{initials} || 
229
  		. " ");
446
        ( substr($borrower{'firstname'},0,1)
230
447
          . substr($borrower{ 'surname' },0,1)
231
	# check if categorycode exists, if not, fallback to default from koha-conf.xml
448
          . " ");
232
	my $dbh = C4::Context->dbh;
449
233
	my $sth = $dbh->prepare("SELECT categorycode FROM categories WHERE categorycode = ?");
450
    # check if categorycode exists, if not, fallback to default from koha-conf.xml
234
	$sth->execute( uc($borrower{'categorycode'}) );
451
    my $dbh = C4::Context->dbh;
235
	unless ( my $row = $sth->fetchrow_hashref ) {
452
    my $sth = $dbh->prepare("SELECT categorycode FROM categories WHERE categorycode = ?");
236
		my $default = $mapping{'categorycode'}->{content};
453
    $sth->execute( uc($borrower{'categorycode'}) );
237
		$debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid};
454
    unless ( my $row = $sth->fetchrow_hashref ) {
238
		$borrower{'categorycode'} = $default
455
        my $default = $mapping{'categorycode'}->{content};
239
	}
456
        $debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid};
240
457
        $borrower{'categorycode'} = $default
241
	return %borrower;
458
    }
459
460
    return %borrower;
242
}
461
}
243
462
244
sub exists_local {
463
sub exists_local {
245
	my $arg = shift;
464
    my $arg    = shift;
246
	my $dbh = C4::Context->dbh;
465
    my $dbh    = C4::Context->dbh;
247
	my $select = "SELECT borrowernumber,cardnumber,userid,password FROM borrowers ";
466
    my $select = "SELECT borrowers.borrowernumber,cardnumber,userid,borrowers.password FROM borrowers ";
248
467
249
	my $sth = $dbh->prepare("$select WHERE userid=?");	# was cardnumber=?
468
    my $sth = $dbh->prepare("$select WHERE userid=?");    # was cardnumber=?
250
	$sth->execute($arg);
469
    $sth->execute($arg);
251
	$debug and printf STDERR "Userid '$arg' exists_local? %s\n", $sth->rows;
470
    $debug and printf STDERR "Userid '$arg' exists_local? %s\n", $sth->rows;
252
	($sth->rows == 1) and return $sth->fetchrow;
471
    ($sth->rows == 1) and return $sth->fetchrow;
253
472
254
	$sth = $dbh->prepare("$select WHERE cardnumber=?");
473
    $sth = $dbh->prepare("$select WHERE cardnumber=?");
255
	$sth->execute($arg);
474
    $sth->execute($arg);
256
	$debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
475
    $debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
257
	($sth->rows == 1) and return $sth->fetchrow;
476
    ($sth->rows == 1) and return $sth->fetchrow;
258
	return 0;
477
478
    $sth = $dbh->prepare("$select JOIN borrower_attributes USING (borrowernumber) WHERE attribute=?");
479
    $sth->execute($arg);
480
    $debug and printf STDERR "attribute '$arg' exists_local? %s\n", $sth->rows;
481
    ($sth->rows == 1) and return $sth->fetchrow;
482
    return 0;
259
}
483
}
260
484
261
sub _do_changepassword {
485
sub _do_changepassword {
Lines 323-402 C4::Auth - Authenticates Koha users Link Here
323
	Make sure that ALL required fields are populated by your LDAP database (and mapped in KOHA_CONF).  
547
	Make sure that ALL required fields are populated by your LDAP database (and mapped in KOHA_CONF).  
324
	What are the required fields?  Well, in mysql you can check the database table "borrowers" like this:
548
	What are the required fields?  Well, in mysql you can check the database table "borrowers" like this:
325
549
326
	mysql> show COLUMNS from borrowers;
550
    mysql> show COLUMNS from borrowers;
327
		+---------------------+--------------+------+-----+---------+----------------+
551
        +---------------------+--------------+------+-----+---------+----------------+
328
		| Field               | Type         | Null | Key | Default | Extra          |
552
        | Field               | Type         | Null | Key | Default | Extra          |
329
		+---------------------+--------------+------+-----+---------+----------------+
553
        +---------------------+--------------+------+-----+---------+----------------+
330
		| borrowernumber      | int(11)      | NO   | PRI | NULL    | auto_increment |
554
        | borrowernumber      | int(11)      | NO   | PRI | NULL    | auto_increment |
331
		| cardnumber          | varchar(16)  | YES  | UNI | NULL    |                |
555
        | cardnumber          | varchar(16)  | YES  | UNI | NULL    |                |
332
		| surname             | mediumtext   | NO   |     | NULL    |                |
556
        | surname             | mediumtext   | NO   |     | NULL    |                |
333
		| firstname           | text         | YES  |     | NULL    |                |
557
        | firstname           | text         | YES  |     | NULL    |                |
334
		| title               | mediumtext   | YES  |     | NULL    |                |
558
        | title               | mediumtext   | YES  |     | NULL    |                |
335
		| othernames          | mediumtext   | YES  |     | NULL    |                |
559
        | othernames          | mediumtext   | YES  |     | NULL    |                |
336
		| initials            | text         | YES  |     | NULL    |                |
560
        | initials            | text         | YES  |     | NULL    |                |
337
		| streetnumber        | varchar(10)  | YES  |     | NULL    |                |
561
        | streetnumber        | varchar(10)  | YES  |     | NULL    |                |
338
		| streettype          | varchar(50)  | YES  |     | NULL    |                |
562
        | streettype          | varchar(50)  | YES  |     | NULL    |                |
339
		| address             | mediumtext   | NO   |     | NULL    |                |
563
        | address             | mediumtext   | NO   |     | NULL    |                |
340
		| address2            | text         | YES  |     | NULL    |                |
564
        | address2            | text         | YES  |     | NULL    |                |
341
		| city                | mediumtext   | NO   |     | NULL    |                |
565
        | city                | mediumtext   | NO   |     | NULL    |                |
342
		| state               | mediumtext   | YES  |     | NULL    |                |
566
        | state               | text         | YES  |     | NULL    |                |
343
		| zipcode             | varchar(25)  | YES  |     | NULL    |                |
567
        | zipcode             | varchar(25)  | YES  |     | NULL    |                |
344
		| country             | text         | YES  |     | NULL    |                |
568
        | country             | text         | YES  |     | NULL    |                |
345
		| email               | mediumtext   | YES  |     | NULL    |                |
569
        | email               | mediumtext   | YES  |     | NULL    |                |
346
		| phone               | text         | YES  |     | NULL    |                |
570
        | phone               | text         | YES  |     | NULL    |                |
347
		| mobile              | varchar(50)  | YES  |     | NULL    |                |
571
        | mobile              | varchar(50)  | YES  |     | NULL    |                |
348
		| fax                 | mediumtext   | YES  |     | NULL    |                |
572
        | fax                 | mediumtext   | YES  |     | NULL    |                |
349
		| emailpro            | text         | YES  |     | NULL    |                |
573
        | emailpro            | text         | YES  |     | NULL    |                |
350
		| phonepro            | text         | YES  |     | NULL    |                |
574
        | phonepro            | text         | YES  |     | NULL    |                |
351
		| B_streetnumber      | varchar(10)  | YES  |     | NULL    |                |
575
        | B_streetnumber      | varchar(10)  | YES  |     | NULL    |                |
352
		| B_streettype        | varchar(50)  | YES  |     | NULL    |                |
576
        | B_streettype        | varchar(50)  | YES  |     | NULL    |                |
353
		| B_address           | varchar(100) | YES  |     | NULL    |                |
577
        | B_address           | varchar(100) | YES  |     | NULL    |                |
354
		| B_address2          | text         | YES  |     | NULL    |                |
578
        | B_address2          | text         | YES  |     | NULL    |                |
355
		| B_city              | mediumtext   | YES  |     | NULL    |                |
579
        | B_city              | mediumtext   | YES  |     | NULL    |                |
356
		| B_state             | mediumtext   | YES  |     | NULL    |                |
580
        | B_state             | text         | YES  |     | NULL    |                |
357
		| B_zipcode           | varchar(25)  | YES  |     | NULL    |                |
581
        | B_zipcode           | varchar(25)  | YES  |     | NULL    |                |
358
		| B_country           | text         | YES  |     | NULL    |                |
582
        | B_country           | text         | YES  |     | NULL    |                |
359
		| B_email             | text         | YES  |     | NULL    |                |
583
        | B_email             | text         | YES  |     | NULL    |                |
360
		| B_phone             | mediumtext   | YES  |     | NULL    |                |
584
        | B_phone             | mediumtext   | YES  |     | NULL    |                |
361
		| dateofbirth         | date         | YES  |     | NULL    |                |
585
        | dateofbirth         | date         | YES  |     | NULL    |                |
362
		| branchcode          | varchar(10)  | NO   | MUL |         |                |
586
        | branchcode          | varchar(10)  | NO   | MUL |         |                |
363
		| categorycode        | varchar(10)  | NO   | MUL |         |                |
587
        | categorycode        | varchar(10)  | NO   | MUL |         |                |
364
		| dateenrolled        | date         | YES  |     | NULL    |                |
588
        | dateenrolled        | date         | YES  |     | NULL    |                |
365
		| dateexpiry          | date         | YES  |     | NULL    |                |
589
        | dateexpiry          | date         | YES  |     | NULL    |                |
366
		| gonenoaddress       | tinyint(1)   | YES  |     | NULL    |                |
590
        | gonenoaddress       | tinyint(1)   | YES  |     | NULL    |                |
367
		| lost                | tinyint(1)   | YES  |     | NULL    |                |
591
        | lost                | tinyint(1)   | YES  |     | NULL    |                |
368
		| debarred            | date         | YES  |     | NULL    |                |
592
        | debarred            | date         | YES  |     | NULL    |                |
369
		| debarredcomment     | varchar(255) | YES  |     | NULL    |                |
593
        | debarredcomment     | varchar(255) | YES  |     | NULL    |                |
370
		| contactname         | mediumtext   | YES  |     | NULL    |                |
594
        | contactname         | mediumtext   | YES  |     | NULL    |                |
371
		| contactfirstname    | text         | YES  |     | NULL    |                |
595
        | contactfirstname    | text         | YES  |     | NULL    |                |
372
		| contacttitle        | text         | YES  |     | NULL    |                |
596
        | contacttitle        | text         | YES  |     | NULL    |                |
373
		| guarantorid         | int(11)      | YES  | MUL | NULL    |                |
597
        | guarantorid         | int(11)      | YES  | MUL | NULL    |                |
374
		| borrowernotes       | mediumtext   | YES  |     | NULL    |                |
598
        | borrowernotes       | mediumtext   | YES  |     | NULL    |                |
375
		| relationship        | varchar(100) | YES  |     | NULL    |                |
599
        | relationship        | varchar(100) | YES  |     | NULL    |                |
376
		| ethnicity           | varchar(50)  | YES  |     | NULL    |                |
600
        | ethnicity           | varchar(50)  | YES  |     | NULL    |                |
377
		| ethnotes            | varchar(255) | YES  |     | NULL    |                |
601
        | ethnotes            | varchar(255) | YES  |     | NULL    |                |
378
		| sex                 | varchar(1)   | YES  |     | NULL    |                |
602
        | sex                 | varchar(1)   | YES  |     | NULL    |                |
379
		| password            | varchar(30)  | YES  |     | NULL    |                |
603
        | password            | varchar(30)  | YES  |     | NULL    |                |
380
		| flags               | int(11)      | YES  |     | NULL    |                |
604
        | flags               | int(11)      | YES  |     | NULL    |                |
381
		| userid              | varchar(30)  | YES  | MUL | NULL    |                |
605
        | userid              | varchar(75)  | YES  | MUL | NULL    |                |
382
		| opacnote            | mediumtext   | YES  |     | NULL    |                |
606
        | opacnote            | mediumtext   | YES  |     | NULL    |                |
383
		| contactnote         | varchar(255) | YES  |     | NULL    |                |
607
        | contactnote         | varchar(255) | YES  |     | NULL    |                |
384
		| sort1               | varchar(80)  | YES  |     | NULL    |                |
608
        | sort1               | varchar(80)  | YES  |     | NULL    |                |
385
		| sort2               | varchar(80)  | YES  |     | NULL    |                |
609
        | sort2               | varchar(80)  | YES  |     | NULL    |                |
386
		| altcontactfirstname | varchar(255) | YES  |     | NULL    |                |
610
        | altcontactfirstname | varchar(255) | YES  |     | NULL    |                |
387
		| altcontactsurname   | varchar(255) | YES  |     | NULL    |                |
611
        | altcontactsurname   | varchar(255) | YES  |     | NULL    |                |
388
		| altcontactaddress1  | varchar(255) | YES  |     | NULL    |                |
612
        | altcontactaddress1  | varchar(255) | YES  |     | NULL    |                |
389
		| altcontactaddress2  | varchar(255) | YES  |     | NULL    |                |
613
        | altcontactaddress2  | varchar(255) | YES  |     | NULL    |                |
390
		| altcontactaddress3  | varchar(255) | YES  |     | NULL    |                |
614
        | altcontactaddress3  | varchar(255) | YES  |     | NULL    |                |
391
		| altcontactstate     | mediumtext   | YES  |     | NULL    |                |
615
        | altcontactstate     | text         | YES  |     | NULL    |                |
392
		| altcontactzipcode   | varchar(50)  | YES  |     | NULL    |                |
616
        | altcontactzipcode   | varchar(50)  | YES  |     | NULL    |                |
393
		| altcontactcountry   | text         | YES  |     | NULL    |                |
617
        | altcontactcountry   | text         | YES  |     | NULL    |                |
394
		| altcontactphone     | varchar(50)  | YES  |     | NULL    |                |
618
        | altcontactphone     | varchar(50)  | YES  |     | NULL    |                |
395
		| smsalertnumber      | varchar(50)  | YES  |     | NULL    |                |
619
        | smsalertnumber      | varchar(50)  | YES  |     | NULL    |                |
396
		| privacy             | int(11)      | NO   |     | 1       |                |
620
        | privacy             | int(11)      | NO   |     | 1       |                |
397
		+---------------------+--------------+------+-----+---------+----------------+
621
        +---------------------+--------------+------+-----+---------+----------------+
398
		66 rows in set (0.00 sec)
622
        67 rows in set (0.00 sec)
399
		Where Null="NO", the field is required.
623
        Where Null="NO", the field is required.
400
624
401
=head1 KOHA_CONF and field mapping
625
=head1 KOHA_CONF and field mapping
402
626
(-)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