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