C4/Auth.pm

   1
   2 # -*- tab-width: 8 -*-
   3 # NOTE: This file uses 8-character tabs; do not change the tab size!
   4
   5 package C4::Auth;
   6
   7 # Copyright 2000-2002 Katipo Communications
   8 #
   9 # This file is part of Koha.
  10 #
  11 # Koha is free software; you can redistribute it and/or modify it under the
  12 # terms of the GNU General Public License as published by the Free Software
  13 # Foundation; either version 2 of the License, or (at your option) any later
  14 # version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  17 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  18 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License along with
  21 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  22 # Suite 330, Boston, MA  02111-1307 USA
  23
  24 use strict;
  25 use Digest::MD5 qw(md5_base64);
  26 use CGI::Session;
  27
  28 require Exporter;
  29 use C4::Context;
  30 use C4::Output;    # to get the template
  31 use C4::Members;
  32 use C4::Koha;
  33 use C4::Branch; # GetBranches
  34 use C4::VirtualShelves 3.02 qw(GetShelvesSummary);
  35
  36 # use utf8;
  37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap);
  38
  39 BEGIN {
  40     $VERSION = 3.02;        # set version for version checking
  41     $debug = $ENV{DEBUG} || 0 ;
  42     @ISA   = qw(Exporter);
  43     @EXPORT    = qw(&checkauth &get_template_and_user);
  44     @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw);
  45     $ldap = C4::Context->config('useldapserver') || 0;
  46     if ($ldap) {
  47         require C4::Auth_with_ldap;             # no import
  48         import  C4::Auth_with_ldap qw(checkpw_ldap);
  49     }
  50 }
  51
  52 =head1 NAME
  53
  54 C4::Auth - Authenticates Koha users
  55
  56 =head1 SYNOPSIS
  57
  58   use CGI;
  59   use C4::Auth;
  60
  61   my $query = new CGI;
  62
  63   my ($template, $borrowernumber, $cookie)
  64     = get_template_and_user(
  65         {
  66             template_name   => "opac-main.tmpl",
  67             query           => $query,
  68       type            => "opac",
  69       authnotrequired => 1,
  70       flagsrequired   => {borrow => 1},
  71   }
  72     );
  73
  74   print $query->header(
  75     -type => 'utf-8',
  76     -cookie => $cookie
  77   ), $template->output;
  78
  79
  80 =head1 DESCRIPTION
  81
  82     The main function of this module is to provide
  83     authentification. However the get_template_and_user function has
  84     been provided so that a users login information is passed along
  85     automatically. This gets loaded into the template.
  86
  87 =head1 FUNCTIONS
  88
  89 =over 2
  90
  91 =item get_template_and_user
  92
  93     my ($template, $borrowernumber, $cookie)
  94         = get_template_and_user(
  95           {
  96             template_name   => "opac-main.tmpl",
  97             query           => $query,
  98             type            => "opac",
  99             authnotrequired => 1,
 100             flagsrequired   => {borrow => 1},
 101           }
 102         );
 103
 104     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
 105     to C<&checkauth> (in this module) to perform authentification.
 106     See C<&checkauth> for an explanation of these parameters.
 107
 108     The C<template_name> is then used to find the correct template for
 109     the page. The authenticated users details are loaded onto the
 110     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 111     C<sessionID> is passed to the template. This can be used in templates
 112     if cookies are disabled. It needs to be put as and input to every
 113     authenticated page.
 114
 115     More information on the C<gettemplate> sub can be found in the
 116     Output.pm module.
 117
 118 =cut
 119
 120 sub get_template_and_user {
 121     my $in       = shift;
 122     my $template =
 123       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 124     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
 125         $in->{'query'},
 126         $in->{'authnotrequired'},
 127         $in->{'flagsrequired'},
 128         $in->{'type'}
 129     ) unless ($in->{'template_name'}=~/maintenance/);
 130
 131     my $borrowernumber;
 132     my $insecure = C4::Context->preference('insecure');
 133     if ($user or $insecure) {
 134
 135         # load the template variables for stylesheets and JavaScript
 136         $template->param( css_libs => $in->{'css_libs'} );
 137         $template->param( css_module => $in->{'css_module'} );
 138         $template->param( css_page => $in->{'css_page'} );
 139         $template->param( css_widgets => $in->{'css_widgets'} );
 140
 141         $template->param( js_libs => $in->{'js_libs'} );
 142         $template->param( js_module => $in->{'js_module'} );
 143         $template->param( js_page => $in->{'js_page'} );
 144         $template->param( js_widgets => $in->{'js_widgets'} );
 145
 146         # user info
 147         $template->param( loggedinusername => $user );
 148         $template->param( sessionID        => $sessionID );
 149                 my $shelves;
 150                 if ($shelves = C4::Context->get_shelves_userenv()) {
 151                 $template->param( barshelves     => scalar (@$shelves));
 152                 $template->param( barshelvesloop => $shelves);
 153                 }
 154
 155         $borrowernumber = getborrowernumber($user);
 156         my ( $borr, $alternativeflags ) =
 157           GetMemberDetails( $borrowernumber );
 158         my @bordat;
 159         $bordat[0] = $borr;
 160         $template->param( "USER_INFO" => \@bordat );
 161
 162         my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
 163                             editcatalogue updatecharges management tools editauthorities serials reports);
 164         # We are going to use the $flags returned by checkauth
 165         # to create the template's parameters that will indicate
 166         # which menus the user can access.
 167         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
 168             $template->param( CAN_user_circulate        => 1 );
 169             $template->param( CAN_user_catalogue        => 1 );
 170             $template->param( CAN_user_parameters       => 1 );
 171             $template->param( CAN_user_borrowers        => 1 );
 172             $template->param( CAN_user_permission       => 1 );
 173             $template->param( CAN_user_reserveforothers => 1 );
 174             $template->param( CAN_user_borrow           => 1 );
 175             $template->param( CAN_user_editcatalogue    => 1 );
 176             $template->param( CAN_user_updatecharges     => 1 );
 177             $template->param( CAN_user_acquisition      => 1 );
 178             $template->param( CAN_user_management       => 1 );
 179             $template->param( CAN_user_tools            => 1 );
 180             $template->param( CAN_user_editauthorities  => 1 );
 181             $template->param( CAN_user_serials          => 1 );
 182             $template->param( CAN_user_reports          => 1 );
 183             $template->param( CAN_user_staffaccess      => 1 );
 184         }
 185
 186         if ( $flags && $flags->{circulate} == 1 ) {
 187             $template->param( CAN_user_circulate => 1 );
 188         }
 189
 190         if ( $flags && $flags->{catalogue} == 1 ) {
 191             $template->param( CAN_user_catalogue => 1 );
 192         }
 193
 194         if ( $flags && $flags->{parameters} == 1 ) {
 195             $template->param( CAN_user_parameters => 1 );
 196             $template->param( CAN_user_management => 1 );
 197         }
 198
 199         if ( $flags && $flags->{borrowers} == 1 ) {
 200             $template->param( CAN_user_borrowers => 1 );
 201         }
 202
 203         if ( $flags && $flags->{permissions} == 1 ) {
 204             $template->param( CAN_user_permission => 1 );
 205         }
 206
 207         if ( $flags && $flags->{reserveforothers} == 1 ) {
 208             $template->param( CAN_user_reserveforothers => 1 );
 209         }
 210
 211         if ( $flags && $flags->{borrow} == 1 ) {
 212             $template->param( CAN_user_borrow => 1 );
 213         }
 214
 215         if ( $flags && $flags->{editcatalogue} == 1 ) {
 216             $template->param( CAN_user_editcatalogue => 1 );
 217         }
 218
 219         if ( $flags && $flags->{updatecharges} == 1 ) {
 220             $template->param( CAN_user_updatecharges => 1 );
 221         }
 222
 223         if ( $flags && $flags->{acquisition} == 1 ) {
 224             $template->param( CAN_user_acquisition => 1 );
 225         }
 226
 227         if ( $flags && $flags->{tools} == 1 ) {
 228             $template->param( CAN_user_tools => 1 );
 229         }
 230
 231         if ( $flags && $flags->{editauthorities} == 1 ) {
 232             $template->param( CAN_user_editauthorities => 1 );
 233         }
 234
 235         if ( $flags && $flags->{serials} == 1 ) {
 236             $template->param( CAN_user_serials => 1 );
 237         }
 238
 239         if ( $flags && $flags->{reports} == 1 ) {
 240             $template->param( CAN_user_reports => 1 );
 241         }
 242         if ( $flags && $flags->{staffaccess} == 1 ) {
 243             $template->param( CAN_user_staffaccess => 1 );
 244         }
 245     }
 246     if ( $in->{'type'} eq "intranet" ) {
 247         $template->param(
 248             intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
 249             intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 250             IntranetNav        => C4::Context->preference("IntranetNav"),
 251             intranetuserjs     => C4::Context->preference("intranetuserjs"),
 252             TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 253             AmazonContent      => C4::Context->preference("AmazonContent"),
 254             LibraryName        => C4::Context->preference("LibraryName"),
 255             LoginBranchcode    => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 256             LoginBranchname    => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
 257             LoginFirstname     => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 258             LoginSurname       => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 259             AutoLocation       => C4::Context->preference("AutoLocation"),
 260             hide_marc          => C4::Context->preference("hide_marc"),
 261             patronimages       => C4::Context->preference("patronimages"),
 262             "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
 263             advancedMARCEditor      => C4::Context->preference("advancedMARCEditor"),
 264             suggestion              => C4::Context->preference("suggestion"),
 265             virtualshelves          => C4::Context->preference("virtualshelves"),
 266             LibraryName             => C4::Context->preference("LibraryName"),
 267             KohaAdminEmailAddress   => "" . C4::Context->preference("KohaAdminEmailAddress"),
 268             IntranetmainUserblock   => C4::Context->preference("IntranetmainUserblock"),
 269             IndependantBranches     => C4::Context->preference("IndependantBranches"),
 270                         CircAutocompl => C4::Context->preference("CircAutocompl"),
 271                         yuipath => C4::Context->preference("yuipath"),
 272                         FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
 273                         AmazonSimilarItems => C4::Context->preference("AmazonSimilarItems"),
 274                         'item-level_itypes' => C4::Context->preference('item-level_itypes'),
 275                         canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
 276                         intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
 277                         noItemTypeImages => C4::Context->preference("noItemTypeImages"),
 278         );
 279     }
 280     else {
 281         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 282         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 283         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 284         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 285   $template->param(
 286             KohaAdminEmailAddress  => "" . C4::Context->preference("KohaAdminEmailAddress"),
 287             AnonSuggestions =>  "" . C4::Context->preference("AnonSuggestions"),
 288             suggestion             => "" . C4::Context->preference("suggestion"),
 289             virtualshelves         => "" . C4::Context->preference("virtualshelves"),
 290             OpacNav                => "" . C4::Context->preference("OpacNav"),
 291             opacheader             => "" . C4::Context->preference("opacheader"),
 292             opaccredits            => "" . C4::Context->preference("opaccredits"),
 293             opacsmallimage         => "" . C4::Context->preference("opacsmallimage"),
 294             opaclargeimage         => "" . C4::Context->preference("opaclargeimage"),
 295             opaclayoutstylesheet   => "". C4::Context->preference("opaclayoutstylesheet"),
 296             opaccolorstylesheet    => "". C4::Context->preference("opaccolorstylesheet"),
 297             opaclanguagesdisplay   => "". C4::Context->preference("opaclanguagesdisplay"),
 298             opacuserlogin          => "" . C4::Context->preference("opacuserlogin"),
 299                         OpacMainUserBlock =>  "" . C4::Context->preference("OpacMainUserBlock"),
 300                         OPACURLOpenInNewWindow =>  "" . C4::Context->preference("OPACURLOpenInNewWindow"),
 301             opacbookbag            => "" . C4::Context->preference("opacbookbag"),
 302             TemplateEncoding       => "". C4::Context->preference("TemplateEncoding"),
 303             AmazonContent          => "" . C4::Context->preference("AmazonContent"),
 304             OPACShelfBrowser       => "". C4::Context->preference("OPACShelfBrowser"),
 305             OPACAmazonSimilarItems => "" . C4::Context->preference("OPACAmazonSimilarItems"),
 306             LibraryName            => "" . C4::Context->preference("LibraryName"),
 307             LibraryNameTitle       => "" . $LibraryNameTitle,
 308             LoginBranchcode        => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 309             LoginBranchname        => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 310             LoginFirstname        => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 311             LoginSurname        => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 312             OpacPasswordChange     => C4::Context->preference("OpacPasswordChange"),
 313             opacreadinghistory     => C4::Context->preference("opacreadinghistory"),
 314             opacuserjs             => C4::Context->preference("opacuserjs"),
 315             OpacCloud              => C4::Context->preference("OpacCloud"),
 316             OpacTopissue           => C4::Context->preference("OpacTopissue"),
 317             OpacAuthorities        => C4::Context->preference("OpacAuthorities"),
 318             OpacBrowser            => C4::Context->preference("OpacBrowser"),
 319             RequestOnOpac          => C4::Context->preference("RequestOnOpac"),
 320             reviewson              => C4::Context->preference("reviewson"),
 321             hide_marc              => C4::Context->preference("hide_marc"),
 322             patronimages           => C4::Context->preference("patronimages"),
 323             hidelostitems          => C4::Context->preference("hidelostitems"),
 324             mylibraryfirst   => C4::Context->preference("SearchMyLibraryFirst"),
 325             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 326             OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
 327             'item-level_itypes' => C4::Context->preference('item-level_itypes'),
 328             'Version' => C4::Context->preference('Version'),
 329                         yuipath => C4::Context->preference("yuipath"),
 330         );
 331     }
 332         $template->param(listloop=>[{shelfname=>"Freelist", shelfnumber=>110}]);
 333     return ( $template, $borrowernumber, $cookie, $flags);
 334 }
 335
 336 =item checkauth
 337
 338   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 339
 340 Verifies that the user is authorized to run this script.  If
 341 the user is authorized, a (userid, cookie, session-id, flags)
 342 quadruple is returned.  If the user is not authorized but does
 343 not have the required privilege (see $flagsrequired below), it
 344 displays an error page and exits.  Otherwise, it displays the
 345 login page and exits.
 346
 347 Note that C<&checkauth> will return if and only if the user
 348 is authorized, so it should be called early on, before any
 349 unfinished operations (e.g., if you've opened a file, then
 350 C<&checkauth> won't close it for you).
 351
 352 C<$query> is the CGI object for the script calling C<&checkauth>.
 353
 354 The C<$noauth> argument is optional. If it is set, then no
 355 authorization is required for the script.
 356
 357 C<&checkauth> fetches user and session information from C<$query> and
 358 ensures that the user is authorized to run scripts that require
 359 authorization.
 360
 361 The C<$flagsrequired> argument specifies the required privileges
 362 the user must have if the username and password are correct.
 363 It should be specified as a reference-to-hash; keys in the hash
 364 should be the "flags" for the user, as specified in the Members
 365 intranet module. Any key specified must correspond to a "flag"
 366 in the userflags table. E.g., { circulate => 1 } would specify
 367 that the user must have the "circulate" privilege in order to
 368 proceed. To make sure that access control is correct, the
 369 C<$flagsrequired> parameter must be specified correctly.
 370
 371 The C<$type> argument specifies whether the template should be
 372 retrieved from the opac or intranet directory tree.  "opac" is
 373 assumed if it is not specified; however, if C<$type> is specified,
 374 "intranet" is assumed if it is not "opac".
 375
 376 If C<$query> does not have a valid session ID associated with it
 377 (i.e., the user has not logged in) or if the session has expired,
 378 C<&checkauth> presents the user with a login page (from the point of
 379 view of the original script, C<&checkauth> does not return). Once the
 380 user has authenticated, C<&checkauth> restarts the original script
 381 (this time, C<&checkauth> returns).
 382
 383 The login page is provided using a HTML::Template, which is set in the
 384 systempreferences table or at the top of this file. The variable C<$type>
 385 selects which template to use, either the opac or the intranet
 386 authentification template.
 387
 388 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 389 cookie should be sent back to the browser; it verifies that the user
 390 has authenticated.
 391
 392 =cut
 393
 394 sub _version_check ($$) {
 395     my $type = shift;
 396     my $query = shift;
 397     my $version;
 398     # If Version syspref is unavailable, it means Koha is beeing installed,
 399     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 400     #warn "about to check version";
 401     unless ($version = C4::Context->preference('Version')) {    # assignment, not comparison
 402       if ($type ne 'opac') {
 403         warn "Install required, redirecting to Installer";
 404         print $query->redirect("/cgi-bin/koha/installer/install.pl");
 405       }
 406       else {
 407         warn "OPAC Install required, redirecting to maintenance";
 408         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 409       }
 410       exit;
 411     }
 412
 413     # check that database and koha version are the same
 414     # there is no DB version, it's a fresh install,
 415     # go to web installer
 416     # there is a DB version, compare it to the code version
 417     my $kohaversion=C4::Context::KOHAVERSION;
 418     # remove the 3 last . to have a Perl number
 419     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 420     $debug and print STDERR "kohaversion : $kohaversion\n";
 421     if ($version < $kohaversion){
 422         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 423         if ($type ne 'opac'){
 424             warn sprintf($warning, 'Installer');
 425             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 426         } else {
 427             warn sprintf("OPAC: " . $warning, 'maintenance');
 428             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 429         }
 430         exit;
 431     }
 432 }
 433
 434 sub _session_log {
 435     (@_) or return 0;
 436     open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 437     printf L join("\n",@_);
 438     close L;
 439 }
 440
 441 sub checkauth {
 442     my $query = shift;
 443         $debug and warn "Checking Auth";
 444     # $authnotrequired will be set for scripts which will run without authentication
 445     my $authnotrequired = shift;
 446     my $flagsrequired   = shift;
 447     my $type            = shift;
 448     $type = 'opac' unless $type;
 449
 450     my $dbh     = C4::Context->dbh;
 451     my $timeout = C4::Context->preference('timeout');
 452     # days
 453     if ($timeout =~ /(\d+)[dD]/) {
 454         $timeout = $1 * 86400;
 455     };
 456     $timeout = 600 unless $timeout;
 457
 458     _version_check($type,$query);
 459     # state variables
 460     my $loggedin = 0;
 461     my %info;
 462     my ( $userid, $cookie, $sessionID, $flags, $shelves );
 463     my $logout = $query->param('logout.x');
 464     if ( $userid = $ENV{'REMOTE_USER'} ) {
 465         # Using Basic Authentication, no cookies required
 466         $cookie = $query->cookie(
 467             -name    => 'CGISESSID',
 468             -value   => '',
 469             -expires => ''
 470         );
 471         $loggedin = 1;
 472     }
 473     elsif ( $sessionID = $query->cookie("CGISESSID")) {     # assignment, not comparison
 474         my $session = get_session($sessionID);
 475         C4::Context->_new_userenv($sessionID);
 476         my ($ip, $lasttime);
 477         if ($session){
 478             C4::Context::set_userenv(
 479                 $session->param('number'),       $session->param('id'),
 480                 $session->param('cardnumber'),   $session->param('firstname'),
 481                 $session->param('surname'),      $session->param('branch'),
 482                 $session->param('branchname'),   $session->param('flags'),
 483                 $session->param('emailaddress'), $session->param('branchprinter')
 484             );
 485             C4::Context::set_shelves_userenv($session->param('shelves'));
 486             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 487             $ip       = $session->param('ip');
 488             $lasttime = $session->param('lasttime');
 489             $userid   = $session->param('id');
 490         }
 491
 492         if ($logout) {
 493             # voluntary logout the user
 494             $session->flush;
 495             $session->delete();
 496             C4::Context->_unset_userenv($sessionID);
 497             _session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,localtime);
 498             $sessionID = undef;
 499             $userid    = undef;
 500         }
 501                 elsif ( $lasttime < time() - $timeout ) {
 502                         # timed logout
 503                         $info{'timed_out'} = 1;
 504                         $session->delete();
 505                         C4::Context->_unset_userenv($sessionID);
 506                         _session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,localtime);
 507                         $userid    = undef;
 508                         $sessionID = undef;
 509                 }
 510                 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 511                         # Different ip than originally logged in from
 512                         $info{'oldip'}        = $ip;
 513                         $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 514                         $info{'different_ip'} = 1;
 515                         $session->delete();
 516                         C4::Context->_unset_userenv($sessionID);
 517                         _session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,localtime, $info{'newip'});
 518                         $sessionID = undef;
 519                         $userid    = undef;
 520                 }
 521                 else {
 522                         $cookie = $query->cookie( CGISESSID => $session->id );
 523                         $session->param('lasttime',time());
 524                         $flags = haspermission( $dbh, $userid, $flagsrequired );
 525                         if ($flags) {
 526                                 $loggedin = 1;
 527                         } else {
 528                                 $info{'nopermission'} = 1;
 529                         }
 530                 }
 531     }
 532     unless ($userid) {
 533         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 534         my $sessionID = $session->id;
 535         $userid    = $query->param('userid');
 536         my $password = $query->param('password');
 537         C4::Context->_new_userenv($sessionID);
 538         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 539         if ($return) {
 540             _session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},localtime);
 541             $cookie = $query->cookie(CGISESSID => $sessionID);
 542             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 543                                 $loggedin = 1;
 544             }
 545             else {
 546                 $info{'nopermission'} = 1;
 547                 C4::Context->_unset_userenv($sessionID);
 548             }
 549
 550                         my ($borrowernumber, $firstname, $surname, $userflags,
 551                                 $branchcode, $branchname, $branchprinter, $emailaddress);
 552
 553             if ( $return == 1 ) {
 554                 my $select = "
 555                 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 556                         branches.branchname    as branchname,
 557                         branches.branchprinter as branchprinter,
 558                         email
 559                 FROM borrowers
 560                 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 561                 ";
 562                 my $sth = $dbh->prepare("$select where userid=?");
 563                 $sth->execute($userid);
 564                                 unless ($sth->rows) {
 565                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 566                                         $sth = $dbh->prepare("$select where cardnumber=?");
 567                     $sth->execute($cardnumber);
 568                                         unless ($sth->rows) {
 569                                 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 570                         $sth->execute($userid);
 571                                                 unless ($sth->rows) {
 572                                         $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 573                                                 }
 574                                         }
 575                                 }
 576                 if ($sth->rows) {
 577                     ($borrowernumber, $firstname, $surname, $userflags,
 578                         $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 579                                         $debug and print STDERR "AUTH_3 results: " .
 580                                                 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 581                                 } else {
 582                                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 583                                 }
 584
 585 # launch a sequence to check if we have a ip for the branch, i
 586 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 587
 588                 my $ip       = $ENV{'REMOTE_ADDR'};
 589                 # if they specify at login, use that
 590                 if ($query->param('branch')) {
 591                     $branchcode  = $query->param('branch');
 592                     $branchname = GetBranchName($branchcode);
 593                 }
 594                 my $branches = GetBranches();
 595                 if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 596                                     # we have to check they are coming from the right ip range
 597                                         my $domain = $branches->{$branchcode}->{'branchip'};
 598                                         if ($ip !~ /^$domain/){
 599                                                 $loggedin=0;
 600                                                 $info{'wrongip'} = 1;
 601                                         }
 602                                 }
 603
 604                 my @branchesloop;
 605                 foreach my $br ( keys %$branches ) {
 606                     #     now we work with the treatment of ip
 607                     my $domain = $branches->{$br}->{'branchip'};
 608                     if ( $domain && $ip =~ /^$domain/ ) {
 609                         $branchcode = $branches->{$br}->{'branchcode'};
 610
 611                         # new op dev : add the branchprinter and branchname in the cookie
 612                         $branchprinter = $branches->{$br}->{'branchprinter'};
 613                         $branchname    = $branches->{$br}->{'branchname'};
 614                     }
 615                 }
 616                 $session->param('number',$borrowernumber);
 617                 $session->param('id',$userid);
 618                 $session->param('cardnumber',$cardnumber);
 619                 $session->param('firstname',$firstname);
 620                 $session->param('surname',$surname);
 621                 $session->param('branch',$branchcode);
 622                 $session->param('branchname',$branchname);
 623                 $session->param('flags',$userflags);
 624                 $session->param('emailaddress',$emailaddress);
 625                 $session->param('ip',$session->remote_addr());
 626                 $session->param('lasttime',time());
 627                 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 628             }
 629             elsif ( $return == 2 ) {
 630                 #We suppose the user is the superlibrarian
 631                                 $borrowernumber = 0;
 632                 $session->param('number',0);
 633                 $session->param('id',C4::Context->config('user'));
 634                 $session->param('cardnumber',C4::Context->config('user'));
 635                 $session->param('firstname',C4::Context->config('user'));
 636                 $session->param('surname',C4::Context->config('user'));
 637                 $session->param('branch','NO_LIBRARY_SET');
 638                 $session->param('branchname','NO_LIBRARY_SET');
 639                 $session->param('flags',1);
 640                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 641                 $session->param('ip',$session->remote_addr());
 642                 $session->param('lasttime',time());
 643             }
 644             C4::Context::set_userenv(
 645                 $session->param('number'),       $session->param('id'),
 646                 $session->param('cardnumber'),   $session->param('firstname'),
 647                 $session->param('surname'),      $session->param('branch'),
 648                 $session->param('branchname'),   $session->param('flags'),
 649                 $session->param('emailaddress'), $session->param('branchprinter')
 650             );
 651                         $shelves = GetShelvesSummary($borrowernumber,2,10);
 652                         $session->param('shelves', $shelves);
 653                         C4::Context::set_shelves_userenv($shelves);
 654         }
 655         else {
 656             if ($userid) {
 657                 $info{'invalid_username_or_password'} = 1;
 658                 C4::Context->_unset_userenv($sessionID);
 659             }
 660
 661         }
 662     }   # END unless ($userid)
 663     my $insecure = C4::Context->boolean_preference('insecure');
 664
 665     # finished authentification, now respond
 666     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 667     {
 668         # successful login
 669         unless ($cookie) {
 670             $cookie = $query->cookie( CGISESSID => '' );
 671         }
 672         return ( $userid, $cookie, $sessionID, $flags );
 673     }
 674
 675 #
 676 #
 677 # AUTH rejected, show the login/password template, after checking the DB.
 678 #
 679 #
 680
 681     # get the inputs from the incoming query
 682     my @inputs = ();
 683     foreach my $name ( param $query) {
 684         (next) if ( $name eq 'userid' || $name eq 'password' );
 685         my $value = $query->param($name);
 686         push @inputs, { name => $name, value => $value };
 687     }
 688     # get the branchloop, which we need for authentication
 689     my $branches = GetBranches();
 690     my @branch_loop;
 691     for my $branch_hash (sort keys %$branches) {
 692                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
 693     }
 694
 695     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
 696     my $template = gettemplate( $template_name, $type, $query );
 697     $template->param(branchloop => \@branch_loop,);
 698     $template->param(
 699     login        => 1,
 700         INPUTS               => \@inputs,
 701         suggestion           => C4::Context->preference("suggestion"),
 702         virtualshelves       => C4::Context->preference("virtualshelves"),
 703         opaclargeimage       => C4::Context->preference("opaclargeimage"),
 704         LibraryName          => C4::Context->preference("LibraryName"),
 705         opacuserlogin        => C4::Context->preference("opacuserlogin"),
 706         OpacNav              => C4::Context->preference("OpacNav"),
 707         opaccredits          => C4::Context->preference("opaccredits"),
 708         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 709         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 710         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 711         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 712         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 713         opacuserjs           => C4::Context->preference("opacuserjs"),
 714         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
 715         OpacCloud            => C4::Context->preference("OpacCloud"),
 716         OpacTopissue         => C4::Context->preference("OpacTopissue"),
 717         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
 718         OpacBrowser          => C4::Context->preference("OpacBrowser"),
 719         intranetcolorstylesheet =>
 720                                                                 C4::Context->preference("intranetcolorstylesheet"),
 721         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 722         IntranetNav        => C4::Context->preference("IntranetNav"),
 723         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 724         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 725         IndependantBranches=> C4::Context->preference("IndependantBranches"),
 726         AutoLocation       => C4::Context->preference("AutoLocation"),
 727         yuipath            => C4::Context->preference("yuipath"),
 728                 wrongip            => $info{'wrongip'}
 729     );
 730
 731     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 732
 733     my $self_url = $query->url( -absolute => 1 );
 734     $template->param(
 735         url         => $self_url,
 736         LibraryName => C4::Context->preference("LibraryName"),
 737     );
 738     $template->param( \%info );
 739 #    $cookie = $query->cookie(CGISESSID => $session->id
 740 #   );
 741     print $query->header(
 742         -type   => 'text/html',
 743         -charset => 'utf-8',
 744         -cookie => $cookie
 745       ),
 746       $template->output;
 747     exit;
 748 }
 749
 750 =item check_api_auth
 751
 752   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 753
 754 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 755 cookie, determine if the user has the privileges specified by C<$userflags>.
 756
 757 C<check_api_auth> is is meant for authenticating users of web services, and
 758 consequently will always return and will not attempt to redirect the user
 759 agent.
 760
 761 If a valid session cookie is already present, check_api_auth will return a status
 762 of "ok", the cookie, and the Koha session ID.
 763
 764 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 765 parameters and create a session cookie and Koha session if the supplied credentials
 766 are OK.
 767
 768 Possible return values in C<$status> are:
 769
 770 =over 4
 771
 772 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 773
 774 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 775
 776 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 777
 778 =item "expired -- session cookie has expired; API user should resubmit userid and password
 779
 780 =back
 781
 782 =cut
 783
 784 sub check_api_auth {
 785     my $query = shift;
 786     my $flagsrequired = shift;
 787
 788     my $dbh     = C4::Context->dbh;
 789     my $timeout = C4::Context->preference('timeout');
 790     $timeout = 600 unless $timeout;
 791
 792     unless (C4::Context->preference('Version')) {
 793         # database has not been installed yet
 794         return ("maintenance", undef, undef);
 795     }
 796     my $kohaversion=C4::Context::KOHAVERSION;
 797     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 798     if (C4::Context->preference('Version') < $kohaversion) {
 799         # database in need of version update; assume that
 800         # no API should be called while databsae is in
 801         # this condition.
 802         return ("maintenance", undef, undef);
 803     }
 804
 805     # FIXME -- most of what follows is a copy-and-paste
 806     # of code from checkauth.  There is an obvious need
 807     # for refactoring to separate the various parts of
 808     # the authentication code, but as of 2007-11-19 this
 809     # is deferred so as to not introduce bugs into the
 810     # regular authentication code for Koha 3.0.
 811
 812     # see if we have a valid session cookie already
 813     # however, if a userid parameter is present (i.e., from
 814     # a form submission, assume that any current cookie
 815     # is to be ignored
 816     my $sessionID = undef;
 817     unless ($query->param('userid')) {
 818         $sessionID = $query->cookie("CGISESSID");
 819     }
 820     if ($sessionID) {
 821         my $session = get_session($sessionID);
 822         C4::Context->_new_userenv($sessionID);
 823         if ($session) {
 824             C4::Context::set_userenv(
 825                 $session->param('number'),       $session->param('id'),
 826                 $session->param('cardnumber'),   $session->param('firstname'),
 827                 $session->param('surname'),      $session->param('branch'),
 828                 $session->param('branchname'),   $session->param('flags'),
 829                 $session->param('emailaddress'), $session->param('branchprinter')
 830             );
 831
 832             my $ip = $session->param('ip');
 833             my $lasttime = $session->param('lasttime');
 834             my $userid = $session->param('id');
 835             if ( $lasttime < time() - $timeout ) {
 836                 # time out
 837                 $session->delete();
 838                 C4::Context->_unset_userenv($sessionID);
 839                 $userid    = undef;
 840                 $sessionID = undef;
 841                 return ("expired", undef, undef);
 842             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 843                 # IP address changed
 844                 $session->delete();
 845                 C4::Context->_unset_userenv($sessionID);
 846                 $userid    = undef;
 847                 $sessionID = undef;
 848                 return ("expired", undef, undef);
 849             } else {
 850                 my $cookie = $query->cookie( CGISESSID => $session->id );
 851                 $session->param('lasttime',time());
 852                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 853                 if ($flags) {
 854                     return ("ok", $cookie, $sessionID);
 855                 } else {
 856                     $session->delete();
 857                     C4::Context->_unset_userenv($sessionID);
 858                     $userid    = undef;
 859                     $sessionID = undef;
 860                     return ("failed", undef, undef);
 861                 }
 862             }
 863         } else {
 864             return ("expired", undef, undef);
 865         }
 866     } else {
 867         # new login
 868         my $userid = $query->param('userid');
 869         my $password = $query->param('password');
 870         unless ($userid and $password) {
 871             # caller did something wrong, fail the authenticateion
 872             return ("failed", undef, undef);
 873         }
 874         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 875         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 876             my $session = get_session("");
 877             return ("failed", undef, undef) unless $session;
 878
 879             my $sessionID = $session->id;
 880             C4::Context->_new_userenv($sessionID);
 881             my $cookie = $query->cookie(CGISESSID => $sessionID);
 882             if ( $return == 1 ) {
 883                 my (
 884                     $borrowernumber, $firstname,  $surname,
 885                     $userflags,      $branchcode, $branchname,
 886                     $branchprinter,  $emailaddress
 887                 );
 888                 my $sth =
 889                   $dbh->prepare(
 890 "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=?"
 891                   );
 892                 $sth->execute($userid);
 893                 (
 894                     $borrowernumber, $firstname,  $surname,
 895                     $userflags,      $branchcode, $branchname,
 896                     $branchprinter,  $emailaddress
 897                 ) = $sth->fetchrow if ( $sth->rows );
 898
 899                 unless ($sth->rows ) {
 900                     my $sth = $dbh->prepare(
 901 "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=?"
 902                       );
 903                     $sth->execute($cardnumber);
 904                     (
 905                         $borrowernumber, $firstname,  $surname,
 906                         $userflags,      $branchcode, $branchname,
 907                         $branchprinter,  $emailaddress
 908                     ) = $sth->fetchrow if ( $sth->rows );
 909
 910                     unless ( $sth->rows ) {
 911                         $sth->execute($userid);
 912                         (
 913                             $borrowernumber, $firstname, $surname, $userflags,
 914                             $branchcode, $branchname, $branchprinter, $emailaddress
 915                         ) = $sth->fetchrow if ( $sth->rows );
 916                     }
 917                 }
 918
 919                 my $ip       = $ENV{'REMOTE_ADDR'};
 920                 # if they specify at login, use that
 921                 if ($query->param('branch')) {
 922                     $branchcode  = $query->param('branch');
 923                     $branchname = GetBranchName($branchcode);
 924                 }
 925                 my $branches = GetBranches();
 926                 my @branchesloop;
 927                 foreach my $br ( keys %$branches ) {
 928                     #     now we work with the treatment of ip
 929                     my $domain = $branches->{$br}->{'branchip'};
 930                     if ( $domain && $ip =~ /^$domain/ ) {
 931                         $branchcode = $branches->{$br}->{'branchcode'};
 932
 933                         # new op dev : add the branchprinter and branchname in the cookie
 934                         $branchprinter = $branches->{$br}->{'branchprinter'};
 935                         $branchname    = $branches->{$br}->{'branchname'};
 936                     }
 937                 }
 938                 $session->param('number',$borrowernumber);
 939                 $session->param('id',$userid);
 940                 $session->param('cardnumber',$cardnumber);
 941                 $session->param('firstname',$firstname);
 942                 $session->param('surname',$surname);
 943                 $session->param('branch',$branchcode);
 944                 $session->param('branchname',$branchname);
 945                 $session->param('flags',$userflags);
 946                 $session->param('emailaddress',$emailaddress);
 947                 $session->param('ip',$session->remote_addr());
 948                 $session->param('lasttime',time());
 949             } elsif ( $return == 2 ) {
 950                 #We suppose the user is the superlibrarian
 951                 $session->param('number',0);
 952                 $session->param('id',C4::Context->config('user'));
 953                 $session->param('cardnumber',C4::Context->config('user'));
 954                 $session->param('firstname',C4::Context->config('user'));
 955                 $session->param('surname',C4::Context->config('user'));
 956                 $session->param('branch','NO_LIBRARY_SET');
 957                 $session->param('branchname','NO_LIBRARY_SET');
 958                 $session->param('flags',1);
 959                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 960                 $session->param('ip',$session->remote_addr());
 961                 $session->param('lasttime',time());
 962             }
 963             C4::Context::set_userenv(
 964                 $session->param('number'),       $session->param('id'),
 965                 $session->param('cardnumber'),   $session->param('firstname'),
 966                 $session->param('surname'),      $session->param('branch'),
 967                 $session->param('branchname'),   $session->param('flags'),
 968                 $session->param('emailaddress'), $session->param('branchprinter')
 969             );
 970             return ("ok", $cookie, $sessionID);
 971         } else {
 972             return ("failed", undef, undef);
 973         }
 974     }
 975 }
 976
 977 =item check_cookie_auth
 978
 979   ($status, $sessionId) = check_api_auth($cookie, $userflags);
 980
 981 Given a CGISESSID cookie set during a previous login to Koha, determine
 982 if the user has the privileges specified by C<$userflags>.
 983
 984 C<check_cookie_auth> is meant for authenticating special services
 985 such as tools/upload-file.pl that are invoked by other pages that
 986 have been authenticated in the usual way.
 987
 988 Possible return values in C<$status> are:
 989
 990 =over 4
 991
 992 =item "ok" -- user authenticated; C<$sessionID> have valid values.
 993
 994 =item "failed" -- credentials are not correct; C<$sessionid> are undef
 995
 996 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 997
 998 =item "expired -- session cookie has expired; API user should resubmit userid and password
 999
1000 =back
1001
1002 =cut
1003
1004 sub check_cookie_auth {
1005     my $cookie = shift;
1006     my $flagsrequired = shift;
1007
1008     my $dbh     = C4::Context->dbh;
1009     my $timeout = C4::Context->preference('timeout');
1010     $timeout = 600 unless $timeout;
1011
1012     unless (C4::Context->preference('Version')) {
1013         # database has not been installed yet
1014         return ("maintenance", undef);
1015     }
1016     my $kohaversion=C4::Context::KOHAVERSION;
1017     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1018     if (C4::Context->preference('Version') < $kohaversion) {
1019         # database in need of version update; assume that
1020         # no API should be called while databsae is in
1021         # this condition.
1022         return ("maintenance", undef);
1023     }
1024
1025     # FIXME -- most of what follows is a copy-and-paste
1026     # of code from checkauth.  There is an obvious need
1027     # for refactoring to separate the various parts of
1028     # the authentication code, but as of 2007-11-23 this
1029     # is deferred so as to not introduce bugs into the
1030     # regular authentication code for Koha 3.0.
1031
1032     # see if we have a valid session cookie already
1033     # however, if a userid parameter is present (i.e., from
1034     # a form submission, assume that any current cookie
1035     # is to be ignored
1036     unless (defined $cookie and $cookie) {
1037         return ("failed", undef);
1038     }
1039     my $sessionID = $cookie;
1040     my $session = get_session($sessionID);
1041     C4::Context->_new_userenv($sessionID);
1042     if ($session) {
1043         C4::Context::set_userenv(
1044             $session->param('number'),       $session->param('id'),
1045             $session->param('cardnumber'),   $session->param('firstname'),
1046             $session->param('surname'),      $session->param('branch'),
1047             $session->param('branchname'),   $session->param('flags'),
1048             $session->param('emailaddress'), $session->param('branchprinter')
1049         );
1050
1051         my $ip = $session->param('ip');
1052         my $lasttime = $session->param('lasttime');
1053         my $userid = $session->param('id');
1054         if ( $lasttime < time() - $timeout ) {
1055             # time out
1056             $session->delete();
1057             C4::Context->_unset_userenv($sessionID);
1058             $userid    = undef;
1059             $sessionID = undef;
1060             return ("expired", undef);
1061         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1062             # IP address changed
1063             $session->delete();
1064             C4::Context->_unset_userenv($sessionID);
1065             $userid    = undef;
1066             $sessionID = undef;
1067             return ("expired", undef);
1068         } else {
1069             $session->param('lasttime',time());
1070             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1071             if ($flags) {
1072                 return ("ok", $sessionID);
1073             } else {
1074                 $session->delete();
1075                 C4::Context->_unset_userenv($sessionID);
1076                 $userid    = undef;
1077                 $sessionID = undef;
1078                 return ("failed", undef);
1079             }
1080         }
1081     } else {
1082         return ("expired", undef);
1083     }
1084 }
1085
1086 =item get_session
1087
1088   use CGI::Session;
1089   my $session = get_session($sessionID);
1090
1091 Given a session ID, retrieve the CGI::Session object used to store
1092 the session's state.  The session object can be used to store
1093 data that needs to be accessed by different scripts during a
1094 user's session.
1095
1096 If the C<$sessionID> parameter is an empty string, a new session
1097 will be created.
1098
1099 =cut
1100
1101 sub get_session {
1102     my $sessionID = shift;
1103     my $storage_method = C4::Context->preference('SessionStorage');
1104     my $dbh = C4::Context->dbh;
1105     my $session;
1106     if ($storage_method eq 'mysql'){
1107         $session = new CGI::Session("driver:MySQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1108     }
1109     elsif ($storage_method eq 'Pg') {
1110         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1111     }
1112     else {
1113         # catch all defaults to tmp should work on all systems
1114         $session = new CGI::Session("driver:File;serializer:yaml", $sessionID, {Directory=>'/tmp'});
1115     }
1116     return $session;
1117 }
1118
1119 sub checkpw {
1120
1121     my ( $dbh, $userid, $password ) = @_;
1122     if ($ldap) {
1123         $debug and print "## checkpw - checking LDAP\n";
1124         my ($retval,$retcard) = checkpw_ldap(@_);    # EXTERNAL AUTH
1125         ($retval) and return ($retval,$retcard);
1126     }
1127
1128     # INTERNAL AUTH
1129     my $sth =
1130       $dbh->prepare(
1131 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1132       );
1133     $sth->execute($userid);
1134     if ( $sth->rows ) {
1135         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1136             $surname, $branchcode, $flags )
1137           = $sth->fetchrow;
1138         if ( md5_base64($password) eq $md5password ) {
1139
1140             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1141                 $firstname, $surname, $branchcode, $flags );
1142             return 1, $cardnumber;
1143         }
1144     }
1145     $sth =
1146       $dbh->prepare(
1147 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1148       );
1149     $sth->execute($userid);
1150     if ( $sth->rows ) {
1151         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1152             $surname, $branchcode, $flags )
1153           = $sth->fetchrow;
1154         if ( md5_base64($password) eq $md5password ) {
1155
1156             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1157                 $firstname, $surname, $branchcode, $flags );
1158             return 1, $userid;
1159         }
1160     }
1161     if (   $userid && $userid eq C4::Context->config('user')
1162         && "$password" eq C4::Context->config('pass') )
1163     {
1164
1165 # Koha superuser account
1166 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1167         return 2;
1168     }
1169     if (   $userid && $userid eq 'demo'
1170         && "$password" eq 'demo'
1171         && C4::Context->config('demo') )
1172     {
1173
1174 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1175 # some features won't be effective : modify systempref, modify MARC structure,
1176         return 2;
1177     }
1178     return 0;
1179 }
1180
1181 =item getuserflags
1182
1183  $authflags = getuserflags($flags,$dbh);
1184 Translates integer flags into permissions strings hash.
1185
1186 C<$flags> is the integer userflags value ( borrowers.userflags )
1187 C<$authflags> is a hashref of permissions
1188
1189 =cut
1190
1191 sub getuserflags {
1192     my $flags   = shift;
1193     my $dbh     = shift;
1194     my $userflags;
1195     $flags = 0 unless $flags;
1196     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1197     $sth->execute;
1198
1199     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1200         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1201             $userflags->{$flag} = 1;
1202         }
1203         else {
1204             $userflags->{$flag} = 0;
1205         }
1206     }
1207     return $userflags;
1208 }
1209
1210 =item haspermission
1211
1212   $flags = ($dbh,$member,$flagsrequired);
1213
1214 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1215 C<$flags> is a hashref of required flags lik C<$borrower-&lt;{authflags}>
1216
1217 Returns member's flags or 0 if a permission is not met.
1218
1219 =cut
1220
1221 sub haspermission {
1222     my ( $dbh, $userid, $flagsrequired ) = @_;
1223     my ($flags,$intflags);
1224     $dbh=C4::Context->dbh unless($dbh);
1225     if(ref($userid)) {
1226         $intflags = $userid->{'flags'};
1227     } else {
1228         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1229         $sth->execute($userid);
1230         my ($intflags) = $sth->fetchrow;
1231         $flags = getuserflags( $intflags, $dbh );
1232     }
1233     if ( $userid eq C4::Context->config('user') ) {
1234         # Super User Account from /etc/koha.conf
1235         $flags->{'superlibrarian'} = 1;
1236     }
1237     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1238         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1239         $flags->{'superlibrarian'} = 1;
1240     }
1241     return $flags if $flags->{superlibrarian};
1242     foreach ( keys %$flagsrequired ) {
1243         return 0 unless( $flags->{$_} );
1244     }
1245     return $flags;
1246     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1247 }
1248
1249
1250 sub getborrowernumber {
1251     my ($userid) = @_;
1252     my $dbh = C4::Context->dbh;
1253     for my $field ( 'userid', 'cardnumber' ) {
1254         my $sth =
1255           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1256         $sth->execute($userid);
1257         if ( $sth->rows ) {
1258             my ($bnumber) = $sth->fetchrow;
1259             return $bnumber;
1260         }
1261     }
1262     return 0;
1263 }
1264
1265 END { }    # module clean-up code here (global destructor)
1266 1;
1267 __END__
1268
1269 =back
1270
1271 =head1 SEE ALSO
1272
1273 CGI(3)
1274
1275 C4::Output(3)
1276
1277 Digest::MD5(3)
1278
1279 =cut