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 "
 423             . C4::Context->config("kohaversion");
 424         if ($type ne 'opac'){
 425             warn sprintf($warning, 'Installer');
 426             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 427         } else {
 428             warn sprintf("OPAC: " . $warning, 'maintenance');
 429             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 430         }
 431         exit;
 432     }
 433 }
 434
 435 sub _session_log {
 436     (@_) or return 0;
 437     open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 438     printf L join("\n",@_);
 439     close L;
 440 }
 441
 442 sub checkauth {
 443     my $query = shift;
 444         $debug and warn "Checking Auth";
 445     # $authnotrequired will be set for scripts which will run without authentication
 446     my $authnotrequired = shift;
 447     my $flagsrequired   = shift;
 448     my $type            = shift;
 449     $type = 'opac' unless $type;
 450
 451     my $dbh     = C4::Context->dbh;
 452     my $timeout = C4::Context->preference('timeout');
 453     # days
 454     if ($timeout =~ /(\d+)[dD]/) {
 455         $timeout = $1 * 86400;
 456     };
 457     $timeout = 600 unless $timeout;
 458
 459     _version_check($type,$query);
 460     # state variables
 461     my $loggedin = 0;
 462     my %info;
 463     my ( $userid, $cookie, $sessionID, $flags, $shelves );
 464     my $logout = $query->param('logout.x');
 465     if ( $userid = $ENV{'REMOTE_USER'} ) {
 466         # Using Basic Authentication, no cookies required
 467         $cookie = $query->cookie(
 468             -name    => 'CGISESSID',
 469             -value   => '',
 470             -expires => ''
 471         );
 472         $loggedin = 1;
 473     }
 474     elsif ( $sessionID = $query->cookie("CGISESSID")) {     # assignment, not comparison
 475         my $session = get_session($sessionID);
 476         C4::Context->_new_userenv($sessionID);
 477         my ($ip, $lasttime);
 478         if ($session){
 479             C4::Context::set_userenv(
 480                 $session->param('number'),       $session->param('id'),
 481                 $session->param('cardnumber'),   $session->param('firstname'),
 482                 $session->param('surname'),      $session->param('branch'),
 483                 $session->param('branchname'),   $session->param('flags'),
 484                 $session->param('emailaddress'), $session->param('branchprinter')
 485             );
 486             C4::Context::set_shelves_userenv($session->param('shelves'));
 487             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 488             $ip       = $session->param('ip');
 489             $lasttime = $session->param('lasttime');
 490             $userid   = $session->param('id');
 491         }
 492
 493         if ($logout) {
 494             # voluntary logout the user
 495             $session->flush;
 496             $session->delete();
 497             C4::Context->_unset_userenv($sessionID);
 498             _session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,localtime);
 499             $sessionID = undef;
 500             $userid    = undef;
 501         }
 502                 elsif ( $lasttime < time() - $timeout ) {
 503                         # timed logout
 504                         $info{'timed_out'} = 1;
 505                         $session->delete();
 506                         C4::Context->_unset_userenv($sessionID);
 507                         _session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,localtime);
 508                         $userid    = undef;
 509                         $sessionID = undef;
 510                 }
 511                 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 512                         # Different ip than originally logged in from
 513                         $info{'oldip'}        = $ip;
 514                         $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 515                         $info{'different_ip'} = 1;
 516                         $session->delete();
 517                         C4::Context->_unset_userenv($sessionID);
 518                         _session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,localtime, $info{'newip'});
 519                         $sessionID = undef;
 520                         $userid    = undef;
 521                 }
 522                 else {
 523                         $cookie = $query->cookie( CGISESSID => $session->id );
 524                         $session->param('lasttime',time());
 525                         $flags = haspermission( $dbh, $userid, $flagsrequired );
 526                         if ($flags) {
 527                                 $loggedin = 1;
 528                         } else {
 529                                 $info{'nopermission'} = 1;
 530                         }
 531                 }
 532     }
 533     unless ($userid) {
 534         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 535         my $sessionID = $session->id;
 536         $userid    = $query->param('userid');
 537         my $password = $query->param('password');
 538         C4::Context->_new_userenv($sessionID);
 539         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 540         if ($return) {
 541             _session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},localtime);
 542             $cookie = $query->cookie(CGISESSID => $sessionID);
 543             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 544                                 $loggedin = 1;
 545             }
 546             else {
 547                 $info{'nopermission'} = 1;
 548                 C4::Context->_unset_userenv($sessionID);
 549             }
 550
 551                         my ($borrowernumber, $firstname, $surname, $userflags,
 552                                 $branchcode, $branchname, $branchprinter, $emailaddress);
 553
 554             if ( $return == 1 ) {
 555                 my $select = "
 556                 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 557                         branches.branchname    as branchname,
 558                         branches.branchprinter as branchprinter,
 559                         email
 560                 FROM borrowers
 561                 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 562                 ";
 563                 my $sth = $dbh->prepare("$select where userid=?");
 564                 $sth->execute($userid);
 565                                 unless ($sth->rows) {
 566                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 567                                         $sth = $dbh->prepare("$select where cardnumber=?");
 568                     $sth->execute($cardnumber);
 569                                         unless ($sth->rows) {
 570                                 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 571                         $sth->execute($userid);
 572                                                 unless ($sth->rows) {
 573                                         $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 574                                                 }
 575                                         }
 576                                 }
 577                 if ($sth->rows) {
 578                     ($borrowernumber, $firstname, $surname, $userflags,
 579                         $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 580                                         $debug and print STDERR "AUTH_3 results: " .
 581                                                 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 582                                 } else {
 583                                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 584                                 }
 585
 586 # launch a sequence to check if we have a ip for the branch, i
 587 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 588
 589                 my $ip       = $ENV{'REMOTE_ADDR'};
 590                 # if they specify at login, use that
 591                 if ($query->param('branch')) {
 592                     $branchcode  = $query->param('branch');
 593                     $branchname = GetBranchName($branchcode);
 594                 }
 595                 my $branches = GetBranches();
 596                 if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 597                                     # we have to check they are coming from the right ip range
 598                                         my $domain = $branches->{$branchcode}->{'branchip'};
 599                                         if ($ip !~ /^$domain/){
 600                                                 $loggedin=0;
 601                                                 $info{'wrongip'} = 1;
 602                                         }
 603                                 }
 604
 605                 my @branchesloop;
 606                 foreach my $br ( keys %$branches ) {
 607                     #     now we work with the treatment of ip
 608                     my $domain = $branches->{$br}->{'branchip'};
 609                     if ( $domain && $ip =~ /^$domain/ ) {
 610                         $branchcode = $branches->{$br}->{'branchcode'};
 611
 612                         # new op dev : add the branchprinter and branchname in the cookie
 613                         $branchprinter = $branches->{$br}->{'branchprinter'};
 614                         $branchname    = $branches->{$br}->{'branchname'};
 615                     }
 616                 }
 617                 $session->param('number',$borrowernumber);
 618                 $session->param('id',$userid);
 619                 $session->param('cardnumber',$cardnumber);
 620                 $session->param('firstname',$firstname);
 621                 $session->param('surname',$surname);
 622                 $session->param('branch',$branchcode);
 623                 $session->param('branchname',$branchname);
 624                 $session->param('flags',$userflags);
 625                 $session->param('emailaddress',$emailaddress);
 626                 $session->param('ip',$session->remote_addr());
 627                 $session->param('lasttime',time());
 628                 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 629             }
 630             elsif ( $return == 2 ) {
 631                 #We suppose the user is the superlibrarian
 632                                 $borrowernumber = 0;
 633                 $session->param('number',0);
 634                 $session->param('id',C4::Context->config('user'));
 635                 $session->param('cardnumber',C4::Context->config('user'));
 636                 $session->param('firstname',C4::Context->config('user'));
 637                 $session->param('surname',C4::Context->config('user'));
 638                 $session->param('branch','NO_LIBRARY_SET');
 639                 $session->param('branchname','NO_LIBRARY_SET');
 640                 $session->param('flags',1);
 641                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 642                 $session->param('ip',$session->remote_addr());
 643                 $session->param('lasttime',time());
 644             }
 645             C4::Context::set_userenv(
 646                 $session->param('number'),       $session->param('id'),
 647                 $session->param('cardnumber'),   $session->param('firstname'),
 648                 $session->param('surname'),      $session->param('branch'),
 649                 $session->param('branchname'),   $session->param('flags'),
 650                 $session->param('emailaddress'), $session->param('branchprinter')
 651             );
 652                         $shelves = GetShelvesSummary($borrowernumber,2,10);
 653                         $session->param('shelves', $shelves);
 654                         C4::Context::set_shelves_userenv($shelves);
 655         }
 656         else {
 657             if ($userid) {
 658                 $info{'invalid_username_or_password'} = 1;
 659                 C4::Context->_unset_userenv($sessionID);
 660             }
 661
 662         }
 663     }   # END unless ($userid)
 664     my $insecure = C4::Context->boolean_preference('insecure');
 665
 666     # finished authentification, now respond
 667     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 668     {
 669         # successful login
 670         unless ($cookie) {
 671             $cookie = $query->cookie( CGISESSID => '' );
 672         }
 673         return ( $userid, $cookie, $sessionID, $flags );
 674     }
 675
 676 #
 677 #
 678 # AUTH rejected, show the login/password template, after checking the DB.
 679 #
 680 #
 681
 682     # get the inputs from the incoming query
 683     my @inputs = ();
 684     foreach my $name ( param $query) {
 685         (next) if ( $name eq 'userid' || $name eq 'password' );
 686         my $value = $query->param($name);
 687         push @inputs, { name => $name, value => $value };
 688     }
 689     # get the branchloop, which we need for authentication
 690     my $branches = GetBranches();
 691     my @branch_loop;
 692     for my $branch_hash (sort keys %$branches) {
 693                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
 694     }
 695
 696     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
 697     my $template = gettemplate( $template_name, $type, $query );
 698     $template->param(branchloop => \@branch_loop,);
 699     $template->param(
 700     login        => 1,
 701         INPUTS               => \@inputs,
 702         suggestion           => C4::Context->preference("suggestion"),
 703         virtualshelves       => C4::Context->preference("virtualshelves"),
 704         opaclargeimage       => C4::Context->preference("opaclargeimage"),
 705         LibraryName          => C4::Context->preference("LibraryName"),
 706         opacuserlogin        => C4::Context->preference("opacuserlogin"),
 707         OpacNav              => C4::Context->preference("OpacNav"),
 708         opaccredits          => C4::Context->preference("opaccredits"),
 709         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 710         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 711         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 712         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 713         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 714         opacuserjs           => C4::Context->preference("opacuserjs"),
 715         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
 716         OpacCloud            => C4::Context->preference("OpacCloud"),
 717         OpacTopissue         => C4::Context->preference("OpacTopissue"),
 718         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
 719         OpacBrowser          => C4::Context->preference("OpacBrowser"),
 720         intranetcolorstylesheet =>
 721                                                                 C4::Context->preference("intranetcolorstylesheet"),
 722         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 723         IntranetNav        => C4::Context->preference("IntranetNav"),
 724         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 725         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 726         IndependantBranches=> C4::Context->preference("IndependantBranches"),
 727         AutoLocation       => C4::Context->preference("AutoLocation"),
 728         yuipath            => C4::Context->preference("yuipath"),
 729                 wrongip            => $info{'wrongip'}
 730     );
 731
 732     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 733
 734     my $self_url = $query->url( -absolute => 1 );
 735     $template->param(
 736         url         => $self_url,
 737         LibraryName => C4::Context->preference("LibraryName"),
 738     );
 739     $template->param( \%info );
 740 #    $cookie = $query->cookie(CGISESSID => $session->id
 741 #   );
 742     print $query->header(
 743         -type   => 'text/html',
 744         -charset => 'utf-8',
 745         -cookie => $cookie
 746       ),
 747       $template->output;
 748     exit;
 749 }
 750
 751 =item check_api_auth
 752
 753   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 754
 755 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 756 cookie, determine if the user has the privileges specified by C<$userflags>.
 757
 758 C<check_api_auth> is is meant for authenticating users of web services, and
 759 consequently will always return and will not attempt to redirect the user
 760 agent.
 761
 762 If a valid session cookie is already present, check_api_auth will return a status
 763 of "ok", the cookie, and the Koha session ID.
 764
 765 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 766 parameters and create a session cookie and Koha session if the supplied credentials
 767 are OK.
 768
 769 Possible return values in C<$status> are:
 770
 771 =over 4
 772
 773 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 774
 775 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 776
 777 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 778
 779 =item "expired -- session cookie has expired; API user should resubmit userid and password
 780
 781 =back
 782
 783 =cut
 784
 785 sub check_api_auth {
 786     my $query = shift;
 787     my $flagsrequired = shift;
 788
 789     my $dbh     = C4::Context->dbh;
 790     my $timeout = C4::Context->preference('timeout');
 791     $timeout = 600 unless $timeout;
 792
 793     unless (C4::Context->preference('Version')) {
 794         # database has not been installed yet
 795         return ("maintenance", undef, undef);
 796     }
 797     my $kohaversion=C4::Context::KOHAVERSION;
 798     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 799     if (C4::Context->preference('Version') < $kohaversion) {
 800         # database in need of version update; assume that
 801         # no API should be called while databsae is in
 802         # this condition.
 803         return ("maintenance", undef, undef);
 804     }
 805
 806     # FIXME -- most of what follows is a copy-and-paste
 807     # of code from checkauth.  There is an obvious need
 808     # for refactoring to separate the various parts of
 809     # the authentication code, but as of 2007-11-19 this
 810     # is deferred so as to not introduce bugs into the
 811     # regular authentication code for Koha 3.0.
 812
 813     # see if we have a valid session cookie already
 814     # however, if a userid parameter is present (i.e., from
 815     # a form submission, assume that any current cookie
 816     # is to be ignored
 817     my $sessionID = undef;
 818     unless ($query->param('userid')) {
 819         $sessionID = $query->cookie("CGISESSID");
 820     }
 821     if ($sessionID) {
 822         my $session = get_session($sessionID);
 823         C4::Context->_new_userenv($sessionID);
 824         if ($session) {
 825             C4::Context::set_userenv(
 826                 $session->param('number'),       $session->param('id'),
 827                 $session->param('cardnumber'),   $session->param('firstname'),
 828                 $session->param('surname'),      $session->param('branch'),
 829                 $session->param('branchname'),   $session->param('flags'),
 830                 $session->param('emailaddress'), $session->param('branchprinter')
 831             );
 832
 833             my $ip = $session->param('ip');
 834             my $lasttime = $session->param('lasttime');
 835             my $userid = $session->param('id');
 836             if ( $lasttime < time() - $timeout ) {
 837                 # time out
 838                 $session->delete();
 839                 C4::Context->_unset_userenv($sessionID);
 840                 $userid    = undef;
 841                 $sessionID = undef;
 842                 return ("expired", undef, undef);
 843             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 844                 # IP address changed
 845                 $session->delete();
 846                 C4::Context->_unset_userenv($sessionID);
 847                 $userid    = undef;
 848                 $sessionID = undef;
 849                 return ("expired", undef, undef);
 850             } else {
 851                 my $cookie = $query->cookie( CGISESSID => $session->id );
 852                 $session->param('lasttime',time());
 853                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 854                 if ($flags) {
 855                     return ("ok", $cookie, $sessionID);
 856                 } else {
 857                     $session->delete();
 858                     C4::Context->_unset_userenv($sessionID);
 859                     $userid    = undef;
 860                     $sessionID = undef;
 861                     return ("failed", undef, undef);
 862                 }
 863             }
 864         } else {
 865             return ("expired", undef, undef);
 866         }
 867     } else {
 868         # new login
 869         my $userid = $query->param('userid');
 870         my $password = $query->param('password');
 871         unless ($userid and $password) {
 872             # caller did something wrong, fail the authenticateion
 873             return ("failed", undef, undef);
 874         }
 875         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 876         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 877             my $session = get_session("");
 878             return ("failed", undef, undef) unless $session;
 879
 880             my $sessionID = $session->id;
 881             C4::Context->_new_userenv($sessionID);
 882             my $cookie = $query->cookie(CGISESSID => $sessionID);
 883             if ( $return == 1 ) {
 884                 my (
 885                     $borrowernumber, $firstname,  $surname,
 886                     $userflags,      $branchcode, $branchname,
 887                     $branchprinter,  $emailaddress
 888                 );
 889                 my $sth =
 890                   $dbh->prepare(
 891 "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=?"
 892                   );
 893                 $sth->execute($userid);
 894                 (
 895                     $borrowernumber, $firstname,  $surname,
 896                     $userflags,      $branchcode, $branchname,
 897                     $branchprinter,  $emailaddress
 898                 ) = $sth->fetchrow if ( $sth->rows );
 899
 900                 unless ($sth->rows ) {
 901                     my $sth = $dbh->prepare(
 902 "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=?"
 903                       );
 904                     $sth->execute($cardnumber);
 905                     (
 906                         $borrowernumber, $firstname,  $surname,
 907                         $userflags,      $branchcode, $branchname,
 908                         $branchprinter,  $emailaddress
 909                     ) = $sth->fetchrow if ( $sth->rows );
 910
 911                     unless ( $sth->rows ) {
 912                         $sth->execute($userid);
 913                         (
 914                             $borrowernumber, $firstname, $surname, $userflags,
 915                             $branchcode, $branchname, $branchprinter, $emailaddress
 916                         ) = $sth->fetchrow if ( $sth->rows );
 917                     }
 918                 }
 919
 920                 my $ip       = $ENV{'REMOTE_ADDR'};
 921                 # if they specify at login, use that
 922                 if ($query->param('branch')) {
 923                     $branchcode  = $query->param('branch');
 924                     $branchname = GetBranchName($branchcode);
 925                 }
 926                 my $branches = GetBranches();
 927                 my @branchesloop;
 928                 foreach my $br ( keys %$branches ) {
 929                     #     now we work with the treatment of ip
 930                     my $domain = $branches->{$br}->{'branchip'};
 931                     if ( $domain && $ip =~ /^$domain/ ) {
 932                         $branchcode = $branches->{$br}->{'branchcode'};
 933
 934                         # new op dev : add the branchprinter and branchname in the cookie
 935                         $branchprinter = $branches->{$br}->{'branchprinter'};
 936                         $branchname    = $branches->{$br}->{'branchname'};
 937                     }
 938                 }
 939                 $session->param('number',$borrowernumber);
 940                 $session->param('id',$userid);
 941                 $session->param('cardnumber',$cardnumber);
 942                 $session->param('firstname',$firstname);
 943                 $session->param('surname',$surname);
 944                 $session->param('branch',$branchcode);
 945                 $session->param('branchname',$branchname);
 946                 $session->param('flags',$userflags);
 947                 $session->param('emailaddress',$emailaddress);
 948                 $session->param('ip',$session->remote_addr());
 949                 $session->param('lasttime',time());
 950             } elsif ( $return == 2 ) {
 951                 #We suppose the user is the superlibrarian
 952                 $session->param('number',0);
 953                 $session->param('id',C4::Context->config('user'));
 954                 $session->param('cardnumber',C4::Context->config('user'));
 955                 $session->param('firstname',C4::Context->config('user'));
 956                 $session->param('surname',C4::Context->config('user'));
 957                 $session->param('branch','NO_LIBRARY_SET');
 958                 $session->param('branchname','NO_LIBRARY_SET');
 959                 $session->param('flags',1);
 960                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 961                 $session->param('ip',$session->remote_addr());
 962                 $session->param('lasttime',time());
 963             }
 964             C4::Context::set_userenv(
 965                 $session->param('number'),       $session->param('id'),
 966                 $session->param('cardnumber'),   $session->param('firstname'),
 967                 $session->param('surname'),      $session->param('branch'),
 968                 $session->param('branchname'),   $session->param('flags'),
 969                 $session->param('emailaddress'), $session->param('branchprinter')
 970             );
 971             return ("ok", $cookie, $sessionID);
 972         } else {
 973             return ("failed", undef, undef);
 974         }
 975     }
 976 }
 977
 978 =item check_cookie_auth
 979
 980   ($status, $sessionId) = check_api_auth($cookie, $userflags);
 981
 982 Given a CGISESSID cookie set during a previous login to Koha, determine
 983 if the user has the privileges specified by C<$userflags>.
 984
 985 C<check_cookie_auth> is meant for authenticating special services
 986 such as tools/upload-file.pl that are invoked by other pages that
 987 have been authenticated in the usual way.
 988
 989 Possible return values in C<$status> are:
 990
 991 =over 4
 992
 993 =item "ok" -- user authenticated; C<$sessionID> have valid values.
 994
 995 =item "failed" -- credentials are not correct; C<$sessionid> are undef
 996
 997 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 998
 999 =item "expired -- session cookie has expired; API user should resubmit userid and password
1000
1001 =back
1002
1003 =cut
1004
1005 sub check_cookie_auth {
1006     my $cookie = shift;
1007     my $flagsrequired = shift;
1008
1009     my $dbh     = C4::Context->dbh;
1010     my $timeout = C4::Context->preference('timeout');
1011     $timeout = 600 unless $timeout;
1012
1013     unless (C4::Context->preference('Version')) {
1014         # database has not been installed yet
1015         return ("maintenance", undef);
1016     }
1017     my $kohaversion=C4::Context::KOHAVERSION;
1018     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1019     if (C4::Context->preference('Version') < $kohaversion) {
1020         # database in need of version update; assume that
1021         # no API should be called while databsae is in
1022         # this condition.
1023         return ("maintenance", undef);
1024     }
1025
1026     # FIXME -- most of what follows is a copy-and-paste
1027     # of code from checkauth.  There is an obvious need
1028     # for refactoring to separate the various parts of
1029     # the authentication code, but as of 2007-11-23 this
1030     # is deferred so as to not introduce bugs into the
1031     # regular authentication code for Koha 3.0.
1032
1033     # see if we have a valid session cookie already
1034     # however, if a userid parameter is present (i.e., from
1035     # a form submission, assume that any current cookie
1036     # is to be ignored
1037     unless (defined $cookie and $cookie) {
1038         return ("failed", undef);
1039     }
1040     my $sessionID = $cookie;
1041     my $session = get_session($sessionID);
1042     C4::Context->_new_userenv($sessionID);
1043     if ($session) {
1044         C4::Context::set_userenv(
1045             $session->param('number'),       $session->param('id'),
1046             $session->param('cardnumber'),   $session->param('firstname'),
1047             $session->param('surname'),      $session->param('branch'),
1048             $session->param('branchname'),   $session->param('flags'),
1049             $session->param('emailaddress'), $session->param('branchprinter')
1050         );
1051
1052         my $ip = $session->param('ip');
1053         my $lasttime = $session->param('lasttime');
1054         my $userid = $session->param('id');
1055         if ( $lasttime < time() - $timeout ) {
1056             # time out
1057             $session->delete();
1058             C4::Context->_unset_userenv($sessionID);
1059             $userid    = undef;
1060             $sessionID = undef;
1061             return ("expired", undef);
1062         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1063             # IP address changed
1064             $session->delete();
1065             C4::Context->_unset_userenv($sessionID);
1066             $userid    = undef;
1067             $sessionID = undef;
1068             return ("expired", undef);
1069         } else {
1070             $session->param('lasttime',time());
1071             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1072             if ($flags) {
1073                 return ("ok", $sessionID);
1074             } else {
1075                 $session->delete();
1076                 C4::Context->_unset_userenv($sessionID);
1077                 $userid    = undef;
1078                 $sessionID = undef;
1079                 return ("failed", undef);
1080             }
1081         }
1082     } else {
1083         return ("expired", undef);
1084     }
1085 }
1086
1087 =item get_session
1088
1089   use CGI::Session;
1090   my $session = get_session($sessionID);
1091
1092 Given a session ID, retrieve the CGI::Session object used to store
1093 the session's state.  The session object can be used to store
1094 data that needs to be accessed by different scripts during a
1095 user's session.
1096
1097 If the C<$sessionID> parameter is an empty string, a new session
1098 will be created.
1099
1100 =cut
1101
1102 sub get_session {
1103     my $sessionID = shift;
1104     my $storage_method = C4::Context->preference('SessionStorage');
1105     my $dbh = C4::Context->dbh;
1106     my $session;
1107     if ($storage_method eq 'mysql'){
1108         $session = new CGI::Session("driver:MySQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1109     }
1110     elsif ($storage_method eq 'Pg') {
1111         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1112     }
1113     else {
1114         # catch all defaults to tmp should work on all systems
1115         $session = new CGI::Session("driver:File;serializer:yaml", $sessionID, {Directory=>'/tmp'});
1116     }
1117     return $session;
1118 }
1119
1120 sub checkpw {
1121
1122     my ( $dbh, $userid, $password ) = @_;
1123     if ($ldap) {
1124         $debug and print "## checkpw - checking LDAP\n";
1125         my ($retval,$retcard) = checkpw_ldap(@_);    # EXTERNAL AUTH
1126         ($retval) and return ($retval,$retcard);
1127     }
1128
1129     # INTERNAL AUTH
1130     my $sth =
1131       $dbh->prepare(
1132 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1133       );
1134     $sth->execute($userid);
1135     if ( $sth->rows ) {
1136         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1137             $surname, $branchcode, $flags )
1138           = $sth->fetchrow;
1139         if ( md5_base64($password) eq $md5password ) {
1140
1141             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1142                 $firstname, $surname, $branchcode, $flags );
1143             return 1, $cardnumber;
1144         }
1145     }
1146     $sth =
1147       $dbh->prepare(
1148 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1149       );
1150     $sth->execute($userid);
1151     if ( $sth->rows ) {
1152         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1153             $surname, $branchcode, $flags )
1154           = $sth->fetchrow;
1155         if ( md5_base64($password) eq $md5password ) {
1156
1157             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1158                 $firstname, $surname, $branchcode, $flags );
1159             return 1, $userid;
1160         }
1161     }
1162     if (   $userid && $userid eq C4::Context->config('user')
1163         && "$password" eq C4::Context->config('pass') )
1164     {
1165
1166 # Koha superuser account
1167 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1168         return 2;
1169     }
1170     if (   $userid && $userid eq 'demo'
1171         && "$password" eq 'demo'
1172         && C4::Context->config('demo') )
1173     {
1174
1175 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1176 # some features won't be effective : modify systempref, modify MARC structure,
1177         return 2;
1178     }
1179     return 0;
1180 }
1181
1182 =item getuserflags
1183
1184  $authflags = getuserflags($flags,$dbh);
1185 Translates integer flags into permissions strings hash.
1186
1187 C<$flags> is the integer userflags value ( borrowers.userflags )
1188 C<$authflags> is a hashref of permissions
1189
1190 =cut
1191
1192 sub getuserflags {
1193     my $flags   = shift;
1194     my $dbh     = shift;
1195     my $userflags;
1196     $flags = 0 unless $flags;
1197     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1198     $sth->execute;
1199
1200     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1201         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1202             $userflags->{$flag} = 1;
1203         }
1204         else {
1205             $userflags->{$flag} = 0;
1206         }
1207     }
1208     return $userflags;
1209 }
1210
1211 =item haspermission
1212
1213   $flags = ($dbh,$member,$flagsrequired);
1214
1215 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1216 C<$flags> is a hashref of required flags lik C<$borrower-&lt;{authflags}>
1217
1218 Returns member's flags or 0 if a permission is not met.
1219
1220 =cut
1221
1222 sub haspermission {
1223     my ( $dbh, $userid, $flagsrequired ) = @_;
1224     my ($flags,$intflags);
1225     $dbh=C4::Context->dbh unless($dbh);
1226     if(ref($userid)) {
1227         $intflags = $userid->{'flags'};
1228     } else {
1229         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1230         $sth->execute($userid);
1231         my ($intflags) = $sth->fetchrow;
1232         $flags = getuserflags( $intflags, $dbh );
1233     }
1234     if ( $userid eq C4::Context->config('user') ) {
1235         # Super User Account from /etc/koha.conf
1236         $flags->{'superlibrarian'} = 1;
1237     }
1238     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1239         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1240         $flags->{'superlibrarian'} = 1;
1241     }
1242     return $flags if $flags->{superlibrarian};
1243     foreach ( keys %$flagsrequired ) {
1244         return 0 unless( $flags->{$_} );
1245     }
1246     return $flags;
1247     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1248 }
1249
1250
1251 sub getborrowernumber {
1252     my ($userid) = @_;
1253     my $dbh = C4::Context->dbh;
1254     for my $field ( 'userid', 'cardnumber' ) {
1255         my $sth =
1256           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1257         $sth->execute($userid);
1258         if ( $sth->rows ) {
1259             my ($bnumber) = $sth->fetchrow;
1260             return $bnumber;
1261         }
1262     }
1263     return 0;
1264 }
1265
1266 END { }    # module clean-up code here (global destructor)
1267 1;
1268 __END__
1269
1270 =back
1271
1272 =head1 SEE ALSO
1273
1274 CGI(3)
1275
1276 C4::Output(3)
1277
1278 Digest::MD5(3)
1279
1280 =cut