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     my $timeout = C4::Context->preference('timeout');
 343     $timeout = 600 unless $timeout;
 344
 345     my $template_name;
 346     if ( $type eq 'opac' ) {
 347         $template_name = "opac-auth.tmpl";
 348     }
 349     else {
 350         $template_name = "auth.tmpl";
 351     }
 352
 353     # state variables
 354     my $loggedin = 0;
 355     my %info;
 356     my ( $userid, $cookie, $sessionID, $flags, $envcookie );
 357     my $logout = $query->param('logout.x');
 358     if ( $userid = $ENV{'REMOTE_USER'} ) {
 359
 360         # Using Basic Authentication, no cookies required
 361         $cookie = $query->cookie(
 362             -name    => 'sessionID',
 363             -value   => '',
 364             -expires => ''
 365         );
 366         $loggedin = 1;
 367     }
 368     elsif ( $sessionID = $query->cookie('sessionID') ) {
 369         C4::Context->_new_userenv($sessionID);
 370         if ( my %hash = $query->cookie('userenv') ) {
 371             C4::Context::set_userenv(
 372                 $hash{number},       $hash{id},
 373                 $hash{cardnumber},   $hash{firstname},
 374                 $hash{surname},      $hash{branch},
 375                 $hash{branchname},   $hash{flags},
 376                 $hash{emailaddress}, $hash{branchprinter}
 377             );
 378         }
 379         my ( $ip, $lasttime );
 380
 381         ( $userid, $ip, $lasttime ) =
 382           $dbh->selectrow_array(
 383             "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
 384             undef, $sessionID );
 385         if ($logout) {
 386
 387             # voluntary logout the user
 388             $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 389                 undef, $sessionID );
 390             C4::Context->_unset_userenv($sessionID);
 391             $sessionID = undef;
 392             $userid    = undef;
 393             open L, ">>/tmp/sessionlog";
 394             my $time = localtime( time() );
 395             printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
 396               $ip, $time;
 397             close L;
 398         }
 399         if ($userid) {
 400             if ( $lasttime < time() - $timeout ) {
 401
 402                 # timed logout
 403                 $info{'timed_out'} = 1;
 404                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 405                     undef, $sessionID );
 406                 C4::Context->_unset_userenv($sessionID);
 407                 $userid    = undef;
 408                 $sessionID = undef;
 409                 open L, ">>/tmp/sessionlog";
 410                 my $time = localtime( time() );
 411                 printf L "%20s from %16s logged out at %30s (inactivity).\n",
 412                   $userid, $ip, $time;
 413                 close L;
 414             }
 415             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 416
 417                 # Different ip than originally logged in from
 418                 $info{'oldip'}        = $ip;
 419                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 420                 $info{'different_ip'} = 1;
 421                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 422                     undef, $sessionID );
 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
 429 "%20s from logged out at %30s (ip changed from %16s to %16s).\n",
 430                   $userid, $time, $ip, $info{'newip'};
 431                 close L;
 432             }
 433             else {
 434                 $cookie = $query->cookie(
 435                     -name    => 'sessionID',
 436                     -value   => $sessionID,
 437                     -expires => ''
 438                 );
 439                 $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?",
 440                     undef, ( time(), $sessionID ) );
 441                 $flags = haspermission( $dbh, $userid, $flagsrequired );
 442                 if ($flags) {
 443                     $loggedin = 1;
 444                 }
 445                 else {
 446                     $info{'nopermission'} = 1;
 447                 }
 448             }
 449         }
 450     }
 451     unless ($userid) {
 452         $sessionID = int( rand() * 100000 ) . '-' . time();
 453         $userid    = $query->param('userid');
 454         C4::Context->_new_userenv($sessionID);
 455         my $password = $query->param('password');
 456         C4::Context->_new_userenv($sessionID);
 457         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 458         if ($return) {
 459             $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?",
 460                 undef, ( $sessionID, $userid ) );
 461             $dbh->do(
 462 "INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
 463                 undef,
 464                 ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() )
 465             );
 466             open L, ">>/tmp/sessionlog";
 467             my $time = localtime( time() );
 468             printf L "%20s from %16s logged in  at %30s.\n", $userid,
 469               $ENV{'REMOTE_ADDR'}, $time;
 470             close L;
 471             $cookie = $query->cookie(
 472                 -name    => 'sessionID',
 473                 -value   => $sessionID,
 474                 -expires => ''
 475             );
 476             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 477                 $loggedin = 1;
 478             }
 479             else {
 480                 $info{'nopermission'} = 1;
 481                 C4::Context->_unset_userenv($sessionID);
 482             }
 483             if ( $return == 1 ) {
 484                 my (
 485                     $borrowernumber, $firstname,  $surname,
 486                     $userflags,      $branchcode, $branchname,
 487                     $branchprinter,  $emailaddress
 488                 );
 489                 my $sth =
 490                   $dbh->prepare(
 491 "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=?"
 492                   );
 493                 $sth->execute($userid);
 494                 (
 495                     $borrowernumber, $firstname,  $surname,
 496                     $userflags,      $branchcode, $branchname,
 497                     $branchprinter,  $emailaddress
 498                   )
 499                   = $sth->fetchrow
 500                   if ( $sth->rows );
 501
 502 #                               warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 503                 unless ( $sth->rows ) {
 504                     my $sth =
 505                       $dbh->prepare(
 506 "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=?"
 507                       );
 508                     $sth->execute($cardnumber);
 509                     (
 510                         $borrowernumber, $firstname,  $surname,
 511                         $userflags,      $branchcode, $branchname,
 512                         $branchprinter,  $emailaddress
 513                       )
 514                       = $sth->fetchrow
 515                       if ( $sth->rows );
 516
 517 #                                       warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 518                     unless ( $sth->rows ) {
 519                         $sth->execute($userid);
 520                         (
 521                             $borrowernumber, $firstname, $surname, $userflags,
 522                             $branchcode, $branchname, $branchprinter, $emailaddress
 523                           )
 524                           = $sth->fetchrow
 525                           if ( $sth->rows );
 526                     }
 527
 528 #                                       warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 529                 }
 530
 531 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 532 #  new op dev :
 533 # 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.
 534                 my $ip       = $ENV{'REMOTE_ADDR'};
 535                 my $branches = GetBranches();
 536                 my @branchesloop;
 537                 foreach my $br ( keys %$branches ) {
 538
 539                     #           now we work with the treatment of ip
 540                     my $domain = $branches->{$br}->{'branchip'};
 541                     if ( $domain && $ip =~ /^$domain/ ) {
 542                         $branchcode = $branches->{$br}->{'branchcode'};
 543
 544                         # new op dev : add the branchprinter and branchname in the cookie
 545                         $branchprinter = $branches->{$br}->{'branchprinter'};
 546                         $branchname    = $branches->{$br}->{'branchname'};
 547                     }
 548                 }
 549                 my $hash = C4::Context::set_userenv(
 550                     $borrowernumber, $userid,    $cardnumber,
 551                     $firstname,      $surname,   $branchcode,
 552                     $branchname,     $userflags, $emailaddress,
 553                     $branchprinter,
 554                 );
 555
 556                 $envcookie = $query->cookie(
 557                     -name    => 'userenv',
 558                     -value   => $hash,
 559                     -expires => ''
 560                 );
 561             }
 562             elsif ( $return == 2 ) {
 563
 564                 #We suppose the user is the superlibrarian
 565                 my $hash = C4::Context::set_userenv(
 566                     0,
 567                     0,
 568                     C4::Context->config('user'),
 569                     C4::Context->config('user'),
 570                     C4::Context->config('user'),
 571                     "",
 572                     "SUPER",
 573                     1,
 574                     C4::Context->preference('KohaAdminEmailAddress')
 575                 );
 576                 $envcookie = $query->cookie(
 577                     -name    => 'userenv',
 578                     -value   => $hash,
 579                     -expires => ''
 580                 );
 581             }
 582         }
 583         else {
 584             if ($userid) {
 585                 $info{'invalid_username_or_password'} = 1;
 586                 C4::Context->_unset_userenv($sessionID);
 587             }
 588         }
 589     }
 590     my $insecure = C4::Context->boolean_preference('insecure');
 591
 592     # finished authentification, now respond
 593     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 594     {
 595
 596         # successful login
 597         unless ($cookie) {
 598             $cookie = $query->cookie(
 599                 -name    => 'sessionID',
 600                 -value   => '',
 601                 -expires => ''
 602             );
 603         }
 604         if ($envcookie) {
 605             return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags );
 606         }
 607         else {
 608             return ( $userid, $cookie, $sessionID, $flags );
 609         }
 610     }
 611
 612     # else we have a problem...
 613     # get the inputs from the incoming query
 614     my @inputs = ();
 615     foreach my $name ( param $query) {
 616         (next) if ( $name eq 'userid' || $name eq 'password' );
 617         my $value = $query->param($name);
 618         push @inputs, { name => $name, value => $value };
 619     }
 620
 621     my $template = gettemplate( $template_name, $type, $query );
 622     $template->param(
 623         INPUTS               => \@inputs,
 624         suggestion           => C4::Context->preference("suggestion"),
 625         virtualshelves       => C4::Context->preference("virtualshelves"),
 626         opaclargeimage       => C4::Context->preference("opaclargeimage"),
 627         LibraryName          => C4::Context->preference("LibraryName"),
 628         OpacNav              => C4::Context->preference("OpacNav"),
 629         opaccredits          => C4::Context->preference("opaccredits"),
 630         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 631         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 632         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 633         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 634         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 635         opacuserjs           => C4::Context->preference("opacuserjs"),
 636
 637         intranetcolorstylesheet =>
 638           C4::Context->preference("intranetcolorstylesheet"),
 639         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 640         IntranetNav        => C4::Context->preference("IntranetNav"),
 641         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 642         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 643
 644     );
 645     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 646
 647     my $self_url = $query->url( -absolute => 1 );
 648     $template->param(
 649         url         => $self_url,
 650         LibraryName => => C4::Context->preference("LibraryName"),
 651     );
 652     $template->param( \%info );
 653     $cookie = $query->cookie(
 654         -name    => 'sessionID',
 655         -value   => $sessionID,
 656         -expires => ''
 657     );
 658     print $query->header(
 659         -type   => guesstype( $template->output ),
 660         -cookie => $cookie
 661       ),
 662       $template->output;
 663     exit;
 664 }
 665
 666 sub checkpw {
 667
 668     my ( $dbh, $userid, $password ) = @_;
 669
 670     # INTERNAL AUTH
 671     my $sth =
 672       $dbh->prepare(
 673 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
 674       );
 675     $sth->execute($userid);
 676     if ( $sth->rows ) {
 677         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
 678             $surname, $branchcode, $flags )
 679           = $sth->fetchrow;
 680         if ( md5_base64($password) eq $md5password ) {
 681
 682             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
 683                 $firstname, $surname, $branchcode, $flags );
 684             return 1, $cardnumber;
 685         }
 686     }
 687     $sth =
 688       $dbh->prepare(
 689 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
 690       );
 691     $sth->execute($userid);
 692     if ( $sth->rows ) {
 693         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
 694             $surname, $branchcode, $flags )
 695           = $sth->fetchrow;
 696         if ( md5_base64($password) eq $md5password ) {
 697
 698             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
 699                 $firstname, $surname, $branchcode, $flags );
 700             return 1, $userid;
 701         }
 702     }
 703     if (   $userid && $userid eq C4::Context->config('user')
 704         && "$password" eq C4::Context->config('pass') )
 705     {
 706
 707 # Koha superuser account
 708 #               C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
 709         return 2;
 710     }
 711     if (   $userid && $userid eq 'demo'
 712         && "$password" eq 'demo'
 713         && C4::Context->config('demo') )
 714     {
 715
 716 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
 717 # some features won't be effective : modify systempref, modify MARC structure,
 718         return 2;
 719     }
 720     return 0;
 721 }
 722
 723 sub getuserflags {
 724     my $cardnumber = shift;
 725     my $dbh        = shift;
 726     my $userflags;
 727     my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
 728     $sth->execute($cardnumber);
 729     my ($flags) = $sth->fetchrow;
 730     $flags = 0 unless $flags;
 731     $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
 732     $sth->execute;
 733
 734     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
 735         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
 736             $userflags->{$flag} = 1;
 737         }
 738         else {
 739             $userflags->{$flag} = 0;
 740         }
 741     }
 742     return $userflags;
 743 }
 744
 745 sub haspermission {
 746     my ( $dbh, $userid, $flagsrequired ) = @_;
 747     my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
 748     $sth->execute($userid);
 749     my ($cardnumber) = $sth->fetchrow;
 750     ($cardnumber) || ( $cardnumber = $userid );
 751     my $flags = getuserflags( $cardnumber, $dbh );
 752     my $configfile;
 753     if ( $userid eq C4::Context->config('user') ) {
 754
 755         # Super User Account from /etc/koha.conf
 756         $flags->{'superlibrarian'} = 1;
 757     }
 758     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
 759
 760         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
 761         $flags->{'superlibrarian'} = 1;
 762     }
 763     return $flags if $flags->{superlibrarian};
 764     foreach ( keys %$flagsrequired ) {
 765         return $flags if $flags->{$_};
 766     }
 767     return 0;
 768 }
 769
 770 sub getborrowernumber {
 771     my ($userid) = @_;
 772     my $dbh = C4::Context->dbh;
 773     for my $field ( 'userid', 'cardnumber' ) {
 774         my $sth =
 775           $dbh->prepare("select borrowernumber from borrowers where $field=?");
 776         $sth->execute($userid);
 777         if ( $sth->rows ) {
 778             my ($bnumber) = $sth->fetchrow;
 779             return $bnumber;
 780         }
 781     }
 782     return 0;
 783 }
 784
 785 END { }    # module clean-up code here (global destructor)
 786 1;
 787 __END__
 788
 789 =back
 790
 791 =head1 SEE ALSO
 792
 793 CGI(3)
 794
 795 C4::Output(3)
 796
 797 Digest::MD5(3)
 798
 799 =cut