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::Members;
  30 use C4::Koha;
  31 use C4::Branch; # GetBranches
  32
  33 # use Net::LDAP;
  34 # use Net::LDAP qw(:all);
  35
  36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  37
  38 # set the version for version checking
  39 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  40     shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
  41 };
  42
  43 =head1 NAME
  44
  45 C4::Auth - Authenticates Koha users
  46
  47 =head1 SYNOPSIS
  48
  49   use CGI;
  50   use C4::Auth;
  51
  52   my $query = new CGI;
  53
  54   my ($template, $borrowernumber, $cookie)
  55     = get_template_and_user({template_name   => "opac-main.tmpl",
  56                              query           => $query,
  57                              type            => "opac",
  58                              authnotrequired => 1,
  59                              flagsrequired   => {borrow => 1},
  60                           });
  61
  62   print $query->header(
  63     -type => 'utf-8',
  64     -cookie => $cookie
  65   ), $template->output;
  66
  67
  68 =head1 DESCRIPTION
  69
  70     The main function of this module is to provide
  71     authentification. However the get_template_and_user function has
  72     been provided so that a users login information is passed along
  73     automatically. This gets loaded into the template.
  74
  75 =head1 FUNCTIONS
  76
  77 =over 2
  78
  79 =cut
  80
  81 @ISA    = qw(Exporter);
  82 @EXPORT = qw(
  83   &checkauth
  84   &get_template_and_user
  85 );
  86
  87 =item get_template_and_user
  88
  89   my ($template, $borrowernumber, $cookie)
  90     = get_template_and_user({template_name   => "opac-main.tmpl",
  91                              query           => $query,
  92                              type            => "opac",
  93                              authnotrequired => 1,
  94                              flagsrequired   => {borrow => 1},
  95                           });
  96
  97     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
  98     to C<&checkauth> (in this module) to perform authentification.
  99     See C<&checkauth> for an explanation of these parameters.
 100
 101     The C<template_name> is then used to find the correct template for
 102     the page. The authenticated users details are loaded onto the
 103     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 104     C<sessionID> is passed to the template. This can be used in templates
 105     if cookies are disabled. It needs to be put as and input to every
 106     authenticated page.
 107
 108     More information on the C<gettemplate> sub can be found in the
 109     Output.pm module.
 110
 111 =cut
 112
 113 sub get_template_and_user {
 114     my $in       = shift;
 115     my $template =
 116       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 117     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
 118         $in->{'query'},
 119         $in->{'authnotrequired'},
 120         $in->{'flagsrequired'},
 121         $in->{'type'}
 122     );
 123
 124     my $borrowernumber;
 125     my $insecure = C4::Context->preference('insecure');
 126     if ($user or $insecure) {
 127         $template->param( loggedinusername => $user );
 128         $template->param( sessionID        => $sessionID );
 129
 130         $borrowernumber = getborrowernumber($user);
 131         my ( $borr, $alternativeflags ) =
 132           GetMemberDetails( $borrowernumber );
 133         my @bordat;
 134         $bordat[0] = $borr;
 135         $template->param( "USER_INFO" => \@bordat );
 136
 137         # We are going to use the $flags returned by checkauth
 138         # to create the template's parameters that will indicate
 139         # which menus the user can access.
 140         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
 141             $template->param( CAN_user_circulate        => 1 );
 142             $template->param( CAN_user_catalogue        => 1 );
 143             $template->param( CAN_user_parameters       => 1 );
 144             $template->param( CAN_user_borrowers        => 1 );
 145             $template->param( CAN_user_permission       => 1 );
 146             $template->param( CAN_user_reserveforothers => 1 );
 147             $template->param( CAN_user_borrow           => 1 );
 148             $template->param( CAN_user_editcatalogue    => 1 );
 149             $template->param( CAN_user_updatecharge     => 1 );
 150             $template->param( CAN_user_acquisition      => 1 );
 151             $template->param( CAN_user_management       => 1 );
 152             $template->param( CAN_user_tools            => 1 );
 153             $template->param( CAN_user_editauthorities  => 1 );
 154             $template->param( CAN_user_serials          => 1 );
 155             $template->param( CAN_user_reports          => 1 );
 156         }
 157
 158         if ( $flags && $flags->{circulate} == 1 ) {
 159             $template->param( CAN_user_circulate => 1 );
 160         }
 161
 162         if ( $flags && $flags->{catalogue} == 1 ) {
 163             $template->param( CAN_user_catalogue => 1 );
 164         }
 165
 166         if ( $flags && $flags->{parameters} == 1 ) {
 167             $template->param( CAN_user_parameters => 1 );
 168             $template->param( CAN_user_management => 1 );
 169         }
 170
 171         if ( $flags && $flags->{borrowers} == 1 ) {
 172             $template->param( CAN_user_borrowers => 1 );
 173         }
 174
 175         if ( $flags && $flags->{permissions} == 1 ) {
 176             $template->param( CAN_user_permission => 1 );
 177         }
 178
 179         if ( $flags && $flags->{reserveforothers} == 1 ) {
 180             $template->param( CAN_user_reserveforothers => 1 );
 181         }
 182
 183         if ( $flags && $flags->{borrow} == 1 ) {
 184             $template->param( CAN_user_borrow => 1 );
 185         }
 186
 187         if ( $flags && $flags->{editcatalogue} == 1 ) {
 188             $template->param( CAN_user_editcatalogue => 1 );
 189         }
 190
 191         if ( $flags && $flags->{updatecharges} == 1 ) {
 192             $template->param( CAN_user_updatecharge => 1 );
 193         }
 194
 195         if ( $flags && $flags->{acquisition} == 1 ) {
 196             $template->param( CAN_user_acquisition => 1 );
 197         }
 198
 199         if ( $flags && $flags->{tools} == 1 ) {
 200             $template->param( CAN_user_tools => 1 );
 201         }
 202
 203         if ( $flags && $flags->{editauthorities} == 1 ) {
 204             $template->param( CAN_user_editauthorities => 1 );
 205         }
 206
 207         if ( $flags && $flags->{serials} == 1 ) {
 208             $template->param( CAN_user_serials => 1 );
 209         }
 210
 211         if ( $flags && $flags->{reports} == 1 ) {
 212             $template->param( CAN_user_reports => 1 );
 213         }
 214     }
 215     if ( $in->{'type'} eq "intranet" ) {
 216         $template->param(
 217             intranetcolorstylesheet =>
 218               C4::Context->preference("intranetcolorstylesheet"),
 219             intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 220             IntranetNav        => C4::Context->preference("IntranetNav"),
 221             intranetuserjs     => C4::Context->preference("intranetuserjs"),
 222             TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 223             AmazonContent      => C4::Context->preference("AmazonContent"),
 224             LibraryName        => C4::Context->preference("LibraryName"),
 225             LoginBranchname    => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
 226             AutoLocation       => C4::Context->preference("AutoLocation"),
 227             hide_marc          => C4::Context->preference("hide_marc"),
 228             patronimages       => C4::Context->preference("patronimages"),
 229             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 230         );
 231     }
 232     else {
 233         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]"
 234           unless ( $in->{'type'} eq 'opac' );
 235         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 236         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 237         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 238         $template->param(
 239             suggestion     => "" . C4::Context->preference("suggestion"),
 240             virtualshelves => "" . C4::Context->preference("virtualshelves"),
 241             OpacNav        => "" . C4::Context->preference("OpacNav"),
 242             opacheader     => "" . C4::Context->preference("opacheader"),
 243             opaccredits    => "" . C4::Context->preference("opaccredits"),
 244             opacsmallimage => "" . C4::Context->preference("opacsmallimage"),
 245             opaclargeimage => "" . C4::Context->preference("opaclargeimage"),
 246             opaclayoutstylesheet => "". C4::Context->preference("opaclayoutstylesheet"),
 247             opaccolorstylesheet => "". C4::Context->preference("opaccolorstylesheet"),
 248             opaclanguagesdisplay => "". C4::Context->preference("opaclanguagesdisplay"),
 249             opacuserlogin    => "" . C4::Context->preference("opacuserlogin"),
 250             opacbookbag      => "" . C4::Context->preference("opacbookbag"),
 251             TemplateEncoding => "". C4::Context->preference("TemplateEncoding"),
 252             AmazonContent => "" . C4::Context->preference("AmazonContent"),
 253             LibraryName   => "" . C4::Context->preference("LibraryName"),
 254             LibraryNameTitle   => "" . $LibraryNameTitle,
 255             LoginBranchname    => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 256             OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
 257             opacreadinghistory => C4::Context->preference("opacreadinghistory"),
 258             opacuserjs         => C4::Context->preference("opacuserjs"),
 259             OpacCloud          => C4::Context->preference("OpacCloud"),
 260             OpacTopissue       => C4::Context->preference("OpacTopissue"),
 261             OpacAuthorities    => C4::Context->preference("OpacAuthorities"),
 262             OpacBrowser        => C4::Context->preference("OpacBrowser"),
 263             RequestOnOpac      => C4::Context->preference("RequestOnOpac"),
 264             reviewson          => C4::Context->preference("reviewson"),
 265             hide_marc          => C4::Context->preference("hide_marc"),
 266             patronimages       => C4::Context->preference("patronimages"),
 267             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 268         );
 269     }
 270     return ( $template, $borrowernumber, $cookie );
 271 }
 272
 273 =item checkauth
 274
 275   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 276
 277 Verifies that the user is authorized to run this script.  If
 278 the user is authorized, a (userid, cookie, session-id, flags)
 279 quadruple is returned.  If the user is not authorized but does
 280 not have the required privilege (see $flagsrequired below), it
 281 displays an error page and exits.  Otherwise, it displays the
 282 login page and exits.
 283
 284 Note that C<&checkauth> will return if and only if the user
 285 is authorized, so it should be called early on, before any
 286 unfinished operations (e.g., if you've opened a file, then
 287 C<&checkauth> won't close it for you).
 288
 289 C<$query> is the CGI object for the script calling C<&checkauth>.
 290
 291 The C<$noauth> argument is optional. If it is set, then no
 292 authorization is required for the script.
 293
 294 C<&checkauth> fetches user and session information from C<$query> and
 295 ensures that the user is authorized to run scripts that require
 296 authorization.
 297
 298 The C<$flagsrequired> argument specifies the required privileges
 299 the user must have if the username and password are correct.
 300 It should be specified as a reference-to-hash; keys in the hash
 301 should be the "flags" for the user, as specified in the Members
 302 intranet module. Any key specified must correspond to a "flag"
 303 in the userflags table. E.g., { circulate => 1 } would specify
 304 that the user must have the "circulate" privilege in order to
 305 proceed. To make sure that access control is correct, the
 306 C<$flagsrequired> parameter must be specified correctly.
 307
 308 The C<$type> argument specifies whether the template should be
 309 retrieved from the opac or intranet directory tree.  "opac" is
 310 assumed if it is not specified; however, if C<$type> is specified,
 311 "intranet" is assumed if it is not "opac".
 312
 313 If C<$query> does not have a valid session ID associated with it
 314 (i.e., the user has not logged in) or if the session has expired,
 315 C<&checkauth> presents the user with a login page (from the point of
 316 view of the original script, C<&checkauth> does not return). Once the
 317 user has authenticated, C<&checkauth> restarts the original script
 318 (this time, C<&checkauth> returns).
 319
 320 The login page is provided using a HTML::Template, which is set in the
 321 systempreferences table or at the top of this file. The variable C<$type>
 322 selects which template to use, either the opac or the intranet
 323 authentification template.
 324
 325 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 326 cookie should be sent back to the browser; it verifies that the user
 327 has authenticated.
 328
 329 =cut
 330
 331 sub checkauth {
 332     my $query = shift;
 333
 334 # $authnotrequired will be set for scripts which will run without authentication
 335     my $authnotrequired = shift;
 336     my $flagsrequired   = shift;
 337     my $type            = shift;
 338     $type = 'opac' unless $type;
 339
 340     my $dbh     = C4::Context->dbh;
 341     unless (C4::Context->preference('Version')){
 342       warn "No Version string in sysprefs, redirecting to Installer";
 343       print $query->redirect("/cgi-bin/koha/installer/install.pl");
 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   => 'utf-8',
 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