Filename | /usr/share/koha/lib/C4/Auth_with_ldap.pm |
Statements | Executed 56 statements in 3.44ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 8.87ms | 609ms | BEGIN@26 | C4::Auth_with_ldap::
1 | 1 | 1 | 5.90ms | 117ms | BEGIN@31 | C4::Auth_with_ldap::
1 | 1 | 1 | 1.85ms | 1.97ms | BEGIN@32 | C4::Auth_with_ldap::
1 | 1 | 1 | 44µs | 51µs | BEGIN@20 | C4::Auth_with_ldap::
1 | 1 | 1 | 22µs | 22µs | BEGIN@36 | C4::Auth_with_ldap::
1 | 1 | 1 | 21µs | 56µs | BEGIN@27 | C4::Auth_with_ldap::
1 | 1 | 1 | 21µs | 60µs | BEGIN@22 | C4::Auth_with_ldap::
1 | 1 | 1 | 18µs | 23µs | BEGIN@25 | C4::Auth_with_ldap::
1 | 1 | 1 | 15µs | 115µs | BEGIN@54 | C4::Auth_with_ldap::
1 | 1 | 1 | 15µs | 53µs | BEGIN@30 | C4::Auth_with_ldap::
1 | 1 | 1 | 14µs | 20µs | BEGIN@28 | C4::Auth_with_ldap::
1 | 1 | 1 | 14µs | 206µs | BEGIN@29 | C4::Auth_with_ldap::
1 | 1 | 1 | 13µs | 123µs | BEGIN@24 | C4::Auth_with_ldap::
1 | 1 | 1 | 10µs | 95µs | BEGIN@34 | C4::Auth_with_ldap::
0 | 0 | 0 | 0s | 0s | _do_changepassword | C4::Auth_with_ldap::
0 | 0 | 0 | 0s | 0s | checkpw_ldap | C4::Auth_with_ldap::
0 | 0 | 0 | 0s | 0s | description | C4::Auth_with_ldap::
0 | 0 | 0 | 0s | 0s | exists_local | C4::Auth_with_ldap::
0 | 0 | 0 | 0s | 0s | ldap_entry_2_hash | C4::Auth_with_ldap::
0 | 0 | 0 | 0s | 0s | ldapserver_error | C4::Auth_with_ldap::
0 | 0 | 0 | 0s | 0s | search_method | C4::Auth_with_ldap::
0 | 0 | 0 | 0s | 0s | update_local | C4::Auth_with_ldap::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package C4::Auth_with_ldap; | ||||
2 | |||||
3 | # Copyright 2000-2002 Katipo Communications | ||||
4 | # | ||||
5 | # This file is part of Koha. | ||||
6 | # | ||||
7 | # Koha is free software; you can redistribute it and/or modify it under the | ||||
8 | # terms of the GNU General Public License as published by the Free Software | ||||
9 | # Foundation; either version 2 of the License, or (at your option) any later | ||||
10 | # version. | ||||
11 | # | ||||
12 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | ||||
13 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | ||||
14 | # A PARTICULAR PURPOSE. See the GNU General Public License for more details. | ||||
15 | # | ||||
16 | # You should have received a copy of the GNU General Public License along | ||||
17 | # with Koha; if not, write to the Free Software Foundation, Inc., | ||||
18 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | ||||
19 | |||||
20 | 3 | 40µs | 2 | 58µs | # spent 51µs (44+7) within C4::Auth_with_ldap::BEGIN@20 which was called:
# once (44µs+7µs) by C4::Auth::BEGIN@39 at line 20 # spent 51µs making 1 call to C4::Auth_with_ldap::BEGIN@20
# spent 7µs making 1 call to strict::import |
21 | #use warnings; FIXME - Bug 2505 | ||||
22 | 3 | 42µs | 2 | 99µs | # spent 60µs (21+39) within C4::Auth_with_ldap::BEGIN@22 which was called:
# once (21µs+39µs) by C4::Auth::BEGIN@39 at line 22 # spent 60µs making 1 call to C4::Auth_with_ldap::BEGIN@22
# spent 39µs making 1 call to Exporter::import |
23 | |||||
24 | 3 | 54µs | 2 | 233µs | # spent 123µs (13+110) within C4::Auth_with_ldap::BEGIN@24 which was called:
# once (13µs+110µs) by C4::Auth::BEGIN@39 at line 24 # spent 123µs making 1 call to C4::Auth_with_ldap::BEGIN@24
# spent 110µs making 1 call to Exporter::import |
25 | 3 | 39µs | 2 | 29µs | # spent 23µs (18+6) within C4::Auth_with_ldap::BEGIN@25 which was called:
# once (18µs+6µs) by C4::Auth::BEGIN@39 at line 25 # spent 23µs making 1 call to C4::Auth_with_ldap::BEGIN@25
# spent 6µs making 1 call to C4::Context::import |
26 | 3 | 165µs | 2 | 609ms | # spent 609ms (8.87+600) within C4::Auth_with_ldap::BEGIN@26 which was called:
# once (8.87ms+600ms) by C4::Auth::BEGIN@39 at line 26 # spent 609ms making 1 call to C4::Auth_with_ldap::BEGIN@26
# spent 274µs making 1 call to Exporter::import |
27 | 3 | 42µs | 2 | 91µs | # spent 56µs (21+35) within C4::Auth_with_ldap::BEGIN@27 which was called:
# once (21µs+35µs) by C4::Auth::BEGIN@39 at line 27 # spent 56µs making 1 call to C4::Auth_with_ldap::BEGIN@27
# spent 35µs making 1 call to Exporter::import |
28 | 3 | 34µs | 2 | 26µs | # spent 20µs (14+6) within C4::Auth_with_ldap::BEGIN@28 which was called:
# once (14µs+6µs) by C4::Auth::BEGIN@39 at line 28 # spent 20µs making 1 call to C4::Auth_with_ldap::BEGIN@28
# spent 6µs making 1 call to UNIVERSAL::import |
29 | 3 | 41µs | 2 | 397µs | # spent 206µs (14+192) within C4::Auth_with_ldap::BEGIN@29 which was called:
# once (14µs+192µs) by C4::Auth::BEGIN@39 at line 29 # spent 206µs making 1 call to C4::Auth_with_ldap::BEGIN@29
# spent 192µs making 1 call to Exporter::import |
30 | 3 | 33µs | 2 | 91µs | # spent 53µs (15+38) within C4::Auth_with_ldap::BEGIN@30 which was called:
# once (15µs+38µs) by C4::Auth::BEGIN@39 at line 30 # spent 53µs making 1 call to C4::Auth_with_ldap::BEGIN@30
# spent 38µs making 1 call to Exporter::import |
31 | 3 | 197µs | 2 | 117ms | # spent 117ms (5.90+111) within C4::Auth_with_ldap::BEGIN@31 which was called:
# once (5.90ms+111ms) by C4::Auth::BEGIN@39 at line 31 # spent 117ms making 1 call to C4::Auth_with_ldap::BEGIN@31
# spent 40µs making 1 call to Net::LDAP::import |
32 | 3 | 190µs | 2 | 1.97ms | # spent 1.97ms (1.85+117µs) within C4::Auth_with_ldap::BEGIN@32 which was called:
# once (1.85ms+117µs) by C4::Auth::BEGIN@39 at line 32 # spent 1.97ms making 1 call to C4::Auth_with_ldap::BEGIN@32
# spent 4µs making 1 call to UNIVERSAL::import |
33 | |||||
34 | 3 | 61µs | 2 | 180µs | # spent 95µs (10+85) within C4::Auth_with_ldap::BEGIN@34 which was called:
# once (10µs+85µs) by C4::Auth::BEGIN@39 at line 34 # spent 95µs making 1 call to C4::Auth_with_ldap::BEGIN@34
# spent 85µs making 1 call to vars::import |
35 | |||||
36 | # spent 22µs within C4::Auth_with_ldap::BEGIN@36 which was called:
# once (22µs+0s) by C4::Auth::BEGIN@39 at line 41 | ||||
37 | 1 | 1µs | require Exporter; | ||
38 | 1 | 2µs | $VERSION = 3.07.00.049; # set the version for version checking | ||
39 | 1 | 12µs | @ISA = qw(Exporter); | ||
40 | 1 | 8µs | @EXPORT = qw( checkpw_ldap ); | ||
41 | 1 | 93µs | 1 | 22µs | } # spent 22µs making 1 call to C4::Auth_with_ldap::BEGIN@36 |
42 | |||||
43 | # Redefine checkpw_ldap: | ||||
44 | # connect to LDAP (named or anonymous) | ||||
45 | # ~ retrieves $userid from KOHA_CONF mapping | ||||
46 | # ~ then compares $password with userPassword | ||||
47 | # ~ then gets the LDAP entry | ||||
48 | # ~ and calls the memberadd if necessary | ||||
49 | |||||
50 | sub ldapserver_error { | ||||
51 | return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift); | ||||
52 | } | ||||
53 | |||||
54 | 3 | 2.33ms | 2 | 214µs | # spent 115µs (15+99) within C4::Auth_with_ldap::BEGIN@54 which was called:
# once (15µs+99µs) by C4::Auth::BEGIN@39 at line 54 # spent 115µs making 1 call to C4::Auth_with_ldap::BEGIN@54
# spent 99µs making 1 call to vars::import |
55 | 1 | 14µs | 1 | 793µs | my $context = C4::Context->new() or die 'C4::Context->new failed'; # spent 793µs making 1 call to C4::Context::new |
56 | 1 | 4µs | 1 | 18µs | my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF}; # spent 18µs making 1 call to C4::Context::config |
57 | 1 | 1µs | my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname'); | ||
58 | 1 | 1µs | my $base = $ldap->{base} or die ldapserver_error('base'); | ||
59 | 1 | 600ns | $ldapname = $ldap->{user} ; | ||
60 | 1 | 600ns | $ldappassword = $ldap->{pass} ; | ||
61 | 1 | 10µs | our %mapping = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of || (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9 | ||
62 | 1 | 4µs | my @mapkeys = keys %mapping; | ||
63 | 1 | 300ns | $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n"; | ||
64 | 1 | 7µs | @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys; | ||
65 | 1 | 200ns | $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n"; | ||
66 | |||||
67 | 1 | 4µs | my %config = ( | ||
68 | anonymous => ($ldapname and $ldappassword) ? 0 : 1, | ||||
69 | replicate => defined($ldap->{replicate}) ? $ldap->{replicate} : 1, # add from LDAP to Koha database for new user | ||||
70 | update => defined($ldap->{update} ) ? $ldap->{update} : 1, # update from LDAP to Koha database for existing user | ||||
71 | ); | ||||
72 | |||||
73 | sub description { | ||||
74 | my $result = shift or return; | ||||
75 | return "LDAP error #" . $result->code | ||||
76 | . ": " . $result->error_name . "\n" | ||||
77 | . "# " . $result->error_text . "\n"; | ||||
78 | } | ||||
79 | |||||
80 | sub search_method { | ||||
81 | my $db = shift or return; | ||||
82 | my $userid = shift or return; | ||||
83 | my $uid_field = $mapping{userid}->{is} or die ldapserver_error("mapping for 'userid'"); | ||||
84 | my $filter = Net::LDAP::Filter->new("$uid_field=$userid") or die "Failed to create new Net::LDAP::Filter"; | ||||
85 | my $search = $db->search( | ||||
86 | base => $base, | ||||
87 | filter => $filter, | ||||
88 | # attrs => ['*'], | ||||
89 | ) or die "LDAP search failed to return object."; | ||||
90 | my $count = $search->count; | ||||
91 | if ($search->code > 0) { | ||||
92 | warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count) . description($search); | ||||
93 | return 0; | ||||
94 | } | ||||
95 | if ($count != 1) { | ||||
96 | warn sprintf("LDAP Auth rejected : %s gets %d hits\n", $filter->as_string, $count); | ||||
97 | return 0; | ||||
98 | } | ||||
99 | return $search; | ||||
100 | } | ||||
101 | |||||
102 | sub checkpw_ldap { | ||||
103 | my ($dbh, $userid, $password) = @_; | ||||
104 | my @hosts = split(',', $prefhost); | ||||
105 | my $db = Net::LDAP->new(\@hosts); | ||||
106 | unless ( $db ) { | ||||
107 | warn "LDAP connexion failed"; | ||||
108 | return 0; | ||||
109 | } | ||||
110 | |||||
111 | #$debug and $db->debug(5); | ||||
112 | my $userldapentry; | ||||
113 | |||||
114 | if ( $ldap->{auth_by_bind} ) { | ||||
115 | my $principal_name; | ||||
116 | if ( $ldap->{anonymous_bind} ) { | ||||
117 | |||||
118 | # Perform an anonymous bind | ||||
119 | my $res = $db->bind; | ||||
120 | if ( $res->code ) { | ||||
121 | warn "Anonymous LDAP bind failed: " . description($res); | ||||
122 | return 0; | ||||
123 | } | ||||
124 | |||||
125 | # Perform a LDAP search for the given username | ||||
126 | my $search = search_method( $db, $userid ) | ||||
127 | or return 0; # warnings are in the sub | ||||
128 | $userldapentry = $search->shift_entry; | ||||
129 | $principal_name = $userldapentry->dn; | ||||
130 | } | ||||
131 | else { | ||||
132 | $principal_name = $ldap->{principal_name}; | ||||
133 | if ( $principal_name and $principal_name =~ /\%/ ) { | ||||
134 | $principal_name = sprintf( $principal_name, $userid ); | ||||
135 | } | ||||
136 | else { | ||||
137 | $principal_name = $userid; | ||||
138 | } | ||||
139 | } | ||||
140 | |||||
141 | # Perform a LDAP bind for the given username using the matched DN | ||||
142 | my $res = $db->bind( $principal_name, password => $password ); | ||||
143 | if ( $res->code ) { | ||||
144 | warn "LDAP bind failed as kohauser $userid: " . description($res); | ||||
145 | return 0; | ||||
146 | } | ||||
147 | if ( !defined($userldapentry) | ||||
148 | && ( $config{update} or $config{replicate} ) ) | ||||
149 | { | ||||
150 | my $search = search_method( $db, $userid ) or return 0; | ||||
151 | $userldapentry = $search->shift_entry; | ||||
152 | } | ||||
153 | } else { | ||||
154 | my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword); | ||||
155 | if ($res->code) { # connection refused | ||||
156 | warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]') . ": " . description($res); | ||||
157 | return 0; | ||||
158 | } | ||||
159 | my $search = search_method($db, $userid) or return 0; # warnings are in the sub | ||||
160 | $userldapentry = $search->shift_entry; | ||||
161 | my $cmpmesg = $db->compare( $userldapentry, attr=>'userpassword', value => $password ); | ||||
162 | if ($cmpmesg->code != 6) { | ||||
163 | warn "LDAP Auth rejected : invalid password for user '$userid'. " . description($cmpmesg); | ||||
164 | return 0; | ||||
165 | } | ||||
166 | } | ||||
167 | |||||
168 | # To get here, LDAP has accepted our user's login attempt. | ||||
169 | # But we still have work to do. See perldoc below for detailed breakdown. | ||||
170 | |||||
171 | my (%borrower); | ||||
172 | my ($borrowernumber,$cardnumber,$local_userid,$savedpw) = exists_local($userid); | ||||
173 | |||||
174 | if (( $borrowernumber and $config{update} ) or | ||||
175 | (!$borrowernumber and $config{replicate}) ) { | ||||
176 | %borrower = ldap_entry_2_hash($userldapentry,$userid); | ||||
177 | $debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n"; | ||||
178 | } | ||||
179 | |||||
180 | if ($borrowernumber) { | ||||
181 | if ($config{update}) { # A1, B1 | ||||
182 | my $c2 = &update_local($local_userid,$password,$borrowernumber,\%borrower) || ''; | ||||
183 | ($cardnumber eq $c2) or warn "update_local returned cardnumber '$c2' instead of '$cardnumber'"; | ||||
184 | } else { # C1, D1 | ||||
185 | # maybe update just the password? | ||||
186 | return(1, $cardnumber, $local_userid); | ||||
187 | } | ||||
188 | } elsif ($config{replicate}) { # A2, C2 | ||||
189 | $borrowernumber = AddMember(%borrower) or die "AddMember failed"; | ||||
190 | } else { | ||||
191 | return 0; # B2, D2 | ||||
192 | } | ||||
193 | if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} ||$config{replicate})) { | ||||
194 | my $extended_patron_attributes; | ||||
195 | foreach my $attribute_type ( C4::Members::AttributeTypes::GetAttributeTypes() ) { | ||||
196 | my $code = $attribute_type->{code}; | ||||
197 | if ( exists($borrower{$code}) && $borrower{$code} !~ m/^\s*$/ ) { # skip empty values | ||||
198 | push @$extended_patron_attributes, { code => $code, value => $borrower{$code} }; | ||||
199 | } | ||||
200 | } | ||||
201 | my @errors; | ||||
202 | #Check before add | ||||
203 | for (my $i; $i< scalar(@$extended_patron_attributes)-1;$i++) { | ||||
204 | my $attr=$extended_patron_attributes->[$i]; | ||||
205 | unless (C4::Members::Attributes::CheckUniqueness($attr->{code}, $attr->{value}, $borrowernumber)) { | ||||
206 | unshift @errors, $i; | ||||
207 | warn "ERROR_extended_unique_id_failed $attr->{code} $attr->{value}"; | ||||
208 | } | ||||
209 | } | ||||
210 | #Removing erroneous attributes | ||||
211 | foreach my $index (@errors){ | ||||
212 | @$extended_patron_attributes=splice(@$extended_patron_attributes,$index,1); | ||||
213 | } | ||||
214 | C4::Members::Attributes::SetBorrowerAttributes($borrowernumber, $extended_patron_attributes); | ||||
215 | } | ||||
216 | return(1, $cardnumber, $userid); | ||||
217 | } | ||||
218 | |||||
219 | # Pass LDAP entry object and local cardnumber (userid). | ||||
220 | # Returns borrower hash. | ||||
221 | # Edit KOHA_CONF so $memberhash{'xxx'} fits your ldap structure. | ||||
222 | # Ensure that mandatory fields are correctly filled! | ||||
223 | # | ||||
224 | sub ldap_entry_2_hash { | ||||
225 | my $userldapentry = shift; | ||||
226 | my %borrower = ( cardnumber => shift ); | ||||
227 | my %memberhash; | ||||
228 | $userldapentry->exists('uid'); # This is bad, but required! By side-effect, this initializes the attrs hash. | ||||
229 | if ($debug) { | ||||
230 | print STDERR "\nkeys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n", $userldapentry->dump(); | ||||
231 | foreach (keys %$userldapentry) { | ||||
232 | print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n"; | ||||
233 | hashdump("LDAP key: ",$userldapentry->{$_}); | ||||
234 | } | ||||
235 | } | ||||
236 | my $x = $userldapentry->{attrs} or return; | ||||
237 | foreach (keys %$x) { | ||||
238 | $memberhash{$_} = join ' ', @{$x->{$_}}; | ||||
239 | $debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n"; | ||||
240 | } | ||||
241 | $debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n", | ||||
242 | "Referencing \%mapping with ", scalar(keys %mapping), " keys\n"; | ||||
243 | foreach my $key (keys %mapping) { | ||||
244 | my $data = $memberhash{ lc($mapping{$key}->{is}) }; # Net::LDAP returns all names in lowercase | ||||
245 | $debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data; | ||||
246 | unless (defined $data) { | ||||
247 | $data = $mapping{$key}->{content} || ''; # default or failsafe '' | ||||
248 | } | ||||
249 | $borrower{$key} = ($data ne '') ? $data : ' ' ; | ||||
250 | } | ||||
251 | $borrower{initials} = $memberhash{initials} || | ||||
252 | ( substr($borrower{'firstname'},0,1) | ||||
253 | . substr($borrower{ 'surname' },0,1) | ||||
254 | . " "); | ||||
255 | |||||
256 | # check if categorycode exists, if not, fallback to default from koha-conf.xml | ||||
257 | my $dbh = C4::Context->dbh; | ||||
258 | my $sth = $dbh->prepare("SELECT categorycode FROM categories WHERE categorycode = ?"); | ||||
259 | $sth->execute( uc($borrower{'categorycode'}) ); | ||||
260 | unless ( my $row = $sth->fetchrow_hashref ) { | ||||
261 | my $default = $mapping{'categorycode'}->{content}; | ||||
262 | $debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid}; | ||||
263 | $borrower{'categorycode'} = $default | ||||
264 | } | ||||
265 | |||||
266 | return %borrower; | ||||
267 | } | ||||
268 | |||||
269 | sub exists_local { | ||||
270 | my $arg = shift; | ||||
271 | my $dbh = C4::Context->dbh; | ||||
272 | my $select = "SELECT borrowernumber,cardnumber,userid,password FROM borrowers "; | ||||
273 | |||||
274 | my $sth = $dbh->prepare("$select WHERE userid=?"); # was cardnumber=? | ||||
275 | $sth->execute($arg); | ||||
276 | $debug and printf STDERR "Userid '$arg' exists_local? %s\n", $sth->rows; | ||||
277 | ($sth->rows == 1) and return $sth->fetchrow; | ||||
278 | |||||
279 | $sth = $dbh->prepare("$select WHERE cardnumber=?"); | ||||
280 | $sth->execute($arg); | ||||
281 | $debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows; | ||||
282 | ($sth->rows == 1) and return $sth->fetchrow; | ||||
283 | return 0; | ||||
284 | } | ||||
285 | |||||
286 | # This function performs a password update, given the userid, borrowerid, | ||||
287 | # and digested password. It will verify that things are correct and return the | ||||
288 | # borrowers cardnumber. The idea is that it is used to keep the local | ||||
289 | # passwords in sync with the LDAP passwords. | ||||
290 | # | ||||
291 | # $cardnum = _do_changepassword($userid, $borrowerid, $digest) | ||||
292 | # | ||||
293 | # Note: if the LDAP config has the update_password tag set to a false value, | ||||
294 | # then this will not update the password, it will simply return the cardnumber. | ||||
295 | sub _do_changepassword { | ||||
296 | my ( $userid, $borrowerid, $digest ) = @_; | ||||
297 | |||||
298 | if ( exists( $ldap->{update_password} ) && !$ldap->{update_password} ) { | ||||
299 | |||||
300 | # This path doesn't update the password, just returns the | ||||
301 | # card number | ||||
302 | my $sth = C4::Context->dbh->prepare( | ||||
303 | 'SELECT cardnumber FROM borrowers WHERE borrowernumber=?' ); | ||||
304 | $sth->execute($borrowerid); | ||||
305 | die | ||||
306 | "Unable to access borrowernumber with userid=$userid, borrowernumber=$borrowerid" | ||||
307 | if !$sth->rows; | ||||
308 | my ($cardnum) = $sth->fetchrow; | ||||
309 | return $cardnum; | ||||
310 | } | ||||
311 | else { | ||||
312 | |||||
313 | # This path updates the password in the database | ||||
314 | print STDERR | ||||
315 | "changing local password for borrowernumber=$borrowerid to '$digest'\n" | ||||
316 | if $debug; | ||||
317 | changepassword( $userid, $borrowerid, $digest ); | ||||
318 | |||||
319 | # Confirm changes | ||||
320 | my $sth = C4::Context->dbh->prepare( | ||||
321 | "SELECT password,cardnumber FROM borrowers WHERE borrowernumber=? " | ||||
322 | ); | ||||
323 | $sth->execute($borrowerid); | ||||
324 | if ( $sth->rows ) { | ||||
325 | my ( $md5password, $cardnum ) = $sth->fetchrow; | ||||
326 | ( $digest eq $md5password ) and return $cardnum; | ||||
327 | warn | ||||
328 | "Password mismatch after update to cardnumber=$cardnum (borrowernumber=$borrowerid)"; | ||||
329 | return; | ||||
330 | } | ||||
331 | die | ||||
332 | "Unexpected error after password update to userid/borrowernumber: $userid / $borrowerid."; | ||||
333 | } | ||||
334 | } | ||||
335 | |||||
336 | sub update_local { | ||||
337 | my $userid = shift or return; | ||||
338 | my $digest = md5_base64(shift) or return; | ||||
339 | my $borrowerid = shift or return; | ||||
340 | my $borrower = shift or return; | ||||
341 | my @keys = keys %$borrower; | ||||
342 | my $dbh = C4::Context->dbh; | ||||
343 | my $query = "UPDATE borrowers\nSET " . | ||||
344 | join(',', map {"$_=?"} @keys) . | ||||
345 | "\nWHERE borrowernumber=? "; | ||||
346 | my $sth = $dbh->prepare($query); | ||||
347 | if ($debug) { | ||||
348 | print STDERR $query, "\n", | ||||
349 | join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys; | ||||
350 | print STDERR "\nuserid = $userid\n"; | ||||
351 | } | ||||
352 | $sth->execute( | ||||
353 | ((map {$borrower->{$_}} @keys), $borrowerid) | ||||
354 | ); | ||||
355 | |||||
356 | # MODIFY PASSWORD/LOGIN | ||||
357 | _do_changepassword($userid, $borrowerid, $digest); | ||||
358 | } | ||||
359 | |||||
360 | 1 | 8µs | 1; | ||
361 | __END__ |