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