|
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 |
return accept_borrower $b,$userid; |
| 180 |
} |
400 |
} |
| 181 |
} |
401 |
|
|
|
402 |
return 0; |
| 403 |
} |
| 182 |
|
404 |
|
| 183 |
# To get here, LDAP has accepted our user's login attempt. |
405 |
# 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. |
406 |
# 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); |
512 |
$sth->execute($arg); |
| 291 |
$debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows; |
513 |
$debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows; |
| 292 |
($sth->rows == 1) and return $sth->fetchrow; |
514 |
($sth->rows == 1) and return $sth->fetchrow; |
|
|
515 |
|
| 516 |
$sth = $dbh->prepare("$select JOIN borrower_attributes USING (borrowernumber) WHERE attribute=?"); |
| 517 |
$sth->execute($arg); |
| 518 |
$debug and printf STDERR "attribute '$arg' exists_local? %s\n", $sth->rows; |
| 519 |
($sth->rows == 1) and return $sth->fetchrow; |
| 520 |
|
| 293 |
return 0; |
521 |
return 0; |
| 294 |
} |
522 |
} |
| 295 |
|
523 |
|
|
Lines 335-341
sub _do_changepassword {
Link Here
|
| 335 |
|
563 |
|
| 336 |
sub update_local { |
564 |
sub update_local { |
| 337 |
my $userid = shift or croak "No userid"; |
565 |
my $userid = shift or croak "No userid"; |
| 338 |
my $password = shift or croak "No password"; |
|
|
| 339 |
my $borrowerid = shift or croak "No borrowerid"; |
566 |
my $borrowerid = shift or croak "No borrowerid"; |
| 340 |
my $borrower = shift or croak "No borrower record"; |
567 |
my $borrower = shift or croak "No borrower record"; |
| 341 |
|
568 |
|
|
Lines 355-361
sub update_local {
Link Here
|
| 355 |
); |
582 |
); |
| 356 |
|
583 |
|
| 357 |
# MODIFY PASSWORD/LOGIN if password was mapped |
584 |
# MODIFY PASSWORD/LOGIN if password was mapped |
| 358 |
_do_changepassword($userid, $borrowerid, $password) if $borrower->{'password'}; |
585 |
if ($borrower->{password} and $password) { |
|
|
586 |
_do_changepassword($userid, $borrowerid, $password); |
| 587 |
} |
| 359 |
} |
588 |
} |
| 360 |
|
589 |
|
| 361 |
1; |
590 |
1; |