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

(-)a/C4/Auth_with_ldap.pm (-69 / +299 lines)
Lines 17-30 package C4::Auth_with_ldap; Link Here
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
19
20
use strict;
20
use Modern::Perl;
21
#use warnings; FIXME - Bug 2505
22
use Carp;
21
use Carp;
23
24
use C4::Debug;
22
use C4::Debug;
25
use C4::Context;
23
use C4::Context;
26
use C4::Members qw(AddMember changepassword);
24
use C4::Members qw(AddMember changepassword);
27
use C4::Members::Attributes;
25
use C4::Members::Attributes qw(SetBorrowerAttributes);
28
use C4::Members::AttributeTypes;
26
use C4::Members::AttributeTypes;
29
use C4::Members::Messaging;
27
use C4::Members::Messaging;
30
use C4::Auth qw(checkpw_internal);
28
use C4::Auth qw(checkpw_internal);
Lines 32-37 use Koha::AuthUtils qw(hash_password); Link Here
32
use List::MoreUtils qw( any );
30
use List::MoreUtils qw( any );
33
use Net::LDAP;
31
use Net::LDAP;
34
use Net::LDAP::Filter;
32
use Net::LDAP::Filter;
33
use YAML;
35
34
36
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
35
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
37
36
Lines 42-47 BEGIN { Link Here
42
	@EXPORT = qw( checkpw_ldap );
41
	@EXPORT = qw( checkpw_ldap );
43
}
42
}
44
43
44
# return the ref of the subroutine
45
sub load_subroutine {
46
    require Package::Stash;
47
    my ( $module, $sub ) = @_;
48
    my $stash = Package::Stash->new($module);
49
    unless ( %{ $stash->namespace } ) {
50
        eval "require $module";
51
        $@ and die $@;
52
    }
53
    $stash->get_package_symbol('&'.$sub);
54
}
55
45
# Redefine checkpw_ldap:
56
# Redefine checkpw_ldap:
46
# connect to LDAP (named or anonymous)
57
# connect to LDAP (named or anonymous)
47
# ~ retrieves $userid from KOHA_CONF mapping
58
# ~ retrieves $userid from KOHA_CONF mapping
Lines 53-66 sub ldapserver_error { Link Here
53
	return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
64
	return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
54
}
65
}
55
66
67
sub debug_msg { $debug and say STDERR @_ }
68
sub logger { say STDERR YAML::Dump @_ }
69
56
use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
70
use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
57
my $context = C4::Context->new() 	or die 'C4::Context->new failed';
71
my $context = C4::Context->new() 	or die 'C4::Context->new failed';
58
my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
72
my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
59
my $prefhost  = $ldap->{hostname}	or die ldapserver_error('hostname');
73
60
my $base      = $ldap->{base}		or die ldapserver_error('base');
74
my ( $prefhost, $base ) = ('')x2;
61
$ldapname     = $ldap->{user}		;
75
unless ( $$ldap{authmethod} ) {
62
$ldappassword = $ldap->{pass}		;
76
    say STDERR "deprecated ldap configuration, see documentation";
63
our %mapping  = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of || (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9
77
    $base = $$ldap{base} or die ldapserver_error('base');
78
    $prefhost = $$ldap{hostname} or die ldapserver_error('hostname');
79
}
80
81
$ldapname     = $ldap->{user};
82
$ldappassword = $ldap->{pass};
83
our %mapping  = %{$ldap->{mapping}} if $ldap->{mapping};
64
my @mapkeys = keys %mapping;
84
my @mapkeys = keys %mapping;
65
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (  total  ): ", join ' ', @mapkeys, "\n";
85
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (  total  ): ", join ' ', @mapkeys, "\n";
66
@mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
86
@mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
Lines 103-184 sub search_method { Link Here
103
    return $search;
123
    return $search;
104
}
124
}
105
125
126
# $cnx is an Net::LDAP object that dies when error occurs
127
# $search are params for the search method (default base is the one set in the config)
128
sub _anon_search {
129
    my ( $cnx, $search ) = @_;
130
131
    my $entry;
132
    for my $branch ( @{ $$ldap{branch} } ) {
133
        debug_msg "search $$search{filter} at $$branch{dn}";
134
135
        my $branch_search = { %$search, base => $$branch{dn}, search => "ObjectClass=*" };
136
        $entry = eval {
137
            $cnx
138
            ->search( %$branch_search )
139
            ->shift_entry
140
        };
141
142
        if ( $entry ) {
143
            debug_msg "found ", $entry->dn;
144
            return { entry => $entry, branch => $branch };
145
        }
146
        elsif ( $@ ) { return { error => 'UNKNOWN', msg => $@ } }
147
        else { $debug and logger { "failed search" => $branch_search } }
148
    }
149
}
150
151
sub set_xattr {
152
    my ( $id, $borrower ) = @_;
153
    if ( my $x = $$borrower{xattr} ) {
154
        #SetBorrowerAttributes is not managing when being sent an Array ref
155
        my $attrs = [ map {
156
            my $key = $_;
157
            my @listattributes;
158
            if (ref ($x->{$key}) eq "ARRAY"){
159
                foreach my $value (@{$x->{$key}}){
160
                  push @listattributes, { code => $key, value => $value }
161
                }
162
            }
163
            else {
164
                push @listattributes, { code => $key, value => $$x{$key} }
165
            }
166
            @listattributes;
167
        } keys %$x ];
168
        $debug and logger { "creating $id" => $attrs };
169
        SetBorrowerAttributes( $id, $attrs );
170
    }
171
}
172
173
sub accept_borrower {
174
    my ($borrower,$userid) = @_;
175
    for ( $$borrower{column}{userid} ) {
176
        $userid ||= $_ or die;
177
        unless ( $_ ) {
178
            $_ = $userid;
179
            next;
180
        }
181
    }
182
183
    my ($id, $cardnumber) = exists_local( $userid ) or debug_msg "$userid is newcommer";
184
185
    my $newcommer = not $id;
186
187
    if ( $newcommer ) {
188
        return 0 unless $config{replicate};
189
        $debug and logger { Member => $$borrower{column} };
190
        $id = AddMember( %{ $$borrower{column} } ) or return 0;
191
    } else {
192
        if ( $config{update} ) {
193
            delete $$borrower{column}{dateenrolled};
194
            delete $$borrower{column}{dateexpiry};
195
            $cardnumber = update_local
196
            ( $userid, $$borrower{column}{password}, $id, $$borrower{column} ); 
197
            if ( my $old_cardnumber = $$borrower{column}{cardnumber} ) {
198
                if ( $old_cardnumber ne $cardnumber ) {
199
                    warn "update_local returned cardnumber '$cardnumber' instead of '$old_cardnumber'";
200
                    return 0;
201
                }
202
            }
203
        }
204
    }
205
206
    if ( $newcommer || $config{'update'} ) {
207
        $debug and logger { "changing attrs for $id" => $$borrower{xattr} };
208
        set_xattr $id, $borrower;
209
    }
210
211
    return ( 1, $cardnumber, $userid );
212
}
213
214
sub cnx {
215
    my $cnx = Net::LDAP->new( $ldap->{uri}, onerror => 'die' ) or do {
216
        warn "ldap error: $!";
217
    };
218
    # bind MUST success
219
    my $msg = eval {
220
        if ( $ldap->{manager} ) {
221
            $cnx->bind ($ldap->{manager}, password => $ldap->{password})
222
        } else {
223
            $cnx->bind();
224
        }
225
    };
226
    debug_msg "ldap $_:", $msg->$_ for qw/ error code /;
227
    if ( $@ ) {
228
        return {
229
            error => 'LDAP_CANTBIND',
230
            msg => $@
231
        };
232
    };
233
    return $cnx;
234
}
235
106
sub checkpw_ldap {
236
sub checkpw_ldap {
107
    my ($dbh, $userid, $password) = @_;
237
    my ($dbh, $userid, $password) = @_;
108
    my @hosts = split(',', $prefhost);
109
    my $db = Net::LDAP->new(\@hosts);
110
    unless ( $db ) {
111
        warn "LDAP connexion failed";
112
        return 0;
113
    }
114
238
115
	#$debug and $db->debug(5);
239
    my $to_borrower = {};
240
241
    my $uattr = $$ldap{userid_from} || $$ldap{mapping}{userid}{is}
242
      or die "userid mapping not set";
243
116
    my $userldapentry;
244
    my $userldapentry;
117
245
118
    if ( $ldap->{auth_by_bind} ) {
246
    if ( $$ldap{authmethod} ) {
119
        my $principal_name;
247
        for ( $$ldap{branch} ) {
120
        if ( $ldap->{anonymous_bind} ) {
248
            $_ or die "no branch, no auth";
249
            ref $_ eq 'HASH' and $_ = [$_];
250
        }
121
251
122
            # Perform an anonymous bind
252
        # This code is an attempt to introduce a new codebase that can be hookable
123
            my $res = $db->bind;
253
        # and can mangage more cases than the old way
124
            if ( $res->code ) {
254
125
                warn "Anonymous LDAP bind failed: " . description($res);
255
        # if the filter isn't set, userid mapping is used
256
        $$ldap{filter} ||= "$uattr=%s";
257
258
        my $cnx = cnx or return 0;
259
260
        # login can be either ...
261
        my $login = do {
262
263
            # An Active Directory principal_name. Just replace the %s by the userid
264
            # well ... don't try if not AD
265
            if ( $$ldap{authmethod} ~~ [qw/ principal_name principalname principalName /] ) {
266
                sprintf( $$ldap{principal_name}, $userid )
267
            }
268
269
            # for other LDAP implementation, the standard way is to
270
            # A) Bind with the manager account and search for the DN of the user entry
271
            # B) Bind with the user DN and password.
272
            # Auth is completed if bind success.
273
            # so in this code;
274
            # - i fill $userldapentry for later use
275
            # - i return the DN
276
277
            elsif ( $$ldap{authmethod} ~~ [qw/ searchdn searchDn search_dn /] ) {
278
                $to_borrower = _anon_search($cnx, {
279
                    filter => sprintf($$ldap{filter}, $userid)
280
                }) or do {
281
                    debug_msg "no answer from ldap";
282
                    return 0;
283
                };
284
285
                if ( $$to_borrower{error} ) {
286
                    say STDERR $$to_borrower{msg};
287
                    return 0;
288
                }
289
290
                $userldapentry = $$to_borrower{entry} or do {
291
                    debug_msg "no entry returned? weird ...";
292
                };
293
294
                # login is the dn of the entry
295
                if ( $userldapentry ) { $userldapentry->dn }
296
                else {
297
                    say STDERR "can't authenticate $userid";
298
                    return 0;
299
                }
300
            } else {
301
                say STDERR "$$ldap{authmethod} authmethod is invalid,"
302
                , "please check your ldap configuration in $ENV{KOHA_CONF}";
126
                return 0;
303
                return 0;
127
            }
304
            }
305
        };
128
306
129
            # Perform a LDAP search for the given username
307
        eval { $cnx->bind( $login, password => $password ) };
130
            my $search = search_method( $db, $userid )
308
        if ( $@ ) {
131
              or return 0;    # warnings are in the sub
309
            say STDERR "ldap bind with $login failed: $@";
132
            $userldapentry = $search->shift_entry;
310
            return 0;
133
            $principal_name = $userldapentry->dn;
134
        }
311
        }
135
        else {
312
        debug_msg "congrats, you're one of us";
136
            $principal_name = $ldap->{principal_name};
313
    } else {
137
            if ( $principal_name and $principal_name =~ /\%/ ) {
314
        # This is the old stuff:
138
                $principal_name = sprintf( $principal_name, $userid );
315
        my @hosts = split(',', $prefhost);
316
        my $db = Net::LDAP->new(\@hosts);
317
        unless ( $db ) {
318
            warn "LDAP connexion failed";
319
            return 0;
320
        }
321
        #$debug and $db->debug(5);
322
323
        if ( $ldap->{auth_by_bind} ) {
324
            my $principal_name;
325
            if ( $ldap->{anonymous_bind} ) {
326
327
                # Perform an anonymous bind
328
                my $res = $db->bind;
329
                if ( $res->code ) {
330
                    warn "Anonymous LDAP bind failed: " . description($res);
331
                    return 0;
332
                }
333
334
                # Perform a LDAP search for the given username
335
                my $search = search_method( $db, $userid )
336
                  or return 0;    # warnings are in the sub
337
                $userldapentry = $search->shift_entry;
338
                $principal_name = $userldapentry->dn;
139
            }
339
            }
140
            else {
340
            else {
141
                $principal_name = $userid;
341
                $principal_name = $ldap->{principal_name};
342
                if ( $principal_name and $principal_name =~ /\%/ ) {
343
                    $principal_name = sprintf( $principal_name, $userid );
344
                }
345
                else {
346
                    $principal_name = $userid;
347
                }
142
            }
348
            }
143
        }
144
349
145
        # Perform a LDAP bind for the given username using the matched DN
350
            # Perform a LDAP bind for the given username using the matched DN
146
        my $res = $db->bind( $principal_name, password => $password );
351
            my $res = $db->bind( $principal_name, password => $password );
147
        if ( $res->code ) {
352
            if ( $res->code ) {
148
            if ( $ldap->{anonymous_bind} ) {
353
                if ( $ldap->{anonymous_bind} ) {
149
                # With anonymous_bind approach we can be sure we have found the correct user
354
                    # With anonymous_bind approach we can be sure we have found the correct user
150
                # and that any 'code' response indicates a 'bad' user (be that blocked, banned
355
                    # and that any 'code' response indicates a 'bad' user (be that blocked, banned
151
                # or password changed). We should not fall back to local accounts in this case.
356
                    # or password changed). We should not fall back to local accounts in this case.
152
                warn "LDAP bind failed as kohauser $userid: " . description($res);
357
                    warn "LDAP bind failed as kohauser $userid: " . description($res);
153
                return -1;
358
                    return -1;
154
            } else {
359
                } else {
155
                # Without a anonymous_bind, we cannot be sure we are looking at a valid ldap user
360
                    # Without a anonymous_bind, we cannot be sure we are looking at a valid ldap user
156
                # at all, and thus we should fall back to local logins to restore previous behaviour
361
                    # at all, and thus we should fall back to local logins to restore previous behaviour
157
                # see bug 12831
362
                    # see bug 12831
158
                warn "LDAP bind failed as kohauser $userid: " . description($res);
363
                    warn "LDAP bind failed as kohauser $userid: " . description($res);
364
                    return 0;
365
                }
366
            }
367
            if ( !defined($userldapentry)
368
                && ( $config{update} or $config{replicate} ) )
369
            {
370
                my $search = search_method( $db, $userid ) or return 0;
371
                $userldapentry = $search->shift_entry;
372
            }
373
        } else {
374
            say STDERR "deprecated kludge: use authmethod search_dn instead";
375
            my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
376
            if ($res->code) {		# connection refused
377
                warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') . ": " . description($res);
159
                return 0;
378
                return 0;
160
            }
379
            }
161
        }
380
            my $search = search_method($db, $userid) or return 0;    # warnings are in the sub
162
        if ( !defined($userldapentry)
163
            && ( $config{update} or $config{replicate} ) )
164
        {
165
            my $search = search_method( $db, $userid ) or return 0;
166
            $userldapentry = $search->shift_entry;
381
            $userldapentry = $search->shift_entry;
382
            my $cmpmesg = $db->compare( $userldapentry, attr => 'userpassword', value => $password );
383
            if ($cmpmesg->code != 6) {
384
                warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
385
                return -1;
386
            }
167
        }
387
        }
168
    } else {
388
    }
169
		my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
389
170
		if ($res->code) {		# connection refused
390
    if ( my $t = $$ldap{transformation} ) {
171
			warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') . ": " . description($res);
391
        $$t{subroutine} ||= 'get_borrower';
172
			return 0;
392
        my $get_borrower = load_subroutine ( @$t{qw/ module subroutine /} );
173
		}
393
        unless ( $get_borrower ) {
174
        my $search = search_method($db, $userid) or return 0;   # warnings are in the sub
394
            warn "no get_borrower $$t{subroutine} subroutine in $$t{module}";
175
        $userldapentry = $search->shift_entry;
395
            return 0;
176
		my $cmpmesg = $db->compare( $userldapentry, attr=>'userpassword', value => $password );
396
        }
177
		if ($cmpmesg->code != 6) {
397
        debug_msg "$$t{subroutine} subroutine loaded from $$t{module}";
178
			warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg);
398
        if ( my $b = $get_borrower->( $$to_borrower{entry} ) ) {
179
			return -1;
399
            $b->{column}->{password} = $password;
180
		}
400
            return accept_borrower $b,$userid;
181
	}
401
        }
402
403
        return 0;
404
    }
182
405
183
    # To get here, LDAP has accepted our user's login attempt.
406
    # To get here, LDAP has accepted our user's login attempt.
184
    # But we still have work to do.  See perldoc below for detailed breakdown.
407
    # But we still have work to do.  See perldoc below for detailed breakdown.
Lines 290-295 sub exists_local { Link Here
290
	$sth->execute($arg);
513
	$sth->execute($arg);
291
	$debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
514
	$debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
292
	($sth->rows == 1) and return $sth->fetchrow;
515
	($sth->rows == 1) and return $sth->fetchrow;
516
517
    $sth = $dbh->prepare("$select JOIN borrower_attributes USING (borrowernumber) WHERE attribute=?");
518
    $sth->execute($arg);
519
    $debug and printf STDERR "attribute '$arg' exists_local? %s\n", $sth->rows;
520
    ($sth->rows == 1) and return $sth->fetchrow;
521
293
	return 0;
522
	return 0;
294
}
523
}
295
524
Lines 335-341 sub _do_changepassword { Link Here
335
564
336
sub update_local {
565
sub update_local {
337
    my $userid     = shift or croak "No userid";
566
    my $userid     = shift or croak "No userid";
338
    my $password   = shift or croak "No password";
339
    my $borrowerid = shift or croak "No borrowerid";
567
    my $borrowerid = shift or croak "No borrowerid";
340
    my $borrower   = shift or croak "No borrower record";
568
    my $borrower   = shift or croak "No borrower record";
341
569
Lines 355-361 sub update_local { Link Here
355
    );
583
    );
356
584
357
    # MODIFY PASSWORD/LOGIN if password was mapped
585
    # MODIFY PASSWORD/LOGIN if password was mapped
358
    _do_changepassword($userid, $borrowerid, $password) if $borrower->{'password'};
586
    if ($borrower->{password} and $password) {
587
        _do_changepassword($userid, $borrowerid, $password);
588
    }
359
}
589
}
360
590
361
1;
591
1;
(-)a/C4/LDAPAuthMethodTutorial.pod (-1 / +110 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 uri 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 uri 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 are using anonymous method, you just omit LDAP credentials
53
54
    <ldapserver uri="ldap://directory.example.com"
55
          authmethod="search_dn" >
56
57
Also, you can set the values for replication and update (documented in legacy
58
pod):
59
60
    <ldapserver uri="ldap://directory.example.com"
61
          manager="uid=koha,ou=people,dc=example,dc=com"
62
          password="MYS3CRET"
63
          authmethod="search_dn"
64
          replicate="1" update="1"
65
    >
66
67
You must now tell koha the ldap branches where to find users
68
69
    <useldapserver>1</useldapserver>
70
    <ldapserver uri="ldap://directory.example.com"
71
          manager="uid=koha,ou=people,dc=example,dc=com"
72
          password="MYS3CRET"
73
          authmethod="search_dn"
74
          replicate="1" update="1"
75
    >
76
      <branch dn="ou=people,dc=site1,dc=example,dc=com" />
77
      <branch dn="ou=people,dc=site2,dc=example,dc=com" />
78
      <branch dn="ou=people,dc=site4,dc=example,dc=com" />
79
80
The best part of this new config is that you don't have to rely on simple
81
mappings anymore (but you still can): you can use a perl module to write much
82
sofisticated transformations directly in perl:
83
84
      <transformation module="C4::LDAPTransform::CustomTransform" />
85
86
This module only have to define a subroutine named get_borrower which will
87
receive C<Net::LDAP::Entry> object and returns hash which corresponds to
88
fields in C<borrowers> table similar to:
89
90
    {
91
        column => {
92
            email     => "test.user\\@example.com",
93
            firstname => "Test",
94
            surname   => "User"
95
            userid    => "testuser",
96
        }
97
    }
98
99
If you don't have <mapping> section in your C<kona-conf.xml> you will have
100
to add additional attribute to your ldapserver directive to indicate which
101
field will be used to bind to LDAP using <userid_from>:
102
103
    <ldapserver uri="ldap://directory.example.com"
104
          manager="uid=koha,ou=people,dc=example,dc=com"
105
          password="MYS3CRET"
106
          authmethod="search_dn"
107
          replicate="1" update="1"
108
          userid_from="uid"
109
    >
110

Return to bug 8993