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