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