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         TagsEnabled                  => C4::Context->preference("TagsEnabled"),
 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