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