Able to call haspermission w/o $dbh, and add error msg on deletemember.
[wip/koha-chris_n.git] / C4 / Auth.pm
1
2 # -*- tab-width: 8 -*-
3 # NOTE: This file uses 8-character tabs; do not change the tab size!
4
5 package C4::Auth;
6
7 # Copyright 2000-2002 Katipo Communications
8 #
9 # This file is part of Koha.
10 #
11 # Koha is free software; you can redistribute it and/or modify it under the
12 # terms of the GNU General Public License as published by the Free Software
13 # Foundation; either version 2 of the License, or (at your option) any later
14 # version.
15 #
16 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
17 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
18 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
19 #
20 # You should have received a copy of the GNU General Public License along with
21 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
22 # Suite 330, Boston, MA  02111-1307 USA
23
24 use strict;
25 use Digest::MD5 qw(md5_base64);
26 use CGI::Session;
27
28 require Exporter;
29 use C4::Context;
30 use C4::Output;    # to get the template
31 use C4::Members;
32 use C4::Koha;
33 use C4::Branch; # GetBranches
34
35 # use utf8;
36 # use Net::LDAP;
37 # use Net::LDAP qw(:all);
38
39 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
40
41 # set the version for version checking
42 $VERSION = 3.00;
43
44 =head1 NAME
45
46 C4::Auth - Authenticates Koha users
47
48 =head1 SYNOPSIS
49
50   use CGI;
51   use C4::Auth;
52
53   my $query = new CGI;
54
55   my ($template, $borrowernumber, $cookie) 
56     = get_template_and_user(
57         {
58             template_name   => "opac-main.tmpl",
59             query           => $query,
60       type            => "opac",
61       authnotrequired => 1,
62       flagsrequired   => {borrow => 1},
63   }
64     );
65
66   print $query->header(
67     -type => 'utf-8',
68     -cookie => $cookie
69   ), $template->output;
70
71
72 =head1 DESCRIPTION
73
74     The main function of this module is to provide
75     authentification. However the get_template_and_user function has
76     been provided so that a users login information is passed along
77     automatically. This gets loaded into the template.
78
79 =head1 FUNCTIONS
80
81 =over 2
82
83 =cut
84
85 @ISA    = qw(Exporter);
86 @EXPORT = qw(
87   &checkauth
88   &get_template_and_user
89 );
90 @EXPORT_OK = qw(
91   &check_api_auth
92   &get_session
93   &check_cookie_auth
94 );
95
96 =item get_template_and_user
97
98         my ($template, $borrowernumber, $cookie)
99                 = get_template_and_user(
100                   {
101                         template_name   => "opac-main.tmpl",
102                         query           => $query,
103                         type            => "opac",
104                         authnotrequired => 1,
105                         flagsrequired   => {borrow => 1},
106                   }
107                 );
108
109     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
110     to C<&checkauth> (in this module) to perform authentification.
111     See C<&checkauth> for an explanation of these parameters.
112
113     The C<template_name> is then used to find the correct template for
114     the page. The authenticated users details are loaded onto the
115     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
116     C<sessionID> is passed to the template. This can be used in templates
117     if cookies are disabled. It needs to be put as and input to every
118     authenticated page.
119
120     More information on the C<gettemplate> sub can be found in the
121     Output.pm module.
122
123 =cut
124
125 sub get_template_and_user {
126     my $in       = shift;
127     my $template =
128       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
129     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
130         $in->{'query'},
131         $in->{'authnotrequired'},
132         $in->{'flagsrequired'},
133         $in->{'type'}
134     ) unless ($in->{'template_name'}=~/maintenance/);
135
136     my $borrowernumber;
137     my $insecure = C4::Context->preference('insecure');
138     if ($user or $insecure) {
139
140                 # load the template variables for stylesheets and JavaScript
141                 $template->param( css_libs => $in->{'css_libs'} );
142                 $template->param( css_module => $in->{'css_module'} );
143                 $template->param( css_page => $in->{'css_page'} );
144                 $template->param( css_widgets => $in->{'css_widgets'} );
145
146         $template->param( js_libs => $in->{'js_libs'} );
147         $template->param( js_module => $in->{'js_module'} );
148         $template->param( js_page => $in->{'js_page'} );
149         $template->param( js_widgets => $in->{'js_widgets'} );
150
151                 # user info
152         $template->param( loggedinusername => $user );
153         $template->param( sessionID        => $sessionID );
154
155         $borrowernumber = getborrowernumber($user);
156         my ( $borr, $alternativeflags ) =
157           GetMemberDetails( $borrowernumber );
158         my @bordat;
159         $bordat[0] = $borr;
160         $template->param( "USER_INFO" => \@bordat );
161
162                 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
163                                                         editcatalogue updatecharge management tools editauthorities serials reports);
164         # We are going to use the $flags returned by checkauth
165         # to create the template's parameters that will indicate
166         # which menus the user can access.
167         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
168             $template->param( CAN_user_circulate        => 1 );
169             $template->param( CAN_user_catalogue        => 1 );
170             $template->param( CAN_user_parameters       => 1 );
171             $template->param( CAN_user_borrowers        => 1 );
172             $template->param( CAN_user_permission       => 1 );
173             $template->param( CAN_user_reserveforothers => 1 );
174             $template->param( CAN_user_borrow           => 1 );
175             $template->param( CAN_user_editcatalogue    => 1 );
176             $template->param( CAN_user_updatecharge     => 1 );
177             $template->param( CAN_user_acquisition      => 1 );
178             $template->param( CAN_user_management       => 1 );
179             $template->param( CAN_user_tools            => 1 ); 
180             $template->param( CAN_user_editauthorities  => 1 );
181             $template->param( CAN_user_serials          => 1 );
182             $template->param( CAN_user_reports          => 1 );
183             $template->param( CAN_user_staffaccess              => 1 );
184         }
185
186         if ( $flags && $flags->{circulate} == 1 ) {
187             $template->param( CAN_user_circulate => 1 );
188         }
189
190         if ( $flags && $flags->{catalogue} == 1 ) {
191             $template->param( CAN_user_catalogue => 1 );
192         }
193
194         if ( $flags && $flags->{parameters} == 1 ) {
195             $template->param( CAN_user_parameters => 1 );
196             $template->param( CAN_user_management => 1 );
197         }
198
199         if ( $flags && $flags->{borrowers} == 1 ) {
200             $template->param( CAN_user_borrowers => 1 );
201         }
202
203         if ( $flags && $flags->{permissions} == 1 ) {
204             $template->param( CAN_user_permission => 1 );
205         }
206
207         if ( $flags && $flags->{reserveforothers} == 1 ) {
208             $template->param( CAN_user_reserveforothers => 1 );
209         }
210
211         if ( $flags && $flags->{borrow} == 1 ) {
212             $template->param( CAN_user_borrow => 1 );
213         }
214
215         if ( $flags && $flags->{editcatalogue} == 1 ) {
216             $template->param( CAN_user_editcatalogue => 1 );
217         }
218
219         if ( $flags && $flags->{updatecharges} == 1 ) {
220             $template->param( CAN_user_updatecharge => 1 );
221         }
222
223         if ( $flags && $flags->{acquisition} == 1 ) {
224             $template->param( CAN_user_acquisition => 1 );
225         }
226
227         if ( $flags && $flags->{tools} == 1 ) {
228             $template->param( CAN_user_tools => 1 );
229         }
230   
231         if ( $flags && $flags->{editauthorities} == 1 ) {
232             $template->param( CAN_user_editauthorities => 1 );
233         }
234     
235         if ( $flags && $flags->{serials} == 1 ) {
236             $template->param( CAN_user_serials => 1 );
237         }
238
239         if ( $flags && $flags->{reports} == 1 ) {
240             $template->param( CAN_user_reports => 1 );
241         }
242         if ( $flags && $flags->{staffaccess} == 1 ) {
243             $template->param( CAN_user_staffaccess => 1 );
244         }
245     }
246     if ( $in->{'type'} eq "intranet" ) {
247         $template->param(
248             intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
249             intranetstylesheet => C4::Context->preference("intranetstylesheet"),
250             IntranetNav        => C4::Context->preference("IntranetNav"),
251             intranetuserjs     => C4::Context->preference("intranetuserjs"),
252             TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
253             AmazonContent      => C4::Context->preference("AmazonContent"),
254             LibraryName        => C4::Context->preference("LibraryName"),
255             LoginBranchcode    => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
256             LoginBranchname    => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
257             LoginFirstname     => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
258             LoginSurname       => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu", 
259             AutoLocation       => C4::Context->preference("AutoLocation"),
260             hide_marc          => C4::Context->preference("hide_marc"),
261             patronimages       => C4::Context->preference("patronimages"),
262             "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
263             advancedMARCEditor      => C4::Context->preference("advancedMARCEditor"),
264             suggestion              => C4::Context->preference("suggestion"),
265             virtualshelves          => C4::Context->preference("virtualshelves"),
266             LibraryName             => C4::Context->preference("LibraryName"),
267             KohaAdminEmailAddress   => "" . C4::Context->preference("KohaAdminEmailAddress"),
268             IntranetmainUserblock       => C4::Context->preference("IntranetmainUserblock"),
269             IndependantBranches     => C4::Context->preference("IndependantBranches"),
270                         CircAutocompl => C4::Context->preference("CircAutocompl"),
271                         yuipath => C4::Context->preference("yuipath"),
272                         FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
273                         AmazonSimilarItems => C4::Context->preference("AmazonSimilarItems"),
274         );
275     }
276     else {
277         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
278         my $LibraryNameTitle = C4::Context->preference("LibraryName");
279         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
280         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
281   $template->param(
282             KohaAdminEmailAddress  => "" . C4::Context->preference("KohaAdminEmailAddress"),
283                         AnonSuggestions =>  "" . C4::Context->preference("AnonSuggestions"),
284             suggestion             => "" . C4::Context->preference("suggestion"),
285             virtualshelves         => "" . C4::Context->preference("virtualshelves"),
286             OpacNav                => "" . C4::Context->preference("OpacNav"),
287             opacheader             => "" . C4::Context->preference("opacheader"),
288             opaccredits            => "" . C4::Context->preference("opaccredits"),
289             opacsmallimage         => "" . C4::Context->preference("opacsmallimage"),
290             opaclargeimage         => "" . C4::Context->preference("opaclargeimage"),
291             opaclayoutstylesheet   => "". C4::Context->preference("opaclayoutstylesheet"),
292             opaccolorstylesheet    => "". C4::Context->preference("opaccolorstylesheet"),
293             opaclanguagesdisplay   => "". C4::Context->preference("opaclanguagesdisplay"),
294             opacuserlogin          => "" . C4::Context->preference("opacuserlogin"),
295             opacbookbag            => "" . C4::Context->preference("opacbookbag"),
296             TemplateEncoding       => "". C4::Context->preference("TemplateEncoding"),
297             AmazonContent          => "" . C4::Context->preference("AmazonContent"),
298             LibraryName            => "" . C4::Context->preference("LibraryName"),
299             LibraryNameTitle       => "" . $LibraryNameTitle,
300             LoginBranchcode        => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
301             LoginBranchname        => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"", 
302             LoginFirstname        => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
303             LoginSurname        => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu", 
304             OpacPasswordChange     => C4::Context->preference("OpacPasswordChange"),
305             opacreadinghistory     => C4::Context->preference("opacreadinghistory"),
306             opacuserjs             => C4::Context->preference("opacuserjs"),
307             OpacCloud              => C4::Context->preference("OpacCloud"),
308             OpacTopissue           => C4::Context->preference("OpacTopissue"),
309             OpacAuthorities        => C4::Context->preference("OpacAuthorities"),
310             OpacBrowser            => C4::Context->preference("OpacBrowser"),
311             RequestOnOpac          => C4::Context->preference("RequestOnOpac"),
312             reviewson              => C4::Context->preference("reviewson"),
313             hide_marc              => C4::Context->preference("hide_marc"),
314             patronimages           => C4::Context->preference("patronimages"),
315             mylibraryfirst   => C4::Context->preference("SearchMyLibraryFirst"),
316             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
317                         OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
318         );
319     }
320     return ( $template, $borrowernumber, $cookie );
321 }
322
323 =item checkauth
324
325   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
326
327 Verifies that the user is authorized to run this script.  If
328 the user is authorized, a (userid, cookie, session-id, flags)
329 quadruple is returned.  If the user is not authorized but does
330 not have the required privilege (see $flagsrequired below), it
331 displays an error page and exits.  Otherwise, it displays the
332 login page and exits.
333
334 Note that C<&checkauth> will return if and only if the user
335 is authorized, so it should be called early on, before any
336 unfinished operations (e.g., if you've opened a file, then
337 C<&checkauth> won't close it for you).
338
339 C<$query> is the CGI object for the script calling C<&checkauth>.
340
341 The C<$noauth> argument is optional. If it is set, then no
342 authorization is required for the script.
343
344 C<&checkauth> fetches user and session information from C<$query> and
345 ensures that the user is authorized to run scripts that require
346 authorization.
347
348 The C<$flagsrequired> argument specifies the required privileges
349 the user must have if the username and password are correct.
350 It should be specified as a reference-to-hash; keys in the hash
351 should be the "flags" for the user, as specified in the Members
352 intranet module. Any key specified must correspond to a "flag"
353 in the userflags table. E.g., { circulate => 1 } would specify
354 that the user must have the "circulate" privilege in order to
355 proceed. To make sure that access control is correct, the
356 C<$flagsrequired> parameter must be specified correctly.
357
358 The C<$type> argument specifies whether the template should be
359 retrieved from the opac or intranet directory tree.  "opac" is
360 assumed if it is not specified; however, if C<$type> is specified,
361 "intranet" is assumed if it is not "opac".
362
363 If C<$query> does not have a valid session ID associated with it
364 (i.e., the user has not logged in) or if the session has expired,
365 C<&checkauth> presents the user with a login page (from the point of
366 view of the original script, C<&checkauth> does not return). Once the
367 user has authenticated, C<&checkauth> restarts the original script
368 (this time, C<&checkauth> returns).
369
370 The login page is provided using a HTML::Template, which is set in the
371 systempreferences table or at the top of this file. The variable C<$type>
372 selects which template to use, either the opac or the intranet 
373 authentification template.
374
375 C<&checkauth> returns a user ID, a cookie, and a session ID. The
376 cookie should be sent back to the browser; it verifies that the user
377 has authenticated.
378
379 =cut
380
381 sub _version_check ($$) {
382     my $type = shift;
383     my $query = shift;
384         my $version;
385     # If Version syspref is unavailable, it means Koha is beeing installed,
386     # and so we must redirect to OPAC maintenance page or to the WebInstaller
387     #warn "about to check version";
388     unless ($version = C4::Context->preference('Version')) {    # assignment, not comparison
389       if ($type ne 'opac') {
390         warn "Install required, redirecting to Installer";
391         print $query->redirect("/cgi-bin/koha/installer/install.pl");
392       } 
393       else {
394         warn "OPAC Install required, redirecting to maintenance";
395         print $query->redirect("/cgi-bin/koha/maintenance.pl");
396       }
397       exit;
398     }
399
400         # check that database and koha version are the same
401         # there is no DB version, it's a fresh install,
402         # go to web installer
403         # there is a DB version, compare it to the code version
404         my $kohaversion=C4::Context::KOHAVERSION;
405         # remove the 3 last . to have a Perl number
406         $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
407         # warn "kohaversion : $kohaversion";
408         if ($version < $kohaversion){
409                 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is "
410                         . C4::Context->config("kohaversion");
411                 if ($type ne 'opac'){
412                         warn sprintf($warning, 'Installer');
413                         print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
414                 } else {
415                         warn sprintf("OPAC: " . $warning, 'maintenance');
416                         print $query->redirect("/cgi-bin/koha/maintenance.pl");
417                 }       
418                 exit;
419         }
420 }
421
422 sub _session_log {
423         (@_) or return 0;
424         open L, ">>/tmp/sessionlog";
425         printf L join("\n",@_);
426         close L;
427 }
428
429 sub checkauth {
430     my $query = shift;
431   # warn "Checking Auth";
432     # $authnotrequired will be set for scripts which will run without authentication
433     my $authnotrequired = shift;
434     my $flagsrequired   = shift;
435     my $type            = shift;
436     $type = 'opac' unless $type;
437
438     my $dbh     = C4::Context->dbh;
439     my $timeout = C4::Context->preference('timeout');
440         # days
441         if ($timeout =~ /(\d*)[dD]/) {
442                 $timeout = $1 * 86400;
443     };
444         $timeout = 600 unless $timeout;
445
446         _version_check($type,$query);
447     # state variables
448     my $loggedin = 0;
449     my %info;
450     my ( $userid, $cookie, $sessionID, $flags );
451     my $logout = $query->param('logout.x');
452     if ( $userid = $ENV{'REMOTE_USER'} ) {
453         # Using Basic Authentication, no cookies required
454         $cookie = $query->cookie(
455             -name    => 'CGISESSID',
456             -value   => '',
457             -expires => ''
458         );
459         $loggedin = 1;
460     }
461     elsif ( $sessionID = $query->cookie("CGISESSID")) {         # assignment, not comparison (?)
462         my $session = get_session($sessionID);
463         C4::Context->_new_userenv($sessionID);
464         if ($session){
465             C4::Context::set_userenv(
466                 $session->param('number'),       $session->param('id'),
467                 $session->param('cardnumber'),   $session->param('firstname'),
468                 $session->param('surname'),      $session->param('branch'),
469                 $session->param('branchname'),   $session->param('flags'),
470                 $session->param('emailaddress'), $session->param('branchprinter')
471             );
472 #             warn       "".$session->param('cardnumber').",   ".$session->param('firstname').",
473 #                 ".$session->param('surname').",      ".$session->param('branch');
474         }
475         my $ip;
476         my $lasttime;
477         if ($session) {
478                         $ip = $session->param('ip');
479                         $lasttime = $session->param('lasttime');
480                         $userid = $session->param('id');
481         }
482     
483         if ($logout) {
484             # voluntary logout the user
485             $session->flush;      
486                         $session->delete();
487             C4::Context->_unset_userenv($sessionID);
488             $sessionID = undef;
489             $userid    = undef;
490             _session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,localtime);
491         }
492         if ($userid) {
493             if ( $lasttime < time() - $timeout ) {
494                 # timed logout
495                 $info{'timed_out'} = 1;
496                 $session->delete();
497                 C4::Context->_unset_userenv($sessionID);
498                 $userid    = undef;
499                 $sessionID = undef;
500                 _session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,localtime);
501             }
502             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
503                 # Different ip than originally logged in from
504                 $info{'oldip'}        = $ip;
505                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
506                 $info{'different_ip'} = 1;
507                                 $session->delete();
508                 C4::Context->_unset_userenv($sessionID);
509                 $sessionID = undef;
510                 $userid    = undef;
511                 _session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,localtime, $info{'newip'});
512             }
513             else {
514                 $cookie = $query->cookie( CGISESSID => $session->id );
515                 $session->param('lasttime',time());
516                 $flags = haspermission( $dbh, $userid, $flagsrequired );
517                 if ($flags) {
518                     $loggedin = 1;
519                 }
520                 else {
521                     $info{'nopermission'} = 1;
522                 }
523             }
524         }
525     }
526     unless ($userid) {
527                 my $session = get_session("");
528         my $sessionID;
529                 if ($session) {
530                         $sessionID = $session->id;
531                 }
532         $userid    = $query->param('userid');
533         C4::Context->_new_userenv($sessionID);
534         my $password = $query->param('password');
535         C4::Context->_new_userenv($sessionID);
536         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
537         if ($return) {
538             _session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},localtime);
539             $cookie = $query->cookie(CGISESSID => $sessionID);
540             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
541                 $loggedin = 1;
542             }
543             else {
544                 $info{'nopermission'} = 1;
545                 C4::Context->_unset_userenv($sessionID);
546             }
547             if ( $return == 1 ) {
548                 my (
549                    $borrowernumber, $firstname, $surname, $userflags,
550                    $branchcode, $branchname, $branchprinter, $emailaddress
551                 );
552                                 my $select = "
553                                 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode, 
554                                                 branches.branchname    as branchname, 
555                                                 branches.branchprinter as branchprinter, 
556                                                 email 
557                                 FROM borrowers 
558                                 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
559                                 ";
560                 my $sth = $dbh->prepare("$select where userid=?");
561                 $sth->execute($userid);
562                                 ($sth->rows) and (
563                                         $borrowernumber, $firstname, $surname, $userflags,
564                                         $branchcode, $branchname, $branchprinter, $emailaddress
565                                 ) = $sth->fetchrow;
566
567 #         warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
568                 unless ( $sth->rows ) {
569                     my $sth = $dbh->prepare("$select where cardnumber=?");
570                                         $sth->execute($cardnumber);
571                                         ($sth->rows) and (
572                                                 $borrowernumber, $firstname, $surname, $userflags,
573                                                 $branchcode, $branchname, $branchprinter, $emailaddress
574                                         ) = $sth->fetchrow;
575
576 #           warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
577                     unless ( $sth->rows ) {
578                         $sth->execute($userid);
579                                                 ($sth->rows) and (
580                                                         $borrowernumber, $firstname, $surname, $userflags,
581                                                         $branchcode, $branchname, $branchprinter, $emailaddress
582                                                 ) = $sth->fetchrow;
583                     }
584                 }
585
586 # launch a sequence to check if we have a ip for the branch, i
587 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
588
589                 my $ip       = $ENV{'REMOTE_ADDR'};
590                 # if they specify at login, use that
591                 if ($query->param('branch')) {
592                     $branchcode  = $query->param('branch');
593                     $branchname = GetBranchName($branchcode);
594                 }
595                 my $branches = GetBranches();
596                 my @branchesloop;
597                 foreach my $br ( keys %$branches ) {
598                     #     now we work with the treatment of ip
599                     my $domain = $branches->{$br}->{'branchip'};
600                     if ( $domain && $ip =~ /^$domain/ ) {
601                         $branchcode = $branches->{$br}->{'branchcode'};
602
603                         # new op dev : add the branchprinter and branchname in the cookie
604                         $branchprinter = $branches->{$br}->{'branchprinter'};
605                         $branchname    = $branches->{$br}->{'branchname'};
606                     }
607                 }
608                 $session->param('number',$borrowernumber);
609                 $session->param('id',$userid);
610                 $session->param('cardnumber',$cardnumber);
611                 $session->param('firstname',$firstname);
612                 $session->param('surname',$surname);
613                 $session->param('branch',$branchcode);
614                 $session->param('branchname',$branchname);
615                 $session->param('flags',$userflags);
616                 $session->param('emailaddress',$emailaddress);
617                 $session->param('ip',$session->remote_addr());
618                 $session->param('lasttime',time());
619 #            warn       "".$session->param('cardnumber').",   ".$session->param('firstname').",
620 #                 ".$session->param('surname').",      ".$session->param('branch');
621             }
622             elsif ( $return == 2 ) {
623                 #We suppose the user is the superlibrarian
624                                 $session->param('number',0);
625                                 $session->param('id',C4::Context->config('user'));
626                                 $session->param('cardnumber',C4::Context->config('user'));
627                                 $session->param('firstname',C4::Context->config('user'));
628                                 $session->param('surname',C4::Context->config('user'));
629                                 $session->param('branch','NO_LIBRARY_SET');
630                                 $session->param('branchname','NO_LIBRARY_SET');
631                                 $session->param('flags',1);
632                                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
633                                 $session->param('ip',$session->remote_addr());
634                                 $session->param('lasttime',time());
635                         }
636                         if ($session) {
637                                 C4::Context::set_userenv(
638                                 $session->param('number'),       $session->param('id'),
639                                 $session->param('cardnumber'),   $session->param('firstname'),
640                                 $session->param('surname'),      $session->param('branch'),
641                                 $session->param('branchname'),   $session->param('flags'),
642                                 $session->param('emailaddress'), $session->param('branchprinter')
643                                 );
644                         }
645         }
646         else {
647             if ($userid) {
648                 $info{'invalid_username_or_password'} = 1;
649                 C4::Context->_unset_userenv($sessionID);
650             }
651         }
652     }
653     my $insecure = C4::Context->boolean_preference('insecure');
654
655     # finished authentification, now respond
656     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
657     {
658         # successful login
659         unless ($cookie) {
660             $cookie = $query->cookie( CGISESSID => '' );
661         }
662         return ( $userid, $cookie, $sessionID, $flags );
663     }
664
665 #
666 #
667 # AUTH rejected, show the login/password template, after checking the DB.
668 #
669 #
670     
671     # get the inputs from the incoming query
672     my @inputs = ();
673     foreach my $name ( param $query) {
674         (next) if ( $name eq 'userid' || $name eq 'password' );
675         my $value = $query->param($name);
676         push @inputs, { name => $name, value => $value };
677     }
678     # get the branchloop, which we need for authentication
679     my $branches = GetBranches();
680     my @branch_loop;
681     for my $branch_hash (keys %$branches) {
682                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
683     }
684
685     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
686     my $template = gettemplate( $template_name, $type, $query );
687     $template->param(branchloop => \@branch_loop,);
688     $template->param(
689     login        => 1,
690         INPUTS               => \@inputs,
691         suggestion           => C4::Context->preference("suggestion"),
692         virtualshelves       => C4::Context->preference("virtualshelves"),
693         opaclargeimage       => C4::Context->preference("opaclargeimage"),
694         LibraryName          => C4::Context->preference("LibraryName"),
695         OpacNav              => C4::Context->preference("OpacNav"),
696         opaccredits          => C4::Context->preference("opaccredits"),
697         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
698         opacsmallimage       => C4::Context->preference("opacsmallimage"),
699         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
700         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
701         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
702         opacuserjs           => C4::Context->preference("opacuserjs"),
703
704         intranetcolorstylesheet =>
705           C4::Context->preference("intranetcolorstylesheet"),
706         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
707         IntranetNav        => C4::Context->preference("IntranetNav"),
708         intranetuserjs     => C4::Context->preference("intranetuserjs"),
709         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
710         IndependantBranches     => C4::Context->preference("IndependantBranches"),
711                 AutoLocation       => C4::Context->preference("AutoLocation"),
712     );
713     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
714
715     my $self_url = $query->url( -absolute => 1 );
716     $template->param(
717         url         => $self_url,
718         LibraryName => => C4::Context->preference("LibraryName"),
719     );
720     $template->param( \%info );
721 #    $cookie = $query->cookie(CGISESSID => $session->id
722 #   );
723     print $query->header(
724                 -type   => 'text/html',
725         -charset => 'utf-8',
726         -cookie => $cookie
727       ),
728       $template->output;
729     exit;
730 }
731
732 =item check_api_auth
733
734   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
735
736 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
737 cookie, determine if the user has the privileges specified by C<$userflags>.
738
739 C<check_api_auth> is is meant for authenticating users of web services, and
740 consequently will always return and will not attempt to redirect the user
741 agent.
742
743 If a valid session cookie is already present, check_api_auth will return a status
744 of "ok", the cookie, and the Koha session ID.
745
746 If no session cookie is present, check_api_auth will check the 'userid' and 'password
747 parameters and create a session cookie and Koha session if the supplied credentials
748 are OK.
749
750 Possible return values in C<$status> are:
751
752 =over 4
753
754 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
755
756 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
757
758 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
759
760 =item "expired -- session cookie has expired; API user should resubmit userid and password
761
762 =back
763
764 =cut
765
766 sub check_api_auth {
767     my $query = shift;
768     my $flagsrequired = shift;
769
770     my $dbh     = C4::Context->dbh;
771     my $timeout = C4::Context->preference('timeout');
772     $timeout = 600 unless $timeout;
773
774     unless (C4::Context->preference('Version')) {
775         # database has not been installed yet
776         return ("maintenance", undef, undef);
777     }
778     my $kohaversion=C4::Context::KOHAVERSION;
779     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
780     if (C4::Context->preference('Version') < $kohaversion) {
781         # database in need of version update; assume that
782         # no API should be called while databsae is in
783         # this condition.
784         return ("maintenance", undef, undef);
785     }
786
787     # FIXME -- most of what follows is a copy-and-paste
788     # of code from checkauth.  There is an obvious need
789     # for refactoring to separate the various parts of
790     # the authentication code, but as of 2007-11-19 this
791     # is deferred so as to not introduce bugs into the
792     # regular authentication code for Koha 3.0.
793
794     # see if we have a valid session cookie already
795     # however, if a userid parameter is present (i.e., from
796     # a form submission, assume that any current cookie
797     # is to be ignored
798     my $sessionID = undef;
799     unless ($query->param('userid')) {
800         $sessionID = $query->cookie("CGISESSID");
801     }
802     if ($sessionID) {
803         my $session = get_session($sessionID);
804         C4::Context->_new_userenv($sessionID);
805         if ($session) {
806             C4::Context::set_userenv(
807                 $session->param('number'),       $session->param('id'),
808                 $session->param('cardnumber'),   $session->param('firstname'),
809                 $session->param('surname'),      $session->param('branch'),
810                 $session->param('branchname'),   $session->param('flags'),
811                 $session->param('emailaddress'), $session->param('branchprinter')
812             );
813
814             my $ip = $session->param('ip');
815             my $lasttime = $session->param('lasttime');
816             my $userid = $session->param('id');
817             if ( $lasttime < time() - $timeout ) {
818                 # time out
819                 $session->delete();
820                 C4::Context->_unset_userenv($sessionID);
821                 $userid    = undef;
822                 $sessionID = undef;
823                 return ("expired", undef, undef);
824             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
825                 # IP address changed
826                 $session->delete();
827                 C4::Context->_unset_userenv($sessionID);
828                 $userid    = undef;
829                 $sessionID = undef;
830                 return ("expired", undef, undef);
831             } else {
832                 my $cookie = $query->cookie( CGISESSID => $session->id );
833                 $session->param('lasttime',time());
834                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
835                 if ($flags) {
836                     return ("ok", $cookie, $sessionID);
837                 } else {
838                     $session->delete();
839                     C4::Context->_unset_userenv($sessionID);
840                     $userid    = undef;
841                     $sessionID = undef;
842                     return ("failed", undef, undef);
843                 }
844             }
845         } else {
846             return ("expired", undef, undef);
847         }
848     } else {
849         # new login
850         my $userid = $query->param('userid');   
851         my $password = $query->param('password');   
852         unless ($userid and $password) {
853             # caller did something wrong, fail the authenticateion
854             return ("failed", undef, undef);
855         }
856         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
857         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
858             my $session = get_session("");
859             return ("failed", undef, undef) unless $session;
860
861             my $sessionID = $session->id;
862             C4::Context->_new_userenv($sessionID);
863             my $cookie = $query->cookie(CGISESSID => $sessionID);
864             if ( $return == 1 ) {
865                 my (
866                     $borrowernumber, $firstname,  $surname,
867                     $userflags,      $branchcode, $branchname,
868                     $branchprinter,  $emailaddress
869                 );
870                 my $sth =
871                   $dbh->prepare(
872 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
873                   );
874                 $sth->execute($userid);
875                 (
876                     $borrowernumber, $firstname,  $surname,
877                     $userflags,      $branchcode, $branchname,
878                     $branchprinter,  $emailaddress
879                 ) = $sth->fetchrow if ( $sth->rows );
880
881                 unless ($sth->rows ) {
882                     my $sth = $dbh->prepare(
883 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
884                       );
885                     $sth->execute($cardnumber);
886                     (
887                         $borrowernumber, $firstname,  $surname,
888                         $userflags,      $branchcode, $branchname,
889                         $branchprinter,  $emailaddress
890                     ) = $sth->fetchrow if ( $sth->rows );
891
892                     unless ( $sth->rows ) {
893                         $sth->execute($userid);
894                         (
895                             $borrowernumber, $firstname, $surname, $userflags,
896                             $branchcode, $branchname, $branchprinter, $emailaddress
897                         ) = $sth->fetchrow if ( $sth->rows );
898                     }
899                 }
900
901                 my $ip       = $ENV{'REMOTE_ADDR'};
902                 # if they specify at login, use that
903                 if ($query->param('branch')) {
904                     $branchcode  = $query->param('branch');
905                     $branchname = GetBranchName($branchcode);
906                 }
907                 my $branches = GetBranches();
908                 my @branchesloop;
909                 foreach my $br ( keys %$branches ) {
910                     #     now we work with the treatment of ip
911                     my $domain = $branches->{$br}->{'branchip'};
912                     if ( $domain && $ip =~ /^$domain/ ) {
913                         $branchcode = $branches->{$br}->{'branchcode'};
914
915                         # new op dev : add the branchprinter and branchname in the cookie
916                         $branchprinter = $branches->{$br}->{'branchprinter'};
917                         $branchname    = $branches->{$br}->{'branchname'};
918                     }
919                 }
920                 $session->param('number',$borrowernumber);
921                 $session->param('id',$userid);
922                 $session->param('cardnumber',$cardnumber);
923                 $session->param('firstname',$firstname);
924                 $session->param('surname',$surname);
925                 $session->param('branch',$branchcode);
926                 $session->param('branchname',$branchname);
927                 $session->param('flags',$userflags);
928                 $session->param('emailaddress',$emailaddress);
929                 $session->param('ip',$session->remote_addr());
930                 $session->param('lasttime',time());
931             } elsif ( $return == 2 ) {
932                 #We suppose the user is the superlibrarian
933                 $session->param('number',0);
934                 $session->param('id',C4::Context->config('user'));
935                 $session->param('cardnumber',C4::Context->config('user'));
936                 $session->param('firstname',C4::Context->config('user'));
937                 $session->param('surname',C4::Context->config('user'));
938                 $session->param('branch','NO_LIBRARY_SET');
939                 $session->param('branchname','NO_LIBRARY_SET');
940                 $session->param('flags',1);
941                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
942                 $session->param('ip',$session->remote_addr());
943                 $session->param('lasttime',time());
944             } 
945             C4::Context::set_userenv(
946                 $session->param('number'),       $session->param('id'),
947                 $session->param('cardnumber'),   $session->param('firstname'),
948                 $session->param('surname'),      $session->param('branch'),
949                 $session->param('branchname'),   $session->param('flags'),
950                 $session->param('emailaddress'), $session->param('branchprinter')
951             );
952             return ("ok", $cookie, $sessionID);
953         } else {
954             return ("failed", undef, undef);
955         }
956     } 
957 }
958
959 =item check_cookie_auth
960
961   ($status, $sessionId) = check_api_auth($cookie, $userflags);
962
963 Given a CGISESSID cookie set during a previous login to Koha, determine
964 if the user has the privileges specified by C<$userflags>.
965
966 C<check_cookie_auth> is meant for authenticating special services
967 such as tools/upload-file.pl that are invoked by other pages that
968 have been authenticated in the usual way.
969
970 Possible return values in C<$status> are:
971
972 =over 4
973
974 =item "ok" -- user authenticated; C<$sessionID> have valid values.
975
976 =item "failed" -- credentials are not correct; C<$sessionid> are undef
977
978 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
979
980 =item "expired -- session cookie has expired; API user should resubmit userid and password
981
982 =back
983
984 =cut
985
986 sub check_cookie_auth {
987     my $cookie = shift;
988     my $flagsrequired = shift;
989
990     my $dbh     = C4::Context->dbh;
991     my $timeout = C4::Context->preference('timeout');
992     $timeout = 600 unless $timeout;
993
994     unless (C4::Context->preference('Version')) {
995         # database has not been installed yet
996         return ("maintenance", undef);
997     }
998     my $kohaversion=C4::Context::KOHAVERSION;
999     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1000     if (C4::Context->preference('Version') < $kohaversion) {
1001         # database in need of version update; assume that
1002         # no API should be called while databsae is in
1003         # this condition.
1004         return ("maintenance", undef);
1005     }
1006
1007     # FIXME -- most of what follows is a copy-and-paste
1008     # of code from checkauth.  There is an obvious need
1009     # for refactoring to separate the various parts of
1010     # the authentication code, but as of 2007-11-23 this
1011     # is deferred so as to not introduce bugs into the
1012     # regular authentication code for Koha 3.0.
1013
1014     # see if we have a valid session cookie already
1015     # however, if a userid parameter is present (i.e., from
1016     # a form submission, assume that any current cookie
1017     # is to be ignored
1018     unless (defined $cookie and $cookie) {
1019         return ("failed", undef);
1020     }
1021     my $sessionID = $cookie;
1022     my $session = get_session($sessionID);
1023     C4::Context->_new_userenv($sessionID);
1024     if ($session) {
1025         C4::Context::set_userenv(
1026             $session->param('number'),       $session->param('id'),
1027             $session->param('cardnumber'),   $session->param('firstname'),
1028             $session->param('surname'),      $session->param('branch'),
1029             $session->param('branchname'),   $session->param('flags'),
1030             $session->param('emailaddress'), $session->param('branchprinter')
1031         );
1032
1033         my $ip = $session->param('ip');
1034         my $lasttime = $session->param('lasttime');
1035         my $userid = $session->param('id');
1036         if ( $lasttime < time() - $timeout ) {
1037             # time out
1038             $session->delete();
1039             C4::Context->_unset_userenv($sessionID);
1040             $userid    = undef;
1041             $sessionID = undef;
1042             return ("expired", undef);
1043         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1044             # IP address changed
1045             $session->delete();
1046             C4::Context->_unset_userenv($sessionID);
1047             $userid    = undef;
1048             $sessionID = undef;
1049             return ("expired", undef);
1050         } else {
1051             $session->param('lasttime',time());
1052             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1053             if ($flags) {
1054                 return ("ok", $sessionID);
1055             } else {
1056                 $session->delete();
1057                 C4::Context->_unset_userenv($sessionID);
1058                 $userid    = undef;
1059                 $sessionID = undef;
1060                 return ("failed", undef);
1061             }
1062         }
1063     } else {
1064         return ("expired", undef);
1065     }
1066 }
1067
1068 =item get_session
1069
1070   use CGI::Session;
1071   my $session = get_session($sessionID);
1072
1073 Given a session ID, retrieve the CGI::Session object used to store
1074 the session's state.  The session object can be used to store 
1075 data that needs to be accessed by different scripts during a
1076 user's session.
1077
1078 If the C<$sessionID> parameter is an empty string, a new session
1079 will be created.
1080
1081 =cut
1082
1083 sub get_session {
1084     my $sessionID = shift;
1085     my $storage_method = C4::Context->preference('SessionStorage');
1086     my $dbh = C4::Context->dbh;
1087     my $session;
1088     if ($storage_method eq 'mysql'){
1089         $session = new CGI::Session("driver:MySQL", $sessionID, {Handle=>$dbh});
1090     }
1091     elsif ($storage_method eq 'Pg') {
1092         $session = new CGI::Session("driver:PostgreSQL", $sessionID, {Handle=>$dbh});
1093     }
1094     else {
1095         # catch all defaults to tmp should work on all systems
1096         $session = new CGI::Session("driver:File", $sessionID, {Directory=>'/tmp'});
1097     }
1098     return $session;
1099 }
1100
1101 sub checkpw {
1102
1103     my ( $dbh, $userid, $password ) = @_;
1104
1105     # INTERNAL AUTH
1106     my $sth =
1107       $dbh->prepare(
1108 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1109       );
1110     $sth->execute($userid);
1111     if ( $sth->rows ) {
1112         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1113             $surname, $branchcode, $flags )
1114           = $sth->fetchrow;
1115         if ( md5_base64($password) eq $md5password ) {
1116
1117             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1118                 $firstname, $surname, $branchcode, $flags );
1119             return 1, $cardnumber;
1120         }
1121     }
1122     $sth =
1123       $dbh->prepare(
1124 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1125       );
1126     $sth->execute($userid);
1127     if ( $sth->rows ) {
1128         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1129             $surname, $branchcode, $flags )
1130           = $sth->fetchrow;
1131         if ( md5_base64($password) eq $md5password ) {
1132
1133             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1134                 $firstname, $surname, $branchcode, $flags );
1135             return 1, $userid;
1136         }
1137     }
1138     if (   $userid && $userid eq C4::Context->config('user')
1139         && "$password" eq C4::Context->config('pass') )
1140     {
1141
1142 # Koha superuser account
1143 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1144         return 2;
1145     }
1146     if (   $userid && $userid eq 'demo'
1147         && "$password" eq 'demo'
1148         && C4::Context->config('demo') )
1149     {
1150
1151 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1152 # some features won't be effective : modify systempref, modify MARC structure,
1153         return 2;
1154     }
1155     return 0;
1156 }
1157
1158 =item getuserflags
1159
1160  $authflags = getuserflags($flags,$dbh);
1161 Translates integer flags into permissions strings hash.
1162
1163 C<$flags> is the integer userflags value ( borrowers.userflags )
1164 C<$authflags> is a hashref of permissions
1165
1166 =cut
1167
1168 sub getuserflags {
1169     my $flags   = shift;
1170     my $dbh     = shift;
1171     my $userflags;
1172         $flags = 0 unless $flags;
1173     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1174     $sth->execute;
1175
1176     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1177         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1178             $userflags->{$flag} = 1;
1179         }
1180         else {
1181             $userflags->{$flag} = 0;
1182         }
1183     }
1184     return $userflags;
1185 }
1186
1187 =item haspermission 
1188
1189   $flags = ($dbh,$member,$flagsrequired);
1190
1191 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1192 C<$flags> is a hashref of required flags lik C<$borrower-&lt;{authflags}> 
1193
1194 Returns member's flags or 0 if a permission is not met.
1195
1196 =cut
1197
1198 sub haspermission {
1199     my ( $dbh, $userid, $flagsrequired ) = @_;
1200         my ($flags,$intflags);
1201         $dbh=C4::Context->dbh unless($dbh);
1202         if(ref($userid)) {
1203                 $intflags = $userid->{'flags'};  
1204         } else {
1205             my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1206             $sth->execute($userid);
1207             my ($intflags) = $sth->fetchrow;
1208             $flags = getuserflags( $intflags, $dbh );
1209         }
1210         if ( $userid eq C4::Context->config('user') ) {
1211         # Super User Account from /etc/koha.conf
1212         $flags->{'superlibrarian'} = 1;
1213     }
1214     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1215         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1216         $flags->{'superlibrarian'} = 1;
1217     }
1218     return $flags if $flags->{superlibrarian};
1219     foreach ( keys %$flagsrequired ) {
1220         return 0 unless( $flags->{$_} );
1221     }
1222     return $flags;
1223         #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1224 }
1225
1226
1227 sub getborrowernumber {
1228     my ($userid) = @_;
1229     my $dbh = C4::Context->dbh;
1230     for my $field ( 'userid', 'cardnumber' ) {
1231         my $sth =
1232           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1233         $sth->execute($userid);
1234         if ( $sth->rows ) {
1235             my ($bnumber) = $sth->fetchrow;
1236             return $bnumber;
1237         }
1238     }
1239     return 0;
1240 }
1241
1242 END { }    # module clean-up code here (global destructor)
1243 1;
1244 __END__
1245
1246 =back
1247
1248 =head1 SEE ALSO
1249
1250 CGI(3)
1251
1252 C4::Output(3)
1253
1254 Digest::MD5(3)
1255
1256 =cut