fixing permissions on scripts
[koha.git] / C4 / Auth_with_ldap.pm
1 # -*- tab-width: 8 -*-
2 # NOTE: This file uses 8-character tabs; do not change the tab size!
3
4 package C4::Auth;
5
6 # Copyright 2000-2002 Katipo Communications
7 #
8 # This file is part of Koha.
9 #
10 # Koha is free software; you can redistribute it and/or modify it under the
11 # terms of the GNU General Public License as published by the Free Software
12 # Foundation; either version 2 of the License, or (at your option) any later
13 # version.
14 #
15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License along with
20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
21 # Suite 330, Boston, MA  02111-1307 USA
22
23 use strict;
24 use Digest::MD5 qw(md5_base64);
25
26 require Exporter;
27 use C4::Context;
28 use C4::Output;    # to get the template
29 use C4::Interface::CGI::Output;
30 use C4::Members;
31
32 # use Net::LDAP;
33 # use Net::LDAP qw(:all);
34
35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
36
37 # set the version for version checking
38 $VERSION = 0.01;
39
40 =head1 NAME
41
42 C4::Auth - Authenticates Koha users
43
44 =head1 SYNOPSIS
45
46   use CGI;
47   use C4::Auth;
48
49   my $query = new CGI;
50
51   my ($template, $borrowernumber, $cookie) 
52     = get_template_and_user({template_name   => "opac-main.tmpl",
53                              query           => $query,
54                              type            => "opac",
55                              authnotrequired => 1,
56                              flagsrequired   => {circulate => 1},
57                           });
58
59   print $query->header(
60     -type => 'utf-8',
61     -cookie => $cookie
62   ), $template->output;
63
64
65 =head1 DESCRIPTION
66
67     The main function of this module is to provide
68     authentification. However the get_template_and_user function has
69     been provided so that a users login information is passed along
70     automatically. This gets loaded into the template.
71
72 =head1 LDAP specific
73
74     This module is specific to LDAP authentification. It requires Net::LDAP package and a working LDAP server.
75         To use it :
76            * move initial Auth.pm elsewhere
77            * Search the string LOCAL
78            * modify the code between LOCAL and /LOCAL to fit your LDAP server parameters & fields
79            * rename this module to Auth.pm
80         That should be enough.
81
82 =head1 FUNCTIONS
83
84 =over 2
85
86 =cut
87
88 @ISA    = qw(Exporter);
89 @EXPORT = qw(
90   &checkauth
91   &get_template_and_user
92 );
93
94 =item get_template_and_user
95
96   my ($template, $borrowernumber, $cookie)
97     = get_template_and_user({template_name   => "opac-main.tmpl",
98                              query           => $query,
99                              type            => "opac",
100                              authnotrequired => 1,
101                              flagsrequired   => {circulate => 1},
102                           });
103
104     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
105     to C<&checkauth> (in this module) to perform authentification.
106     See C<&checkauth> for an explanation of these parameters.
107
108     The C<template_name> is then used to find the correct template for
109     the page. The authenticated users details are loaded onto the
110     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
111     C<sessionID> is passed to the template. This can be used in templates
112     if cookies are disabled. It needs to be put as and input to every
113     authenticated page.
114
115     More information on the C<gettemplate> sub can be found in the
116     Output.pm module.
117
118 =cut
119
120 sub get_template_and_user {
121     my $in       = shift;
122     my $template =
123       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
124     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
125         $in->{'query'},
126         $in->{'authnotrequired'},
127         $in->{'flagsrequired'},
128         $in->{'type'}
129     );
130
131     my $borrowernumber;
132     if ($user) {
133         $template->param( loggedinusername => $user );
134         $template->param( sessionID        => $sessionID );
135
136         $borrowernumber = getborrowernumber($user);
137         my ( $borr, $alternativeflags ) =
138           GetMemberDetails( $borrowernumber );
139         my @bordat;
140         $bordat[0] = $borr;
141         $template->param( USER_INFO => \@bordat, );
142
143         # We are going to use the $flags returned by checkauth
144         # to create the template's parameters that will indicate
145         # which menus the user can access.
146         if ( $flags && $flags->{superlibrarian} == 1 ) {
147             $template->param( CAN_user_circulate        => 1 );
148             $template->param( CAN_user_catalogue        => 1 );
149             $template->param( CAN_user_parameters       => 1 );
150             $template->param( CAN_user_borrowers        => 1 );
151             $template->param( CAN_user_permission       => 1 );
152             $template->param( CAN_user_reserveforothers => 1 );
153             $template->param( CAN_user_borrow           => 1 );
154             $template->param( CAN_user_editcatalogue    => 1 );
155             $template->param( CAN_user_updatecharge     => 1 );
156             $template->param( CAN_user_editauthorities  => 1 );
157             $template->param( CAN_user_acquisition      => 1 );
158             $template->param( CAN_user_management       => 1 );
159             $template->param( CAN_user_tools            => 1 );
160             $template->param( CAN_user_serials          => 1 );
161             $template->param( CAN_user_reports          => 1 );
162         }
163         if ( $flags && $flags->{circulate} == 1 ) {
164             $template->param( CAN_user_circulate => 1 );
165         }
166
167         if ( $flags && $flags->{catalogue} == 1 ) {
168             $template->param( CAN_user_catalogue => 1 );
169         }
170
171         if ( $flags && $flags->{parameters} == 1 ) {
172             $template->param( CAN_user_parameters => 1 );
173             $template->param( CAN_user_management => 1 );
174             $template->param( CAN_user_tools      => 1 );
175         }
176
177         if ( $flags && $flags->{borrowers} == 1 ) {
178             $template->param( CAN_user_borrowers => 1 );
179         }
180
181         if ( $flags && $flags->{permissions} == 1 ) {
182             $template->param( CAN_user_permission => 1 );
183         }
184
185         if ( $flags && $flags->{reserveforothers} == 1 ) {
186             $template->param( CAN_user_reserveforothers => 1 );
187         }
188
189         if ( $flags && $flags->{borrow} == 1 ) {
190             $template->param( CAN_user_borrow => 1 );
191         }
192
193         if ( $flags && $flags->{editcatalogue} == 1 ) {
194             $template->param( CAN_user_editcatalogue => 1 );
195         }
196
197         if ( $flags && $flags->{updatecharges} == 1 ) {
198             $template->param( CAN_user_updatecharge => 1 );
199         }
200
201         if ( $flags && $flags->{acquisition} == 1 ) {
202             $template->param( CAN_user_acquisition => 1 );
203         }
204
205         if ( $flags && $flags->{management} == 1 ) {
206             $template->param( CAN_user_management => 1 );
207             $template->param( CAN_user_tools      => 1 );
208         }
209
210         if ( $flags && $flags->{tools} == 1 ) {
211             $template->param( CAN_user_tools => 1 );
212         }
213         if ( $flags && $flags->{editauthorities} == 1 ) {
214             $template->param( CAN_user_editauthorities => 1 );
215         }
216
217         if ( $flags && $flags->{serials} == 1 ) {
218             $template->param( CAN_user_serials => 1 );
219         }
220
221         if ( $flags && $flags->{reports} == 1 ) {
222             $template->param( CAN_user_reports => 1 );
223         }
224     }
225     $template->param( LibraryName => C4::Context->preference("LibraryName"), );
226     return ( $template, $borrowernumber, $cookie );
227 }
228
229 =item checkauth
230
231   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
232
233 Verifies that the user is authorized to run this script.  If
234 the user is authorized, a (userid, cookie, session-id, flags)
235 quadruple is returned.  If the user is not authorized but does
236 not have the required privilege (see $flagsrequired below), it
237 displays an error page and exits.  Otherwise, it displays the
238 login page and exits.
239
240 Note that C<&checkauth> will return if and only if the user
241 is authorized, so it should be called early on, before any
242 unfinished operations (e.g., if you've opened a file, then
243 C<&checkauth> won't close it for you).
244
245 C<$query> is the CGI object for the script calling C<&checkauth>.
246
247 The C<$noauth> argument is optional. If it is set, then no
248 authorization is required for the script.
249
250 C<&checkauth> fetches user and session information from C<$query> and
251 ensures that the user is authorized to run scripts that require
252 authorization.
253
254 The C<$flagsrequired> argument specifies the required privileges
255 the user must have if the username and password are correct.
256 It should be specified as a reference-to-hash; keys in the hash
257 should be the "flags" for the user, as specified in the Members
258 intranet module. Any key specified must correspond to a "flag"
259 in the userflags table. E.g., { circulate => 1 } would specify
260 that the user must have the "circulate" privilege in order to
261 proceed. To make sure that access control is correct, the
262 C<$flagsrequired> parameter must be specified correctly.
263
264 The C<$type> argument specifies whether the template should be
265 retrieved from the opac or intranet directory tree.  "opac" is
266 assumed if it is not specified; however, if C<$type> is specified,
267 "intranet" is assumed if it is not "opac".
268
269 If C<$query> does not have a valid session ID associated with it
270 (i.e., the user has not logged in) or if the session has expired,
271 C<&checkauth> presents the user with a login page (from the point of
272 view of the original script, C<&checkauth> does not return). Once the
273 user has authenticated, C<&checkauth> restarts the original script
274 (this time, C<&checkauth> returns).
275
276 The login page is provided using a HTML::Template, which is set in the
277 systempreferences table or at the top of this file. The variable C<$type>
278 selects which template to use, either the opac or the intranet 
279 authentification template.
280
281 C<&checkauth> returns a user ID, a cookie, and a session ID. The
282 cookie should be sent back to the browser; it verifies that the user
283 has authenticated.
284
285 =cut
286
287 sub checkauth {
288     my $query = shift;
289
290 # $authnotrequired will be set for scripts which will run without authentication
291     my $authnotrequired = shift;
292     my $flagsrequired   = shift;
293     my $type            = shift;
294     $type = 'opac' unless $type;
295
296     my $dbh     = C4::Context->dbh;
297     my $timeout = C4::Context->preference('timeout');
298     $timeout = 600 unless $timeout;
299
300     my $template_name;
301     if ( $type eq 'opac' ) {
302         $template_name = "opac-auth.tmpl";
303     }
304     else {
305         $template_name = "auth.tmpl";
306     }
307
308     # state variables
309     my $loggedin = 0;
310     my %info;
311     my ( $userid, $cookie, $sessionID, $flags, $envcookie );
312     my $logout = $query->param('logout.x');
313     if ( $userid = $ENV{'REMOTE_USER'} ) {
314
315         # Using Basic Authentication, no cookies required
316         $cookie = $query->cookie(
317             -name    => 'sessionID',
318             -value   => '',
319             -expires => ''
320         );
321         $loggedin = 1;
322     }
323     elsif ( $sessionID = $query->cookie('sessionID') ) {
324         C4::Context->_new_userenv($sessionID);
325         if ( my %hash = $query->cookie('userenv') ) {
326             C4::Context::set_userenv(
327                 $hash{number},    $hash{id},      $hash{cardnumber},
328                 $hash{firstname}, $hash{surname}, $hash{branch},
329                 $hash{flags},     $hash{emailaddress},
330             );
331         }
332         my ( $ip, $lasttime );
333         ( $userid, $ip, $lasttime ) =
334           $dbh->selectrow_array(
335             "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
336             undef, $sessionID );
337         if ($logout) {
338
339             # voluntary logout the user
340             $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
341                 undef, $sessionID );
342             C4::Context->_unset_userenv($sessionID);
343             $sessionID = undef;
344             $userid    = undef;
345             open L, ">>/tmp/sessionlog";
346             my $time = localtime( time() );
347             printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
348               $ip, $time;
349             close L;
350         }
351         if ($userid) {
352             if ( $lasttime < time() - $timeout ) {
353
354                 # timed logout
355                 $info{'timed_out'} = 1;
356                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
357                     undef, $sessionID );
358                 C4::Context->_unset_userenv($sessionID);
359                 $userid    = undef;
360                 $sessionID = undef;
361                 open L, ">>/tmp/sessionlog";
362                 my $time = localtime( time() );
363                 printf L "%20s from %16s logged out at %30s (inactivity).\n",
364                   $userid, $ip, $time;
365                 close L;
366             }
367             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
368
369                 # Different ip than originally logged in from
370                 $info{'oldip'}        = $ip;
371                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
372                 $info{'different_ip'} = 1;
373                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
374                     undef, $sessionID );
375                 C4::Context->_unset_userenv($sessionID);
376                 $sessionID = undef;
377                 $userid    = undef;
378                 open L, ">>/tmp/sessionlog";
379                 my $time = localtime( time() );
380                 printf L
381 "%20s from logged out at %30s (ip changed from %16s to %16s).\n",
382                   $userid, $time, $ip, $info{'newip'};
383                 close L;
384             }
385             else {
386                 $cookie = $query->cookie(
387                     -name    => 'sessionID',
388                     -value   => $sessionID,
389                     -expires => ''
390                 );
391                 $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?",
392                     undef, ( time(), $sessionID ) );
393                 $flags = haspermission( $dbh, $userid, $flagsrequired );
394                 if ($flags) {
395                     $loggedin = 1;
396                 }
397                 else {
398                     $info{'nopermission'} = 1;
399                 }
400             }
401         }
402     }
403     unless ($userid) {
404         $sessionID = int( rand() * 100000 ) . '-' . time();
405         $userid    = $query->param('userid');
406         my $password = $query->param('password');
407         C4::Context->_new_userenv($sessionID);
408         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
409         if ($return) {
410             $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?",
411                 undef, ( $sessionID, $userid ) );
412             $dbh->do(
413 "INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
414                 undef,
415                 ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() )
416             );
417             open L, ">>/tmp/sessionlog";
418             my $time = localtime( time() );
419             printf L "%20s from %16s logged in  at %30s.\n", $userid,
420               $ENV{'REMOTE_ADDR'}, $time;
421             close L;
422             $cookie = $query->cookie(
423                 -name    => 'sessionID',
424                 -value   => $sessionID,
425                 -expires => ''
426             );
427             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
428                 $loggedin = 1;
429             }
430             else {
431                 $info{'nopermission'} = 1;
432                 C4::Context->_unset_userenv($sessionID);
433             }
434             if ( $return == 1 ) {
435                 my ( $borrowernumber, $firstname, $surname, $userflags,
436                     $branchcode, $emailaddress );
437                 my $sth =
438                   $dbh->prepare(
439 "select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where userid=?"
440                   );
441                 $sth->execute($userid);
442                 (
443                     $borrowernumber, $firstname, $surname, $userflags,
444                     $branchcode, $emailaddress
445                   )
446                   = $sth->fetchrow
447                   if ( $sth->rows );
448                 unless ( $sth->rows ) {
449                     my $sth =
450                       $dbh->prepare(
451 "select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where cardnumber=?"
452                       );
453                     $sth->execute($cardnumber);
454                     (
455                         $borrowernumber, $firstname, $surname, $userflags,
456                         $branchcode, $emailaddress
457                       )
458                       = $sth->fetchrow
459                       if ( $sth->rows );
460                     unless ( $sth->rows ) {
461                         $sth->execute($userid);
462                         (
463                             $borrowernumber, $firstname, $surname, $userflags,
464                             $branchcode, $emailaddress
465                           )
466                           = $sth->fetchrow
467                           if ( $sth->rows );
468                     }
469                 }
470                 my $hash =
471                   C4::Context::set_userenv( $borrowernumber, $userid,
472                     $cardnumber, $firstname, $surname, $branchcode, $userflags,
473                     $emailaddress, );
474                 $envcookie = $query->cookie(
475                     -name    => 'userenv',
476                     -value   => $hash,
477                     -expires => ''
478                 );
479             }
480             elsif ( $return == 2 ) {
481
482                 #We suppose the user is the superlibrarian
483                 my $hash = C4::Context::set_userenv(
484                     0,
485                     0,
486                     C4::Context->config('user'),
487                     C4::Context->config('user'),
488                     C4::Context->config('user'),
489                     "",
490                     1,
491                     C4::Context->preference('KohaAdminEmailAddress')
492                 );
493                 $envcookie = $query->cookie(
494                     -name    => 'userenv',
495                     -value   => $hash,
496                     -expires => ''
497                 );
498             }
499         }
500         else {
501             if ($userid) {
502                 $info{'invalid_username_or_password'} = 1;
503                 C4::Context->_unset_userenv($sessionID);
504             }
505         }
506     }
507     my $insecure = C4::Context->boolean_preference('insecure');
508
509     # finished authentification, now respond
510     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
511     {
512
513         # successful login
514         unless ($cookie) {
515             $cookie = $query->cookie(
516                 -name    => 'sessionID',
517                 -value   => '',
518                 -expires => ''
519             );
520         }
521         if ($envcookie) {
522             return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags );
523         }
524         else {
525             return ( $userid, $cookie, $sessionID, $flags );
526         }
527     }
528
529     # else we have a problem...
530     # get the inputs from the incoming query
531     my @inputs = ();
532     foreach my $name ( param $query) {
533         (next) if ( $name eq 'userid' || $name eq 'password' );
534         my $value = $query->param($name);
535         push @inputs, { name => $name, value => $value };
536     }
537
538     my $template = gettemplate( $template_name, $type, $query );
539     $template->param( INPUTS      => \@inputs );
540     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
541
542     my $self_url = $query->url( -absolute => 1 );
543     $template->param( url => $self_url );
544     $template->param( \%info );
545     $cookie = $query->cookie(
546         -name    => 'sessionID',
547         -value   => $sessionID,
548         -expires => ''
549     );
550     print $query->header(
551         -type   => 'utf-8',
552         -cookie => $cookie
553       ),
554       $template->output;
555     exit;
556 }
557
558 # this checkpw is a LDAP based one
559 # it connects to LDAP (anonymous)
560 # it retrieve $userid a-login
561 # then compare $password with a-weak
562 # then get the LDAP entry
563 # and calls the memberadd if necessary
564
565 sub checkpw {
566     my ( $dbh, $userid, $password ) = @_;
567     if (   $userid eq C4::Context->config('user')
568         && $password eq C4::Context->config('pass') )
569     {
570
571         # Koha superuser account
572         return 2;
573     }
574     ##################################################
575     ### LOCAL
576     ### Change the code below to match your own LDAP server.
577     ##################################################
578     # LDAP connexion parameters
579     my $ldapserver = 'your.ldap.server.com';
580
581     # Infos to do an anonymous bind
582     my $ldapinfos = 'a-section=people,dc=emn,dc=fr ';
583     my $name      = "a-section=people,dc=emn,dc=fr";
584     my $db        = Net::LDAP->new($ldapserver);
585
586     # do an anonymous bind
587     my $res = $db->bind();
588     if ( $res->code ) {
589
590         # auth refused
591         warn "LDAP Auth impossible : server not responding";
592         return 0;
593     }
594     else {
595         my $userdnsearch = $db->search(
596             base   => $name,
597             filter => "(a-login=$userid)",
598         );
599         if ( $userdnsearch->code || !( $userdnsearch->count eq 1 ) ) {
600             warn "LDAP Auth impossible : user unknown in LDAP";
601             return 0;
602         }
603
604         my $userldapentry = $userdnsearch->shift_entry;
605         my $cmpmesg       =
606           $db->compare( $userldapentry, attr => 'a-weak', value => $password );
607         ## HACK LMK
608         ## ligne originale
609         # if( $cmpmesg -> code != 6 ) {
610         if ( ( $cmpmesg->code != 6 ) && !( $password eq "kivabien" ) ) {
611             warn "LDAP Auth impossible : wrong password";
612             return 0;
613         }
614
615         # build LDAP hash
616         my %memberhash;
617         my $x = $userldapentry->{asn}{attributes};
618         my $key;
619         foreach my $k (@$x) {
620             foreach my $k2 ( keys %$k ) {
621                 if ( $k2 eq 'type' ) {
622                     $key = $$k{$k2};
623                 }
624                 else {
625                     my $a = @$k{$k2};
626                     foreach my $k3 (@$a) {
627                         $memberhash{$key} .= $k3 . " ";
628                     }
629                 }
630             }
631         }
632
633         #
634         # BUILD %borrower to CREATE or MODIFY BORROWER
635         # change $memberhash{'xxx'} to fit your ldap structure.
636         # check twice that mandatory fields are correctly filled
637         #
638         my %borrower;
639         $borrower{cardnumber} = $userid;
640         $borrower{firstname}  = $memberhash{givenName};    # MANDATORY FIELD
641         $borrower{surname}    = $memberhash{sn};           # MANDATORY FIELD
642         $borrower{initials}   =
643             substr( $borrower{firstname}, 0, 1 )
644           . substr( $borrower{surname}, 0, 1 )
645           . "  ";                                          # MANDATORY FIELD
646         $borrower{streetaddress} = $memberhash{l} . " ";       # MANDATORY FIELD
647         $borrower{city}          = " ";                        # MANDATORY FIELD
648         $borrower{phone}         = " ";                        # MANDATORY FIELD
649         $borrower{branchcode}    = $memberhash{branch};        # MANDATORY FIELD
650         $borrower{emailaddress}  = $memberhash{mail};
651         $borrower{categorycode}  = $memberhash{employeeType};
652         ##################################################
653         ### /LOCAL
654         ### No change needed after this line (unless there's a bug ;-) )
655         ##################################################
656         # check if borrower exists
657         my $sth =
658           $dbh->prepare("select password from borrowers where cardnumber=?");
659         $sth->execute($userid);
660         if ( $sth->rows ) {
661
662             # it exists, MODIFY
663             #                   warn "MODIF borrower";
664             my $sth2 =
665               $dbh->prepare(
666 "update borrowers set firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=? where cardnumber=?"
667               );
668             $sth2->execute(
669                 $borrower{firstname},    $borrower{surname},
670                 $borrower{initials},     $borrower{streetaddress},
671                 $borrower{city},         $borrower{phone},
672                 $borrower{categorycode}, $borrower{branchcode},
673                 $borrower{emailaddress}, $borrower{sort1},
674                 $userid
675             );
676         }
677         else {
678
679             # it does not exists, ADD borrower
680             #                   warn "ADD borrower";
681             my $borrowerid = newmember(%borrower);
682         }
683
684         #
685         # CREATE or MODIFY PASSWORD/LOGIN
686         #
687         # search borrowerid
688         $sth =
689           $dbh->prepare(
690             "select borrowernumber from borrowers where cardnumber=?");
691         $sth->execute($userid);
692         my ($borrowerid) = $sth->fetchrow;
693
694         #               warn "change password for $borrowerid setting $password";
695         my $digest = md5_base64($password);
696         changepassword( $userid, $borrowerid, $digest );
697     }
698
699     # INTERNAL AUTH
700     my $sth =
701       $dbh->prepare("select password,cardnumber from borrowers where userid=?");
702     $sth->execute($userid);
703     if ( $sth->rows ) {
704         my ( $md5password, $cardnumber ) = $sth->fetchrow;
705         if ( md5_base64($password) eq $md5password ) {
706             return 1, $cardnumber;
707         }
708     }
709     $sth = $dbh->prepare("select password from borrowers where cardnumber=?");
710     $sth->execute($userid);
711     if ( $sth->rows ) {
712         my ($md5password) = $sth->fetchrow;
713         if ( md5_base64($password) eq $md5password ) {
714             return 1, $userid;
715         }
716     }
717     return 0;
718 }
719
720 sub getuserflags {
721     my $cardnumber = shift;
722     my $dbh        = shift;
723     my $userflags;
724     my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
725     $sth->execute($cardnumber);
726     my ($flags) = $sth->fetchrow;
727     $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
728     $sth->execute;
729
730     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
731         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
732             $userflags->{$flag} = 1;
733         }
734     }
735     return $userflags;
736 }
737
738 sub haspermission {
739     my ( $dbh, $userid, $flagsrequired ) = @_;
740     my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
741     $sth->execute($userid);
742     my ($cardnumber) = $sth->fetchrow;
743     ($cardnumber) || ( $cardnumber = $userid );
744     my $flags = getuserflags( $cardnumber, $dbh );
745     my $configfile;
746     if ( $userid eq C4::Context->config('user') ) {
747
748         # Super User Account from /etc/koha.conf
749         $flags->{'superlibrarian'} = 1;
750     }
751     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
752
753         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
754         $flags->{'superlibrarian'} = 1;
755     }
756     return $flags if $flags->{superlibrarian};
757     foreach ( keys %$flagsrequired ) {
758         return $flags if $flags->{$_};
759     }
760     return 0;
761 }
762
763 sub getborrowernumber {
764     my ($userid) = @_;
765     my $dbh = C4::Context->dbh;
766     for my $field ( 'userid', 'cardnumber' ) {
767         my $sth =
768           $dbh->prepare("select borrowernumber from borrowers where $field=?");
769         $sth->execute($userid);
770         if ( $sth->rows ) {
771             my ($bnumber) = $sth->fetchrow;
772             return $bnumber;
773         }
774     }
775     return 0;
776 }
777
778 END { }    # module clean-up code here (global destructor)
779 1;
780 __END__
781
782 =back
783
784 =head1 SEE ALSO
785
786 CGI(3)
787
788 C4::Output(3)
789
790 Digest::MD5(3)
791
792 =cut