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