fixing permissions on scripts
[koha.git] / C4 / Auth.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 use CGI::Session;
26
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 Net::LDAP;
36 # use Net::LDAP qw(:all);
37
38 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
39
40 # set the version for version checking
41 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
42     shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
43 };
44
45 =head1 NAME
46
47 C4::Auth - Authenticates Koha users
48
49 =head1 SYNOPSIS
50
51   use CGI;
52   use C4::Auth;
53
54   my $query = new CGI;
55
56   my ($template, $borrowernumber, $cookie) 
57     = get_template_and_user(
58         {
59             template_name   => "opac-main.tmpl",
60             query           => $query,
61             type            => "opac",
62             authnotrequired => 1,
63             flagsrequired   => {borrow => 1},
64         }
65     );
66
67   print $query->header(
68     -type => 'utf-8',
69     -cookie => $cookie
70   ), $template->output;
71
72
73 =head1 DESCRIPTION
74
75     The main function of this module is to provide
76     authentification. However the get_template_and_user function has
77     been provided so that a users login information is passed along
78     automatically. This gets loaded into the template.
79
80 =head1 FUNCTIONS
81
82 =over 2
83
84 =cut
85
86 @ISA    = qw(Exporter);
87 @EXPORT = qw(
88   &checkauth
89   &get_template_and_user
90 );
91
92 =item get_template_and_user
93
94   my ($template, $borrowernumber, $cookie)
95     = get_template_and_user(
96         {
97            template_name   => "opac-main.tmpl",
98            query           => $query,
99            type            => "opac",
100            authnotrequired => 1,
101            flagsrequired   => {borrow => 1},
102         }
103     );
104
105     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
106     to C<&checkauth> (in this module) to perform authentification.
107     See C<&checkauth> for an explanation of these parameters.
108
109     The C<template_name> is then used to find the correct template for
110     the page. The authenticated users details are loaded onto the
111     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
112     C<sessionID> is passed to the template. This can be used in templates
113     if cookies are disabled. It needs to be put as and input to every
114     authenticated page.
115
116     More information on the C<gettemplate> sub can be found in the
117     Output.pm module.
118
119 =cut
120
121 sub get_template_and_user {
122     my $in       = shift;
123     my $template =
124       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
125     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
126         $in->{'query'},
127         $in->{'authnotrequired'},
128         $in->{'flagsrequired'},
129         $in->{'type'}
130     ) unless ($in->{'template_name'}=~/maintenance/);
131
132     my $borrowernumber;
133     my $insecure = C4::Context->preference('insecure');
134     if ($user or $insecure) {
135         $template->param( loggedinusername => $user );
136         $template->param( sessionID        => $sessionID );
137
138         $borrowernumber = getborrowernumber($user);
139         my ( $borr, $alternativeflags ) =
140           GetMemberDetails( $borrowernumber );
141         my @bordat;
142         $bordat[0] = $borr;
143         $template->param( "USER_INFO" => \@bordat );
144
145         # We are going to use the $flags returned by checkauth
146         # to create the template's parameters that will indicate
147         # which menus the user can access.
148         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
149             $template->param( CAN_user_circulate        => 1 );
150             $template->param( CAN_user_catalogue        => 1 );
151             $template->param( CAN_user_parameters       => 1 );
152             $template->param( CAN_user_borrowers        => 1 );
153             $template->param( CAN_user_permission       => 1 );
154             $template->param( CAN_user_reserveforothers => 1 );
155             $template->param( CAN_user_borrow           => 1 );
156             $template->param( CAN_user_editcatalogue    => 1 );
157             $template->param( CAN_user_updatecharge     => 1 );
158             $template->param( CAN_user_acquisition      => 1 );
159             $template->param( CAN_user_management       => 1 );
160             $template->param( CAN_user_tools            => 1 ); 
161             $template->param( CAN_user_editauthorities  => 1 );
162             $template->param( CAN_user_serials          => 1 );
163             $template->param( CAN_user_reports          => 1 );
164         }
165
166         if ( $flags && $flags->{circulate} == 1 ) {
167             $template->param( CAN_user_circulate => 1 );
168         }
169
170         if ( $flags && $flags->{catalogue} == 1 ) {
171             $template->param( CAN_user_catalogue => 1 );
172         }
173
174         if ( $flags && $flags->{parameters} == 1 ) {
175             $template->param( CAN_user_parameters => 1 );
176             $template->param( CAN_user_management => 1 );
177         }
178
179         if ( $flags && $flags->{borrowers} == 1 ) {
180             $template->param( CAN_user_borrowers => 1 );
181         }
182
183         if ( $flags && $flags->{permissions} == 1 ) {
184             $template->param( CAN_user_permission => 1 );
185         }
186
187         if ( $flags && $flags->{reserveforothers} == 1 ) {
188             $template->param( CAN_user_reserveforothers => 1 );
189         }
190
191         if ( $flags && $flags->{borrow} == 1 ) {
192             $template->param( CAN_user_borrow => 1 );
193         }
194
195         if ( $flags && $flags->{editcatalogue} == 1 ) {
196             $template->param( CAN_user_editcatalogue => 1 );
197         }
198
199         if ( $flags && $flags->{updatecharges} == 1 ) {
200             $template->param( CAN_user_updatecharge => 1 );
201         }
202
203         if ( $flags && $flags->{acquisition} == 1 ) {
204             $template->param( CAN_user_acquisition => 1 );
205         }
206
207         if ( $flags && $flags->{tools} == 1 ) {
208             $template->param( CAN_user_tools => 1 );
209         }
210         
211         if ( $flags && $flags->{editauthorities} == 1 ) {
212             $template->param( CAN_user_editauthorities => 1 );
213         }
214                 
215         if ( $flags && $flags->{serials} == 1 ) {
216             $template->param( CAN_user_serials => 1 );
217         }
218
219         if ( $flags && $flags->{reports} == 1 ) {
220             $template->param( CAN_user_reports => 1 );
221         }
222     }
223     if ( $in->{'type'} eq "intranet" ) {
224         $template->param(
225             intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
226             intranetstylesheet => C4::Context->preference("intranetstylesheet"),
227             IntranetNav        => C4::Context->preference("IntranetNav"),
228             intranetuserjs     => C4::Context->preference("intranetuserjs"),
229             TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
230             AmazonContent      => C4::Context->preference("AmazonContent"),
231             LibraryName        => C4::Context->preference("LibraryName"),
232             LoginBranchcode    => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
233             LoginBranchname    => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
234             AutoLocation       => C4::Context->preference("AutoLocation"),
235             hide_marc          => C4::Context->preference("hide_marc"),
236             patronimages       => C4::Context->preference("patronimages"),
237             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
238             advancedMARCEditor      => C4::Context->preference("advancedMARCEditor"),
239             suggestion              => C4::Context->preference("suggestion"),
240             virtualshelves          => C4::Context->preference("virtualshelves"),
241             LibraryName             => C4::Context->preference("LibraryName"),
242             KohaAdminEmailAddress   => "" . C4::Context->preference("KohaAdminEmailAddress"),
243         );
244     }
245     else {
246         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]"
247           unless ( $in->{'type'} eq 'opac' );
248         my $LibraryNameTitle = C4::Context->preference("LibraryName");
249         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
250         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
251         $template->param(
252             KohaAdminEmailAddress  => "" . C4::Context->preference("KohaAdminEmailAddress"),
253             suggestion             => "" . C4::Context->preference("suggestion"),
254             virtualshelves         => "" . C4::Context->preference("virtualshelves"),
255             OpacNav                => "" . C4::Context->preference("OpacNav"),
256             opacheader             => "" . C4::Context->preference("opacheader"),
257             opaccredits            => "" . C4::Context->preference("opaccredits"),
258             opacsmallimage         => "" . C4::Context->preference("opacsmallimage"),
259             opaclargeimage         => "" . C4::Context->preference("opaclargeimage"),
260             opaclayoutstylesheet   => "". C4::Context->preference("opaclayoutstylesheet"),
261             opaccolorstylesheet    => "". C4::Context->preference("opaccolorstylesheet"),
262             opaclanguagesdisplay   => "". C4::Context->preference("opaclanguagesdisplay"),
263             opacuserlogin          => "" . C4::Context->preference("opacuserlogin"),
264             opacbookbag            => "" . C4::Context->preference("opacbookbag"),
265             TemplateEncoding       => "". C4::Context->preference("TemplateEncoding"),
266             AmazonContent          => "" . C4::Context->preference("AmazonContent"),
267             LibraryName            => "" . C4::Context->preference("LibraryName"),
268             LibraryNameTitle       => "" . $LibraryNameTitle,
269             LoginBranchcode        => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
270             LoginBranchname        => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"", 
271             OpacPasswordChange     => C4::Context->preference("OpacPasswordChange"),
272             opacreadinghistory     => C4::Context->preference("opacreadinghistory"),
273             opacuserjs             => C4::Context->preference("opacuserjs"),
274             OpacCloud              => C4::Context->preference("OpacCloud"),
275             OpacTopissue           => C4::Context->preference("OpacTopissue"),
276             OpacAuthorities        => C4::Context->preference("OpacAuthorities"),
277             OpacBrowser            => C4::Context->preference("OpacBrowser"),
278             RequestOnOpac          => C4::Context->preference("RequestOnOpac"),
279             reviewson              => C4::Context->preference("reviewson"),
280             hide_marc              => C4::Context->preference("hide_marc"),
281             patronimages           => C4::Context->preference("patronimages"),
282             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
283         );
284     }
285     return ( $template, $borrowernumber, $cookie );
286 }
287
288 =item checkauth
289
290   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
291
292 Verifies that the user is authorized to run this script.  If
293 the user is authorized, a (userid, cookie, session-id, flags)
294 quadruple is returned.  If the user is not authorized but does
295 not have the required privilege (see $flagsrequired below), it
296 displays an error page and exits.  Otherwise, it displays the
297 login page and exits.
298
299 Note that C<&checkauth> will return if and only if the user
300 is authorized, so it should be called early on, before any
301 unfinished operations (e.g., if you've opened a file, then
302 C<&checkauth> won't close it for you).
303
304 C<$query> is the CGI object for the script calling C<&checkauth>.
305
306 The C<$noauth> argument is optional. If it is set, then no
307 authorization is required for the script.
308
309 C<&checkauth> fetches user and session information from C<$query> and
310 ensures that the user is authorized to run scripts that require
311 authorization.
312
313 The C<$flagsrequired> argument specifies the required privileges
314 the user must have if the username and password are correct.
315 It should be specified as a reference-to-hash; keys in the hash
316 should be the "flags" for the user, as specified in the Members
317 intranet module. Any key specified must correspond to a "flag"
318 in the userflags table. E.g., { circulate => 1 } would specify
319 that the user must have the "circulate" privilege in order to
320 proceed. To make sure that access control is correct, the
321 C<$flagsrequired> parameter must be specified correctly.
322
323 The C<$type> argument specifies whether the template should be
324 retrieved from the opac or intranet directory tree.  "opac" is
325 assumed if it is not specified; however, if C<$type> is specified,
326 "intranet" is assumed if it is not "opac".
327
328 If C<$query> does not have a valid session ID associated with it
329 (i.e., the user has not logged in) or if the session has expired,
330 C<&checkauth> presents the user with a login page (from the point of
331 view of the original script, C<&checkauth> does not return). Once the
332 user has authenticated, C<&checkauth> restarts the original script
333 (this time, C<&checkauth> returns).
334
335 The login page is provided using a HTML::Template, which is set in the
336 systempreferences table or at the top of this file. The variable C<$type>
337 selects which template to use, either the opac or the intranet 
338 authentification template.
339
340 C<&checkauth> returns a user ID, a cookie, and a session ID. The
341 cookie should be sent back to the browser; it verifies that the user
342 has authenticated.
343
344 =cut
345
346 sub checkauth {
347     my $query = shift;
348         # warn "Checking Auth";
349 # $authnotrequired will be set for scripts which will run without authentication
350     my $authnotrequired = shift;
351     my $flagsrequired   = shift;
352     my $type            = shift;
353     $type = 'opac' unless $type;
354
355     my $dbh     = C4::Context->dbh;
356     # check that database and koha version are the same
357     unless (C4::Context->preference('Version')){
358       if ($type ne 'opac'){
359         warn "Install required, redirecting to Installer";
360         print $query->redirect("/cgi-bin/koha/installer/install.pl");
361       } else {
362         warn "OPAC Install required, redirecting to maintenance";
363         print $query->redirect("/cgi-bin/koha/maintenance.pl");
364       }       
365       exit;
366     }
367     if (C4::Context->preference('Version') < C4::Context->config("kohaversion")){
368       if ($type ne 'opac'){
369       warn "Database update needed, redirecting to Installer. Database is ".C4::Context->preference('Version')." and Koha is : ".C4::Context->config("kohaversion");
370         print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
371       } else {
372       warn "OPAC :Database update needed, redirecting to maintenance. Database is ".C4::Context->preference('Version')." and Koha is : ".C4::Context->config("kohaversion");
373         print $query->redirect("/cgi-bin/koha/maintenance.pl");
374       }       
375       exit;
376     }
377     my $timeout = C4::Context->preference('timeout');
378     $timeout = 600 unless $timeout;
379
380     my $template_name;
381     if ( $type eq 'opac' ) {
382         $template_name = "opac-auth.tmpl";
383     }
384     else {
385         $template_name = "auth.tmpl";
386     }
387
388     # state variables
389     my $loggedin = 0;
390     my %info;
391     my ( $userid, $cookie, $sessionID, $flags );
392     my $logout = $query->param('logout.x');
393     if ( $userid = $ENV{'REMOTE_USER'} ) {
394
395         # Using Basic Authentication, no cookies required
396         $cookie = $query->cookie(
397             -name    => 'CGISESSID',
398             -value   => '',
399             -expires => ''
400         );
401         $loggedin = 1;
402     }
403     elsif ( $sessionID = $query->cookie("CGISESSID")) {
404                 my $session = new CGI::Session("driver:MySQL", $sessionID, {Handle=>$dbh});
405             
406         C4::Context->_new_userenv($sessionID);
407                 if ($session){
408                         C4::Context::set_userenv(
409                 $session->param('number'),       $session->param('id'),
410                 $session->param('cardnumber'),   $session->param('firstname'),
411                 $session->param('surname'),      $session->param('branch'),
412                 $session->param('branchname'),   $session->param('flags'),
413                 $session->param('emailaddress'), $session->param('branchprinter')
414             );
415         }
416         my $ip=$session->param('ip');
417         $userid = $session->param('id');
418                 my $lasttime = $session->param('lasttime');
419         if ($logout) {
420
421             # voluntary logout the user
422                         $session->delete;
423             C4::Context->_unset_userenv($sessionID);
424             $sessionID = undef;
425             $userid    = undef;
426             open L, ">>/tmp/sessionlog";
427             my $time = localtime( time() );
428             printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
429               $ip, $time;
430             close L;
431         }
432         if ($userid) {
433                         # warn "here $userid";
434             if ( $lasttime < time() - $timeout ) {
435
436                 # timed logout
437                 $info{'timed_out'} = 1;
438                                 $session->delete();
439                 C4::Context->_unset_userenv($sessionID);
440                 $userid    = undef;
441                 $sessionID = undef;
442                 open L, ">>/tmp/sessionlog";
443                 my $time = localtime( time() );
444                 printf L "%20s from %16s logged out at %30s (inactivity).\n",
445                   $userid, $ip, $time;
446                 close L;
447             }
448             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
449
450                 # Different ip than originally logged in from
451                 $info{'oldip'}        = $ip;
452                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
453                 $info{'different_ip'} = 1;
454                                 $session->delete();
455                 C4::Context->_unset_userenv($sessionID);
456                 $sessionID = undef;
457                 $userid    = undef;
458                 open L, ">>/tmp/sessionlog";
459                 my $time = localtime( time() );
460                 printf L
461 "%20s from logged out at %30s (ip changed from %16s to %16s).\n",
462                   $userid, $time, $ip, $info{'newip'};
463                 close L;
464             }
465             else {
466                 $cookie = $query->cookie(CGISESSID => $session->id
467                 );
468                                 $session->param('lasttime',time());
469                 $flags = haspermission( $dbh, $userid, $flagsrequired );
470                 if ($flags) {
471                     $loggedin = 1;
472                 }
473                 else {
474                     $info{'nopermission'} = 1;
475                 }
476             }
477         }
478     }
479     unless ($userid) {
480                 my $session = new CGI::Session("driver:MySQL", undef, {Handle=>$dbh});          
481                 my $sessionID = $session->id;
482         $userid    = $query->param('userid');
483         C4::Context->_new_userenv($sessionID);
484         my $password = $query->param('password');
485         C4::Context->_new_userenv($sessionID);
486         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
487         if ($return) {
488             open L, ">>/tmp/sessionlog";
489             my $time = localtime( time() );
490             printf L "%20s from %16s logged in  at %30s.\n", $userid,
491               $ENV{'REMOTE_ADDR'}, $time;
492             close L;
493             $cookie = $query->cookie(CGISESSID => $sessionID);
494             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
495                 $loggedin = 1;
496             }
497             else {
498                 $info{'nopermission'} = 1;
499                 C4::Context->_unset_userenv($sessionID);
500             }
501             if ( $return == 1 ) {
502                 my (
503                     $borrowernumber, $firstname,  $surname,
504                     $userflags,      $branchcode, $branchname,
505                     $branchprinter,  $emailaddress
506                 );
507                 my $sth =
508                   $dbh->prepare(
509 "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=?"
510                   );
511                 $sth->execute($userid);
512                 (
513                     $borrowernumber, $firstname,  $surname,
514                     $userflags,      $branchcode, $branchname,
515                     $branchprinter,  $emailaddress
516                   )
517                   = $sth->fetchrow
518                   if ( $sth->rows );
519
520 #                               warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
521                 unless ( $sth->rows ) {
522                     my $sth =
523                       $dbh->prepare(
524 "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=?"
525                       );
526                     $sth->execute($cardnumber);
527                     (
528                         $borrowernumber, $firstname,  $surname,
529                         $userflags,      $branchcode, $branchname,
530                         $branchprinter,  $emailaddress
531                       )
532                       = $sth->fetchrow
533                       if ( $sth->rows );
534
535 #                                       warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
536                     unless ( $sth->rows ) {
537                         $sth->execute($userid);
538                         (
539                             $borrowernumber, $firstname, $surname, $userflags,
540                             $branchcode, $branchname, $branchprinter, $emailaddress
541                           )
542                           = $sth->fetchrow
543                           if ( $sth->rows );
544                     }
545
546 #                                       warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
547                 }
548
549 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
550 #  new op dev :
551 # launch a sequence to check if we have a ip for the branch, if we have one we replace the branchcode of the userenv by the branch bound in the ip.
552                 my $ip       = $ENV{'REMOTE_ADDR'};
553                                 # if they specify at login, use that
554                                 if ($query->param('branch')) {
555                                 $branchcode  = $query->param('branch');
556                                 $branchname = GetBranchName($branchcode);
557                                 }
558                 my $branches = GetBranches();
559                 my @branchesloop;
560                 foreach my $br ( keys %$branches ) {
561                     #           now we work with the treatment of ip
562                     my $domain = $branches->{$br}->{'branchip'};
563                     if ( $domain && $ip =~ /^$domain/ ) {
564                         $branchcode = $branches->{$br}->{'branchcode'};
565
566                         # new op dev : add the branchprinter and branchname in the cookie
567                         $branchprinter = $branches->{$br}->{'branchprinter'};
568                         $branchname    = $branches->{$br}->{'branchname'};
569                     }
570                 }
571                                 
572                                 $session->param('number',$borrowernumber);
573                                 $session->param('id',$userid);
574                                 $session->param('cardnumber',$cardnumber);
575                                 $session->param('firstname',$firstname);
576                                 $session->param('surname',$surname);
577                                 $session->param('branch',$branchcode);
578                                 $session->param('branchname',$branchname);
579                                 $session->param('flags',$userflags);
580                                 $session->param('emailaddress',$emailaddress);
581                 $session->param('ip',$session->remote_addr());
582                                 $session->param('lasttime',time());
583             }
584             elsif ( $return == 2 ) {
585
586                 #We suppose the user is the superlibrarian
587                                 $session->param('number',0);
588                                 $session->param('id',C4::Context->config('user'));
589                                 $session->param('cardnumber',C4::Context->config('user'));
590                                 $session->param('firstname',C4::Context->config('user'));
591                                 $session->param('surname',C4::Context->config('user'),);
592                                 $session->param('branch','NO_LIBRARY_SET');
593                                 $session->param('branchname','NO_LIBRARY_SET');
594                                 $session->param('flags',1);
595                                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
596                 $session->param('ip',$session->remote_addr());
597                                 $session->param('lasttime',time());
598                         }
599                         if ($session){
600                 C4::Context::set_userenv(
601                 $session->param('number'),       $session->param('id'),
602                 $session->param('cardnumber'),   $session->param('firstname'),
603                 $session->param('surname'),      $session->param('branch'),
604                 $session->param('branchname'),   $session->param('flags'),
605                 $session->param('emailaddress'), $session->param('branchprinter')
606                 );
607                 }               
608         }
609
610         else {
611             if ($userid) {
612                 $info{'invalid_username_or_password'} = 1;
613                 C4::Context->_unset_userenv($sessionID);
614             }
615         }
616     }
617     my $insecure = C4::Context->boolean_preference('insecure');
618
619     # finished authentification, now respond
620     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
621     {
622         # successful login
623         unless ($cookie) {
624             $cookie = $query->cookie( CGISESSID => ''
625             );
626         }
627                 return ( $userid, $cookie, $sessionID, $flags );
628
629     }
630
631     # else we have a problem...
632     # get the inputs from the incoming query
633     my @inputs = ();
634     foreach my $name ( param $query) {
635         (next) if ( $name eq 'userid' || $name eq 'password' );
636         my $value = $query->param($name);
637         push @inputs, { name => $name, value => $value };
638     }
639     # get the branchloop, which we need for authetication
640     my $branches = GetBranches();
641     my @branch_loop;
642     for my $branch_hash (keys %$branches) {
643                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
644     }
645
646     my $template = gettemplate( $template_name, $type, $query );
647     $template->param(branchloop => \@branch_loop,);
648     $template->param(
649                 login                            => 1,
650         INPUTS               => \@inputs,
651         suggestion           => C4::Context->preference("suggestion"),
652         virtualshelves       => C4::Context->preference("virtualshelves"),
653         opaclargeimage       => C4::Context->preference("opaclargeimage"),
654         LibraryName          => C4::Context->preference("LibraryName"),
655         OpacNav              => C4::Context->preference("OpacNav"),
656         opaccredits          => C4::Context->preference("opaccredits"),
657         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
658         opacsmallimage       => C4::Context->preference("opacsmallimage"),
659         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
660         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
661         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
662         opacuserjs           => C4::Context->preference("opacuserjs"),
663
664         intranetcolorstylesheet =>
665           C4::Context->preference("intranetcolorstylesheet"),
666         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
667         IntranetNav        => C4::Context->preference("IntranetNav"),
668         intranetuserjs     => C4::Context->preference("intranetuserjs"),
669         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
670
671     );
672     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
673
674     my $self_url = $query->url( -absolute => 1 );
675     $template->param(
676         url         => $self_url,
677         LibraryName => => C4::Context->preference("LibraryName"),
678     );
679     $template->param( \%info );
680 #    $cookie = $query->cookie(CGISESSID => $session->id
681 #   );
682     print $query->header(
683         -type   => 'utf-8',
684         -cookie => $cookie
685       ),
686       $template->output;
687     exit;
688 }
689
690 sub checkpw {
691
692     my ( $dbh, $userid, $password ) = @_;
693
694     # INTERNAL AUTH
695     my $sth =
696       $dbh->prepare(
697 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
698       );
699     $sth->execute($userid);
700     if ( $sth->rows ) {
701         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
702             $surname, $branchcode, $flags )
703           = $sth->fetchrow;
704         if ( md5_base64($password) eq $md5password ) {
705
706             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
707                 $firstname, $surname, $branchcode, $flags );
708             return 1, $cardnumber;
709         }
710     }
711     $sth =
712       $dbh->prepare(
713 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
714       );
715     $sth->execute($userid);
716     if ( $sth->rows ) {
717         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
718             $surname, $branchcode, $flags )
719           = $sth->fetchrow;
720         if ( md5_base64($password) eq $md5password ) {
721
722             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
723                 $firstname, $surname, $branchcode, $flags );
724             return 1, $userid;
725         }
726     }
727     if (   $userid && $userid eq C4::Context->config('user')
728         && "$password" eq C4::Context->config('pass') )
729     {
730
731 # Koha superuser account
732 #               C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
733         return 2;
734     }
735     if (   $userid && $userid eq 'demo'
736         && "$password" eq 'demo'
737         && C4::Context->config('demo') )
738     {
739
740 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
741 # some features won't be effective : modify systempref, modify MARC structure,
742         return 2;
743     }
744     return 0;
745 }
746
747 sub getuserflags {
748     my $cardnumber = shift;
749     my $dbh        = shift;
750     my $userflags;
751     my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
752     $sth->execute($cardnumber);
753     my ($flags) = $sth->fetchrow;
754     $flags = 0 unless $flags;
755     $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
756     $sth->execute;
757
758     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
759         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
760             $userflags->{$flag} = 1;
761         }
762         else {
763             $userflags->{$flag} = 0;
764         }
765     }
766     return $userflags;
767 }
768
769 sub haspermission {
770     my ( $dbh, $userid, $flagsrequired ) = @_;
771     my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
772     $sth->execute($userid);
773     my ($cardnumber) = $sth->fetchrow;
774     ($cardnumber) || ( $cardnumber = $userid );
775     my $flags = getuserflags( $cardnumber, $dbh );
776     my $configfile;
777     if ( $userid eq C4::Context->config('user') ) {
778
779         # Super User Account from /etc/koha.conf
780         $flags->{'superlibrarian'} = 1;
781     }
782     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
783
784         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
785         $flags->{'superlibrarian'} = 1;
786     }
787     return $flags if $flags->{superlibrarian};
788     foreach ( keys %$flagsrequired ) {
789         return $flags if $flags->{$_};
790     }
791     return 0;
792 }
793
794 sub getborrowernumber {
795     my ($userid) = @_;
796     my $dbh = C4::Context->dbh;
797     for my $field ( 'userid', 'cardnumber' ) {
798         my $sth =
799           $dbh->prepare("select borrowernumber from borrowers where $field=?");
800         $sth->execute($userid);
801         if ( $sth->rows ) {
802             my ($bnumber) = $sth->fetchrow;
803             return $bnumber;
804         }
805     }
806     return 0;
807 }
808
809 END { }    # module clean-up code here (global destructor)
810 1;
811 __END__
812
813 =back
814
815 =head1 SEE ALSO
816
817 CGI(3)
818
819 C4::Output(3)
820
821 Digest::MD5(3)
822
823 =cut