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