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