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