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             advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
 231             suggestion => C4::Context->preference("suggestion"),
 232             virtualshelves => C4::Context->preference("virtualshelves"),
 233             LibraryName => C4::Context->preference("LibraryName"),
 234         );
 235     }
 236     else {
 237         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]"
 238           unless ( $in->{'type'} eq 'opac' );
 239         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 240         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 241         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 242         $template->param(
 243             suggestion     => "" . C4::Context->preference("suggestion"),
 244             virtualshelves => "" . C4::Context->preference("virtualshelves"),
 245             OpacNav        => "" . C4::Context->preference("OpacNav"),
 246             opacheader     => "" . C4::Context->preference("opacheader"),
 247             opaccredits    => "" . C4::Context->preference("opaccredits"),
 248             opacsmallimage => "" . C4::Context->preference("opacsmallimage"),
 249             opaclargeimage => "" . C4::Context->preference("opaclargeimage"),
 250             opaclayoutstylesheet => "". C4::Context->preference("opaclayoutstylesheet"),
 251             opaccolorstylesheet => "". C4::Context->preference("opaccolorstylesheet"),
 252             opaclanguagesdisplay => "". C4::Context->preference("opaclanguagesdisplay"),
 253             opacuserlogin    => "" . C4::Context->preference("opacuserlogin"),
 254             opacbookbag      => "" . C4::Context->preference("opacbookbag"),
 255             TemplateEncoding => "". C4::Context->preference("TemplateEncoding"),
 256             AmazonContent => "" . C4::Context->preference("AmazonContent"),
 257             LibraryName   => "" . C4::Context->preference("LibraryName"),
 258             LibraryNameTitle   => "" . $LibraryNameTitle,
 259             LoginBranchname    => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 260             OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
 261             opacreadinghistory => C4::Context->preference("opacreadinghistory"),
 262             opacuserjs         => C4::Context->preference("opacuserjs"),
 263             OpacCloud          => C4::Context->preference("OpacCloud"),
 264             OpacTopissue       => C4::Context->preference("OpacTopissue"),
 265             OpacAuthorities    => C4::Context->preference("OpacAuthorities"),
 266             OpacBrowser        => C4::Context->preference("OpacBrowser"),
 267             RequestOnOpac      => C4::Context->preference("RequestOnOpac"),
 268             reviewson          => C4::Context->preference("reviewson"),
 269             hide_marc          => C4::Context->preference("hide_marc"),
 270             patronimages       => C4::Context->preference("patronimages"),
 271             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 272         );
 273     }
 274     return ( $template, $borrowernumber, $cookie );
 275 }
 276
 277 =item checkauth
 278
 279   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 280
 281 Verifies that the user is authorized to run this script.  If
 282 the user is authorized, a (userid, cookie, session-id, flags)
 283 quadruple is returned.  If the user is not authorized but does
 284 not have the required privilege (see $flagsrequired below), it
 285 displays an error page and exits.  Otherwise, it displays the
 286 login page and exits.
 287
 288 Note that C<&checkauth> will return if and only if the user
 289 is authorized, so it should be called early on, before any
 290 unfinished operations (e.g., if you've opened a file, then
 291 C<&checkauth> won't close it for you).
 292
 293 C<$query> is the CGI object for the script calling C<&checkauth>.
 294
 295 The C<$noauth> argument is optional. If it is set, then no
 296 authorization is required for the script.
 297
 298 C<&checkauth> fetches user and session information from C<$query> and
 299 ensures that the user is authorized to run scripts that require
 300 authorization.
 301
 302 The C<$flagsrequired> argument specifies the required privileges
 303 the user must have if the username and password are correct.
 304 It should be specified as a reference-to-hash; keys in the hash
 305 should be the "flags" for the user, as specified in the Members
 306 intranet module. Any key specified must correspond to a "flag"
 307 in the userflags table. E.g., { circulate => 1 } would specify
 308 that the user must have the "circulate" privilege in order to
 309 proceed. To make sure that access control is correct, the
 310 C<$flagsrequired> parameter must be specified correctly.
 311
 312 The C<$type> argument specifies whether the template should be
 313 retrieved from the opac or intranet directory tree.  "opac" is
 314 assumed if it is not specified; however, if C<$type> is specified,
 315 "intranet" is assumed if it is not "opac".
 316
 317 If C<$query> does not have a valid session ID associated with it
 318 (i.e., the user has not logged in) or if the session has expired,
 319 C<&checkauth> presents the user with a login page (from the point of
 320 view of the original script, C<&checkauth> does not return). Once the
 321 user has authenticated, C<&checkauth> restarts the original script
 322 (this time, C<&checkauth> returns).
 323
 324 The login page is provided using a HTML::Template, which is set in the
 325 systempreferences table or at the top of this file. The variable C<$type>
 326 selects which template to use, either the opac or the intranet
 327 authentification template.
 328
 329 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 330 cookie should be sent back to the browser; it verifies that the user
 331 has authenticated.
 332
 333 =cut
 334
 335 sub checkauth {
 336     my $query = shift;
 337
 338 # $authnotrequired will be set for scripts which will run without authentication
 339     my $authnotrequired = shift;
 340     my $flagsrequired   = shift;
 341     my $type            = shift;
 342     $type = 'opac' unless $type;
 343
 344     my $dbh     = C4::Context->dbh;
 345     # check that database and koha version are the same
 346     unless (C4::Context->preference('Version')){
 347       warn "Install required, redirecting to Installer";
 348       print $query->redirect("/cgi-bin/koha/installer/install.pl");
 349       exit;
 350     }
 351     if (C4::Context->preference('Version') < C4::Context->config("kohaversion")){
 352       warn "Database update needed, redirecting to Installer. Database is ".C4::Context->preference('Version')." and Koha is : ".C4::Context->config("kohaversion");
 353       print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 354       exit;
 355     }
 356     my $timeout = C4::Context->preference('timeout');
 357     $timeout = 600 unless $timeout;
 358
 359     my $template_name;
 360     if ( $type eq 'opac' ) {
 361         $template_name = "opac-auth.tmpl";
 362     }
 363     else {
 364         $template_name = "auth.tmpl";
 365     }
 366
 367     # state variables
 368     my $loggedin = 0;
 369     my %info;
 370     my ( $userid, $cookie, $sessionID, $flags, $envcookie );
 371     my $logout = $query->param('logout.x');
 372     if ( $userid = $ENV{'REMOTE_USER'} ) {
 373
 374         # Using Basic Authentication, no cookies required
 375         $cookie = $query->cookie(
 376             -name    => 'sessionID',
 377             -value   => '',
 378             -expires => ''
 379         );
 380         $loggedin = 1;
 381     }
 382     elsif ( $sessionID = $query->cookie('sessionID') ) {
 383         C4::Context->_new_userenv($sessionID);
 384         if ( my %hash = $query->cookie('userenv') ) {
 385             C4::Context::set_userenv(
 386                 $hash{number},       $hash{id},
 387                 $hash{cardnumber},   $hash{firstname},
 388                 $hash{surname},      $hash{branch},
 389                 $hash{branchname},   $hash{flags},
 390                 $hash{emailaddress}, $hash{branchprinter}
 391             );
 392         }
 393         my ( $ip, $lasttime );
 394
 395         ( $userid, $ip, $lasttime ) =
 396           $dbh->selectrow_array(
 397             "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
 398             undef, $sessionID );
 399         if ($logout) {
 400
 401             # voluntary logout the user
 402             $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 403                 undef, $sessionID );
 404             C4::Context->_unset_userenv($sessionID);
 405             $sessionID = undef;
 406             $userid    = undef;
 407             open L, ">>/tmp/sessionlog";
 408             my $time = localtime( time() );
 409             printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
 410               $ip, $time;
 411             close L;
 412         }
 413         if ($userid) {
 414             if ( $lasttime < time() - $timeout ) {
 415
 416                 # timed logout
 417                 $info{'timed_out'} = 1;
 418                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 419                     undef, $sessionID );
 420                 C4::Context->_unset_userenv($sessionID);
 421                 $userid    = undef;
 422                 $sessionID = undef;
 423                 open L, ">>/tmp/sessionlog";
 424                 my $time = localtime( time() );
 425                 printf L "%20s from %16s logged out at %30s (inactivity).\n",
 426                   $userid, $ip, $time;
 427                 close L;
 428             }
 429             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 430
 431                 # Different ip than originally logged in from
 432                 $info{'oldip'}        = $ip;
 433                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 434                 $info{'different_ip'} = 1;
 435                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 436                     undef, $sessionID );
 437                 C4::Context->_unset_userenv($sessionID);
 438                 $sessionID = undef;
 439                 $userid    = undef;
 440                 open L, ">>/tmp/sessionlog";
 441                 my $time = localtime( time() );
 442                 printf L
 443 "%20s from logged out at %30s (ip changed from %16s to %16s).\n",
 444                   $userid, $time, $ip, $info{'newip'};
 445                 close L;
 446             }
 447             else {
 448                 $cookie = $query->cookie(
 449                     -name    => 'sessionID',
 450                     -value   => $sessionID,
 451                     -expires => ''
 452                 );
 453                 $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?",
 454                     undef, ( time(), $sessionID ) );
 455                 $flags = haspermission( $dbh, $userid, $flagsrequired );
 456                 if ($flags) {
 457                     $loggedin = 1;
 458                 }
 459                 else {
 460                     $info{'nopermission'} = 1;
 461                 }
 462             }
 463         }
 464     }
 465     unless ($userid) {
 466         $sessionID = int( rand() * 100000 ) . '-' . time();
 467         $userid    = $query->param('userid');
 468         C4::Context->_new_userenv($sessionID);
 469         my $password = $query->param('password');
 470         C4::Context->_new_userenv($sessionID);
 471         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 472         if ($return) {
 473             $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?",
 474                 undef, ( $sessionID, $userid ) );
 475             $dbh->do(
 476 "INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
 477                 undef,
 478                 ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() )
 479             );
 480             open L, ">>/tmp/sessionlog";
 481             my $time = localtime( time() );
 482             printf L "%20s from %16s logged in  at %30s.\n", $userid,
 483               $ENV{'REMOTE_ADDR'}, $time;
 484             close L;
 485             $cookie = $query->cookie(
 486                 -name    => 'sessionID',
 487                 -value   => $sessionID,
 488                 -expires => ''
 489             );
 490             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 491                 $loggedin = 1;
 492             }
 493             else {
 494                 $info{'nopermission'} = 1;
 495                 C4::Context->_unset_userenv($sessionID);
 496             }
 497             if ( $return == 1 ) {
 498                 my (
 499                     $borrowernumber, $firstname,  $surname,
 500                     $userflags,      $branchcode, $branchname,
 501                     $branchprinter,  $emailaddress
 502                 );
 503                 my $sth =
 504                   $dbh->prepare(
 505 "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=?"
 506                   );
 507                 $sth->execute($userid);
 508                 (
 509                     $borrowernumber, $firstname,  $surname,
 510                     $userflags,      $branchcode, $branchname,
 511                     $branchprinter,  $emailaddress
 512                   )
 513                   = $sth->fetchrow
 514                   if ( $sth->rows );
 515
 516 #                               warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 517                 unless ( $sth->rows ) {
 518                     my $sth =
 519                       $dbh->prepare(
 520 "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=?"
 521                       );
 522                     $sth->execute($cardnumber);
 523                     (
 524                         $borrowernumber, $firstname,  $surname,
 525                         $userflags,      $branchcode, $branchname,
 526                         $branchprinter,  $emailaddress
 527                       )
 528                       = $sth->fetchrow
 529                       if ( $sth->rows );
 530
 531 #                                       warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 532                     unless ( $sth->rows ) {
 533                         $sth->execute($userid);
 534                         (
 535                             $borrowernumber, $firstname, $surname, $userflags,
 536                             $branchcode, $branchname, $branchprinter, $emailaddress
 537                           )
 538                           = $sth->fetchrow
 539                           if ( $sth->rows );
 540                     }
 541
 542 #                                       warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 543                 }
 544
 545 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 546 #  new op dev :
 547 # 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.
 548                 my $ip       = $ENV{'REMOTE_ADDR'};
 549                 my $branches = GetBranches();
 550                 my @branchesloop;
 551                 foreach my $br ( keys %$branches ) {
 552
 553                     #           now we work with the treatment of ip
 554                     my $domain = $branches->{$br}->{'branchip'};
 555                     if ( $domain && $ip =~ /^$domain/ ) {
 556                         $branchcode = $branches->{$br}->{'branchcode'};
 557
 558                         # new op dev : add the branchprinter and branchname in the cookie
 559                         $branchprinter = $branches->{$br}->{'branchprinter'};
 560                         $branchname    = $branches->{$br}->{'branchname'};
 561                     }
 562                 }
 563                 my $hash = C4::Context::set_userenv(
 564                     $borrowernumber, $userid,    $cardnumber,
 565                     $firstname,      $surname,   $branchcode,
 566                     $branchname,     $userflags, $emailaddress,
 567                     $branchprinter,
 568                 );
 569
 570                 $envcookie = $query->cookie(
 571                     -name    => 'userenv',
 572                     -value   => $hash,
 573                     -expires => ''
 574                 );
 575             }
 576             elsif ( $return == 2 ) {
 577
 578                 #We suppose the user is the superlibrarian
 579                 my $hash = C4::Context::set_userenv(
 580                     0,
 581                     0,
 582                     C4::Context->config('user'),
 583                     C4::Context->config('user'),
 584                     C4::Context->config('user'),
 585                     "",
 586                     "NO_LIBRARY_SET",
 587                     1,
 588                     C4::Context->preference('KohaAdminEmailAddress')
 589                 );
 590                 $envcookie = $query->cookie(
 591                     -name    => 'userenv',
 592                     -value   => $hash,
 593                     -expires => ''
 594                 );
 595             }
 596         }
 597         else {
 598             if ($userid) {
 599                 $info{'invalid_username_or_password'} = 1;
 600                 C4::Context->_unset_userenv($sessionID);
 601             }
 602         }
 603     }
 604     my $insecure = C4::Context->boolean_preference('insecure');
 605
 606     # finished authentification, now respond
 607     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 608     {
 609
 610         # successful login
 611         unless ($cookie) {
 612             $cookie = $query->cookie(
 613                 -name    => 'sessionID',
 614                 -value   => '',
 615                 -expires => ''
 616             );
 617         }
 618         if ($envcookie) {
 619             return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags );
 620         }
 621         else {
 622             return ( $userid, $cookie, $sessionID, $flags );
 623         }
 624     }
 625
 626     # else we have a problem...
 627     # get the inputs from the incoming query
 628     my @inputs = ();
 629     foreach my $name ( param $query) {
 630         (next) if ( $name eq 'userid' || $name eq 'password' );
 631         my $value = $query->param($name);
 632         push @inputs, { name => $name, value => $value };
 633     }
 634
 635     my $template = gettemplate( $template_name, $type, $query );
 636     $template->param(
 637         INPUTS               => \@inputs,
 638         suggestion           => C4::Context->preference("suggestion"),
 639         virtualshelves       => C4::Context->preference("virtualshelves"),
 640         opaclargeimage       => C4::Context->preference("opaclargeimage"),
 641         LibraryName          => C4::Context->preference("LibraryName"),
 642         OpacNav              => C4::Context->preference("OpacNav"),
 643         opaccredits          => C4::Context->preference("opaccredits"),
 644         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 645         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 646         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 647         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 648         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 649         opacuserjs           => C4::Context->preference("opacuserjs"),
 650
 651         intranetcolorstylesheet =>
 652           C4::Context->preference("intranetcolorstylesheet"),
 653         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 654         IntranetNav        => C4::Context->preference("IntranetNav"),
 655         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 656         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 657
 658     );
 659     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 660
 661     my $self_url = $query->url( -absolute => 1 );
 662     $template->param(
 663         url         => $self_url,
 664         LibraryName => => C4::Context->preference("LibraryName"),
 665     );
 666     $template->param( \%info );
 667     $cookie = $query->cookie(
 668         -name    => 'sessionID',
 669         -value   => $sessionID,
 670         -expires => ''
 671     );
 672     print $query->header(
 673         -type   => 'utf-8',
 674         -cookie => $cookie
 675       ),
 676       $template->output;
 677     exit;
 678 }
 679
 680 sub checkpw {
 681
 682     my ( $dbh, $userid, $password ) = @_;
 683
 684     # INTERNAL AUTH
 685     my $sth =
 686       $dbh->prepare(
 687 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
 688       );
 689     $sth->execute($userid);
 690     if ( $sth->rows ) {
 691         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
 692             $surname, $branchcode, $flags )
 693           = $sth->fetchrow;
 694         if ( md5_base64($password) eq $md5password ) {
 695
 696             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
 697                 $firstname, $surname, $branchcode, $flags );
 698             return 1, $cardnumber;
 699         }
 700     }
 701     $sth =
 702       $dbh->prepare(
 703 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
 704       );
 705     $sth->execute($userid);
 706     if ( $sth->rows ) {
 707         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
 708             $surname, $branchcode, $flags )
 709           = $sth->fetchrow;
 710         if ( md5_base64($password) eq $md5password ) {
 711
 712             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
 713                 $firstname, $surname, $branchcode, $flags );
 714             return 1, $userid;
 715         }
 716     }
 717     if (   $userid && $userid eq C4::Context->config('user')
 718         && "$password" eq C4::Context->config('pass') )
 719     {
 720
 721 # Koha superuser account
 722 #               C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
 723         return 2;
 724     }
 725     if (   $userid && $userid eq 'demo'
 726         && "$password" eq 'demo'
 727         && C4::Context->config('demo') )
 728     {
 729
 730 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
 731 # some features won't be effective : modify systempref, modify MARC structure,
 732         return 2;
 733     }
 734     return 0;
 735 }
 736
 737 sub getuserflags {
 738     my $cardnumber = shift;
 739     my $dbh        = shift;
 740     my $userflags;
 741     my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
 742     $sth->execute($cardnumber);
 743     my ($flags) = $sth->fetchrow;
 744     $flags = 0 unless $flags;
 745     $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
 746     $sth->execute;
 747
 748     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
 749         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
 750             $userflags->{$flag} = 1;
 751         }
 752         else {
 753             $userflags->{$flag} = 0;
 754         }
 755     }
 756     return $userflags;
 757 }
 758
 759 sub haspermission {
 760     my ( $dbh, $userid, $flagsrequired ) = @_;
 761     my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
 762     $sth->execute($userid);
 763     my ($cardnumber) = $sth->fetchrow;
 764     ($cardnumber) || ( $cardnumber = $userid );
 765     my $flags = getuserflags( $cardnumber, $dbh );
 766     my $configfile;
 767     if ( $userid eq C4::Context->config('user') ) {
 768
 769         # Super User Account from /etc/koha.conf
 770         $flags->{'superlibrarian'} = 1;
 771     }
 772     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
 773
 774         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
 775         $flags->{'superlibrarian'} = 1;
 776     }
 777     return $flags if $flags->{superlibrarian};
 778     foreach ( keys %$flagsrequired ) {
 779         return $flags if $flags->{$_};
 780     }
 781     return 0;
 782 }
 783
 784 sub getborrowernumber {
 785     my ($userid) = @_;
 786     my $dbh = C4::Context->dbh;
 787     for my $field ( 'userid', 'cardnumber' ) {
 788         my $sth =
 789           $dbh->prepare("select borrowernumber from borrowers where $field=?");
 790         $sth->execute($userid);
 791         if ( $sth->rows ) {
 792             my ($bnumber) = $sth->fetchrow;
 793             return $bnumber;
 794         }
 795     }
 796     return 0;
 797 }
 798
 799 END { }    # module clean-up code here (global destructor)
 800 1;
 801 __END__
 802
 803 =back
 804
 805 =head1 SEE ALSO
 806
 807 CGI(3)
 808
 809 C4::Output(3)
 810
 811 Digest::MD5(3)
 812
 813 =cut