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         # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 431         if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
 432                 warn "OPAC Install required, redirecting to maintenance";
 433                 print $query->redirect("/cgi-bin/koha/maintenance.pl");
 434         }
 435     unless ($version = C4::Context->preference('Version')) {    # assignment, not comparison
 436       if ($type ne 'opac') {
 437         warn "Install required, redirecting to Installer";
 438         print $query->redirect("/cgi-bin/koha/installer/install.pl");
 439       }
 440       else {
 441         warn "OPAC Install required, redirecting to maintenance";
 442         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 443       }
 444       exit;
 445     }
 446
 447     # check that database and koha version are the same
 448     # there is no DB version, it's a fresh install,
 449     # go to web installer
 450     # there is a DB version, compare it to the code version
 451     my $kohaversion=C4::Context::KOHAVERSION;
 452     # remove the 3 last . to have a Perl number
 453     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 454     $debug and print STDERR "kohaversion : $kohaversion\n";
 455     if ($version < $kohaversion){
 456         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 457         if ($type ne 'opac'){
 458             warn sprintf($warning, 'Installer');
 459             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 460         } else {
 461             warn sprintf("OPAC: " . $warning, 'maintenance');
 462             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 463         }
 464         exit;
 465     }
 466 }
 467
 468 sub _session_log {
 469     (@_) or return 0;
 470     open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 471     printf L join("\n",@_);
 472     close L;
 473 }
 474
 475 sub checkauth {
 476     my $query = shift;
 477         $debug and warn "Checking Auth";
 478     # $authnotrequired will be set for scripts which will run without authentication
 479     my $authnotrequired = shift;
 480     my $flagsrequired   = shift;
 481     my $type            = shift;
 482     $type = 'opac' unless $type;
 483
 484     my $dbh     = C4::Context->dbh;
 485     my $timeout = C4::Context->preference('timeout');
 486     # days
 487     if ($timeout =~ /(\d+)[dD]/) {
 488         $timeout = $1 * 86400;
 489     };
 490     $timeout = 600 unless $timeout;
 491
 492     _version_check($type,$query);
 493     # state variables
 494     my $loggedin = 0;
 495     my %info;
 496     my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
 497     my $logout = $query->param('logout.x');
 498
 499     if ( $userid = $ENV{'REMOTE_USER'} ) {
 500         # Using Basic Authentication, no cookies required
 501         $cookie = $query->cookie(
 502             -name    => 'CGISESSID',
 503             -value   => '',
 504             -expires => ''
 505         );
 506         $loggedin = 1;
 507     }
 508     elsif ( $sessionID = $query->cookie("CGISESSID")) {     # assignment, not comparison
 509         my $session = get_session($sessionID);
 510         C4::Context->_new_userenv($sessionID);
 511         my ($ip, $lasttime, $sessiontype);
 512         if ($session){
 513             C4::Context::set_userenv(
 514                 $session->param('number'),       $session->param('id'),
 515                 $session->param('cardnumber'),   $session->param('firstname'),
 516                 $session->param('surname'),      $session->param('branch'),
 517                 $session->param('branchname'),   $session->param('flags'),
 518                 $session->param('emailaddress'), $session->param('branchprinter')
 519             );
 520             C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
 521             C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
 522             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 523             $ip       = $session->param('ip');
 524             $lasttime = $session->param('lasttime');
 525             $userid   = $session->param('id');
 526                         $sessiontype = $session->param('sessiontype');
 527         }
 528
 529                 if ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) ) {
 530                         #if a user enters an id ne to the id in the current session, we need to log them in...
 531                         #first we need to clear the anonymous session...
 532                         $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
 533             $session->flush;
 534             $session->delete();
 535             C4::Context->_unset_userenv($sessionID);
 536                         $sessionID = undef;
 537                         $userid = undef;
 538                 }
 539         elsif ($logout) {
 540             # voluntary logout the user
 541             $session->flush;
 542             $session->delete();
 543             C4::Context->_unset_userenv($sessionID);
 544             _session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,localtime);
 545             $sessionID = undef;
 546             $userid    = undef;
 547         }
 548                 elsif ( $lasttime < time() - $timeout ) {
 549                         # timed logout
 550                         $info{'timed_out'} = 1;
 551                         $session->delete();
 552                         C4::Context->_unset_userenv($sessionID);
 553                         _session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,localtime);
 554                         $userid    = undef;
 555                         $sessionID = undef;
 556                 }
 557                 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 558                         # Different ip than originally logged in from
 559                         $info{'oldip'}        = $ip;
 560                         $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 561                         $info{'different_ip'} = 1;
 562                         $session->delete();
 563                         C4::Context->_unset_userenv($sessionID);
 564                         _session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,localtime, $info{'newip'});
 565                         $sessionID = undef;
 566                         $userid    = undef;
 567                 }
 568                 else {
 569                         $cookie = $query->cookie( CGISESSID => $session->id );
 570                         $session->param('lasttime',time());
 571                         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...
 572                                 $flags = haspermission( $dbh, $userid, $flagsrequired );
 573                                 if ($flags) {
 574                                         $loggedin = 1;
 575                                 } else {
 576                                         $info{'nopermission'} = 1;
 577                                 }
 578                         }
 579                 }
 580     }
 581     unless ($userid || $sessionID) {
 582         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 583                 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 584         my $sessionID = $session->id;
 585         C4::Context->_new_userenv($sessionID);
 586         $cookie = $query->cookie(CGISESSID => $sessionID);
 587                 if ( $userid    = $query->param('userid') ) {
 588                 my $password = $query->param('password');
 589                 my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 590                 if ($return) {
 591                 _session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},localtime);
 592                 if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 593                                         $loggedin = 1;
 594                 }
 595                         else {
 596                         $info{'nopermission'} = 1;
 597                         C4::Context->_unset_userenv($sessionID);
 598                 }
 599
 600                                 my ($borrowernumber, $firstname, $surname, $userflags,
 601                                         $branchcode, $branchname, $branchprinter, $emailaddress);
 602
 603                 if ( $return == 1 ) {
 604                         my $select = "
 605                         SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 606                             branches.branchname    as branchname,
 607                                 branches.branchprinter as branchprinter,
 608                                 email
 609                         FROM borrowers
 610                         LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 611                         ";
 612                         my $sth = $dbh->prepare("$select where userid=?");
 613                         $sth->execute($userid);
 614                                         unless ($sth->rows) {
 615                                 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 616                                                 $sth = $dbh->prepare("$select where cardnumber=?");
 617                                 $sth->execute($cardnumber);
 618                                                 unless ($sth->rows) {
 619                                         $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 620                                 $sth->execute($userid);
 621                                                         unless ($sth->rows) {
 622                                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 623                                                         }
 624                                                 }
 625                                         }
 626                         if ($sth->rows) {
 627                         ($borrowernumber, $firstname, $surname, $userflags,
 628                                 $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 629                                                 $debug and print STDERR "AUTH_3 results: " .
 630                                                         "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 631                                         } else {
 632                                                 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 633                                         }
 634
 635 # launch a sequence to check if we have a ip for the branch, i
 636 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 637
 638                                         my $ip       = $ENV{'REMOTE_ADDR'};
 639                                         # if they specify at login, use that
 640                                         if ($query->param('branch')) {
 641                                                 $branchcode  = $query->param('branch');
 642                                                 $branchname = GetBranchName($branchcode);
 643                                         }
 644                                         my $branches = GetBranches();
 645                                         if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 646                                                 # we have to check they are coming from the right ip range
 647                                                 my $domain = $branches->{$branchcode}->{'branchip'};
 648                                                 if ($ip !~ /^$domain/){
 649                                                         $loggedin=0;
 650                                                         $info{'wrongip'} = 1;
 651                                                 }
 652                                         }
 653
 654                                         my @branchesloop;
 655                                         foreach my $br ( keys %$branches ) {
 656                                                 #     now we work with the treatment of ip
 657                                                 my $domain = $branches->{$br}->{'branchip'};
 658                                                 if ( $domain && $ip =~ /^$domain/ ) {
 659                                                         $branchcode = $branches->{$br}->{'branchcode'};
 660
 661                                                         # new op dev : add the branchprinter and branchname in the cookie
 662                                                         $branchprinter = $branches->{$br}->{'branchprinter'};
 663                                                         $branchname    = $branches->{$br}->{'branchname'};
 664                                                 }
 665                                         }
 666                                         $session->param('number',$borrowernumber);
 667                                         $session->param('id',$userid);
 668                                         $session->param('cardnumber',$cardnumber);
 669                                         $session->param('firstname',$firstname);
 670                                         $session->param('surname',$surname);
 671                                         $session->param('branch',$branchcode);
 672                                         $session->param('branchname',$branchname);
 673                                         $session->param('flags',$userflags);
 674                                         $session->param('emailaddress',$emailaddress);
 675                                         $session->param('ip',$session->remote_addr());
 676                                         $session->param('lasttime',time());
 677                                         $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 678                                 }
 679                                 elsif ( $return == 2 ) {
 680                                         #We suppose the user is the superlibrarian
 681                                         $borrowernumber = 0;
 682                                         $session->param('number',0);
 683                                         $session->param('id',C4::Context->config('user'));
 684                                         $session->param('cardnumber',C4::Context->config('user'));
 685                                         $session->param('firstname',C4::Context->config('user'));
 686                                         $session->param('surname',C4::Context->config('user'));
 687                                         $session->param('branch','NO_LIBRARY_SET');
 688                                         $session->param('branchname','NO_LIBRARY_SET');
 689                                         $session->param('flags',1);
 690                                         $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 691                                         $session->param('ip',$session->remote_addr());
 692                                         $session->param('lasttime',time());
 693                                 }
 694                                 C4::Context::set_userenv(
 695                                         $session->param('number'),       $session->param('id'),
 696                                         $session->param('cardnumber'),   $session->param('firstname'),
 697                                         $session->param('surname'),      $session->param('branch'),
 698                                         $session->param('branchname'),   $session->param('flags'),
 699                                         $session->param('emailaddress'), $session->param('branchprinter')
 700                                 );
 701
 702                                 # Grab borrower's shelves and add to the session...
 703                                 $barshelves = GetShelvesSummary($borrowernumber,2,10);
 704                                 $session->param('barshelves', $barshelves);
 705                                 C4::Context::set_shelves_userenv('bar',$barshelves);
 706
 707                                 # Grab the public shelves and add to the session...
 708                                 $pubshelves = GetShelvesSummary(0,2,10);
 709                                 $session->param('pubshelves', $pubshelves);
 710                                 C4::Context::set_shelves_userenv('pub',$pubshelves);
 711                         }
 712                 else {
 713                 if ($userid) {
 714                         $info{'invalid_username_or_password'} = 1;
 715                         C4::Context->_unset_userenv($sessionID);
 716                 }
 717                         }
 718         }       # END if ( $userid    = $query->param('userid') )
 719                 elsif ($type eq "opac") {
 720             # if we are here this is an anonymous session; add public lists to it and a few other items...
 721             # anonymous sessions are created only for the OPAC
 722                         $debug and warn "Initiating an anonymous session...";
 723
 724                         # Grab the public shelves and add to the session...
 725                         $pubshelves = GetShelvesSummary(0,2,10);
 726                         $session->param('pubshelves', $pubshelves);
 727                         C4::Context::set_shelves_userenv('pub',$pubshelves);
 728
 729                         # setting a couple of other session vars...
 730                         $session->param('ip',$session->remote_addr());
 731                         $session->param('lasttime',time());
 732                         $session->param('sessiontype','anon');
 733                 }
 734     }   # END unless ($userid)
 735     my $insecure = C4::Context->boolean_preference('insecure');
 736
 737     # finished authentification, now respond
 738     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 739     {
 740         # successful login
 741         unless ($cookie) {
 742             $cookie = $query->cookie( CGISESSID => '' );
 743         }
 744         return ( $userid, $cookie, $sessionID, $flags );
 745     }
 746
 747 #
 748 #
 749 # AUTH rejected, show the login/password template, after checking the DB.
 750 #
 751 #
 752
 753     # get the inputs from the incoming query
 754     my @inputs = ();
 755     foreach my $name ( param $query) {
 756         (next) if ( $name eq 'userid' || $name eq 'password' );
 757         my $value = $query->param($name);
 758         push @inputs, { name => $name, value => $value };
 759     }
 760     # get the branchloop, which we need for authentication
 761     my $branches = GetBranches();
 762     my @branch_loop;
 763     for my $branch_hash (sort keys %$branches) {
 764                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
 765     }
 766
 767     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
 768     my $template = gettemplate( $template_name, $type, $query );
 769     $template->param(branchloop => \@branch_loop,);
 770     $template->param(
 771     login        => 1,
 772         INPUTS               => \@inputs,
 773         suggestion           => C4::Context->preference("suggestion"),
 774         virtualshelves       => C4::Context->preference("virtualshelves"),
 775         LibraryName          => C4::Context->preference("LibraryName"),
 776         opacuserlogin        => C4::Context->preference("opacuserlogin"),
 777         OpacNav              => C4::Context->preference("OpacNav"),
 778         opaccredits          => C4::Context->preference("opaccredits"),
 779         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 780         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 781         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 782         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 783         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 784         opacuserjs           => C4::Context->preference("opacuserjs"),
 785         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
 786         OpacCloud            => C4::Context->preference("OpacCloud"),
 787         OpacTopissue         => C4::Context->preference("OpacTopissue"),
 788         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
 789         OpacBrowser          => C4::Context->preference("OpacBrowser"),
 790         opacheader           => C4::Context->preference("opacheader"),
 791         TagsEnabled                  => C4::Context->preference("TagsEnabled"),
 792         OPACUserCSS           => C4::Context->preference("OPACUserCSS"),
 793         intranetcolorstylesheet =>
 794                                                                 C4::Context->preference("intranetcolorstylesheet"),
 795         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 796         IntranetNav        => C4::Context->preference("IntranetNav"),
 797         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 798         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 799         IndependantBranches=> C4::Context->preference("IndependantBranches"),
 800         AutoLocation       => C4::Context->preference("AutoLocation"),
 801                 wrongip            => $info{'wrongip'}
 802     );
 803
 804     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 805
 806     my $self_url = $query->url( -absolute => 1 );
 807     $template->param(
 808         url         => $self_url,
 809         LibraryName => C4::Context->preference("LibraryName"),
 810     );
 811     $template->param( \%info );
 812 #    $cookie = $query->cookie(CGISESSID => $session->id
 813 #   );
 814     print $query->header(
 815         -type   => 'text/html',
 816         -charset => 'utf-8',
 817         -cookie => $cookie
 818       ),
 819       $template->output;
 820     exit;
 821 }
 822
 823 =item check_api_auth
 824
 825   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 826
 827 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 828 cookie, determine if the user has the privileges specified by C<$userflags>.
 829
 830 C<check_api_auth> is is meant for authenticating users of web services, and
 831 consequently will always return and will not attempt to redirect the user
 832 agent.
 833
 834 If a valid session cookie is already present, check_api_auth will return a status
 835 of "ok", the cookie, and the Koha session ID.
 836
 837 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 838 parameters and create a session cookie and Koha session if the supplied credentials
 839 are OK.
 840
 841 Possible return values in C<$status> are:
 842
 843 =over 4
 844
 845 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 846
 847 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 848
 849 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 850
 851 =item "expired -- session cookie has expired; API user should resubmit userid and password
 852
 853 =back
 854
 855 =cut
 856
 857 sub check_api_auth {
 858     my $query = shift;
 859     my $flagsrequired = shift;
 860
 861     my $dbh     = C4::Context->dbh;
 862     my $timeout = C4::Context->preference('timeout');
 863     $timeout = 600 unless $timeout;
 864
 865     unless (C4::Context->preference('Version')) {
 866         # database has not been installed yet
 867         return ("maintenance", undef, undef);
 868     }
 869     my $kohaversion=C4::Context::KOHAVERSION;
 870     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 871     if (C4::Context->preference('Version') < $kohaversion) {
 872         # database in need of version update; assume that
 873         # no API should be called while databsae is in
 874         # this condition.
 875         return ("maintenance", undef, undef);
 876     }
 877
 878     # FIXME -- most of what follows is a copy-and-paste
 879     # of code from checkauth.  There is an obvious need
 880     # for refactoring to separate the various parts of
 881     # the authentication code, but as of 2007-11-19 this
 882     # is deferred so as to not introduce bugs into the
 883     # regular authentication code for Koha 3.0.
 884
 885     # see if we have a valid session cookie already
 886     # however, if a userid parameter is present (i.e., from
 887     # a form submission, assume that any current cookie
 888     # is to be ignored
 889     my $sessionID = undef;
 890     unless ($query->param('userid')) {
 891         $sessionID = $query->cookie("CGISESSID");
 892     }
 893     if ($sessionID) {
 894         my $session = get_session($sessionID);
 895         C4::Context->_new_userenv($sessionID);
 896         if ($session) {
 897             C4::Context::set_userenv(
 898                 $session->param('number'),       $session->param('id'),
 899                 $session->param('cardnumber'),   $session->param('firstname'),
 900                 $session->param('surname'),      $session->param('branch'),
 901                 $session->param('branchname'),   $session->param('flags'),
 902                 $session->param('emailaddress'), $session->param('branchprinter')
 903             );
 904
 905             my $ip = $session->param('ip');
 906             my $lasttime = $session->param('lasttime');
 907             my $userid = $session->param('id');
 908             if ( $lasttime < time() - $timeout ) {
 909                 # time out
 910                 $session->delete();
 911                 C4::Context->_unset_userenv($sessionID);
 912                 $userid    = undef;
 913                 $sessionID = undef;
 914                 return ("expired", undef, undef);
 915             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 916                 # IP address changed
 917                 $session->delete();
 918                 C4::Context->_unset_userenv($sessionID);
 919                 $userid    = undef;
 920                 $sessionID = undef;
 921                 return ("expired", undef, undef);
 922             } else {
 923                 my $cookie = $query->cookie( CGISESSID => $session->id );
 924                 $session->param('lasttime',time());
 925                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 926                 if ($flags) {
 927                     return ("ok", $cookie, $sessionID);
 928                 } else {
 929                     $session->delete();
 930                     C4::Context->_unset_userenv($sessionID);
 931                     $userid    = undef;
 932                     $sessionID = undef;
 933                     return ("failed", undef, undef);
 934                 }
 935             }
 936         } else {
 937             return ("expired", undef, undef);
 938         }
 939     } else {
 940         # new login
 941         my $userid = $query->param('userid');
 942         my $password = $query->param('password');
 943         unless ($userid and $password) {
 944             # caller did something wrong, fail the authenticateion
 945             return ("failed", undef, undef);
 946         }
 947         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 948         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 949             my $session = get_session("");
 950             return ("failed", undef, undef) unless $session;
 951
 952             my $sessionID = $session->id;
 953             C4::Context->_new_userenv($sessionID);
 954             my $cookie = $query->cookie(CGISESSID => $sessionID);
 955             if ( $return == 1 ) {
 956                 my (
 957                     $borrowernumber, $firstname,  $surname,
 958                     $userflags,      $branchcode, $branchname,
 959                     $branchprinter,  $emailaddress
 960                 );
 961                 my $sth =
 962                   $dbh->prepare(
 963 "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=?"
 964                   );
 965                 $sth->execute($userid);
 966                 (
 967                     $borrowernumber, $firstname,  $surname,
 968                     $userflags,      $branchcode, $branchname,
 969                     $branchprinter,  $emailaddress
 970                 ) = $sth->fetchrow if ( $sth->rows );
 971
 972                 unless ($sth->rows ) {
 973                     my $sth = $dbh->prepare(
 974 "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=?"
 975                       );
 976                     $sth->execute($cardnumber);
 977                     (
 978                         $borrowernumber, $firstname,  $surname,
 979                         $userflags,      $branchcode, $branchname,
 980                         $branchprinter,  $emailaddress
 981                     ) = $sth->fetchrow if ( $sth->rows );
 982
 983                     unless ( $sth->rows ) {
 984                         $sth->execute($userid);
 985                         (
 986                             $borrowernumber, $firstname, $surname, $userflags,
 987                             $branchcode, $branchname, $branchprinter, $emailaddress
 988                         ) = $sth->fetchrow if ( $sth->rows );
 989                     }
 990                 }
 991
 992                 my $ip       = $ENV{'REMOTE_ADDR'};
 993                 # if they specify at login, use that
 994                 if ($query->param('branch')) {
 995                     $branchcode  = $query->param('branch');
 996                     $branchname = GetBranchName($branchcode);
 997                 }
 998                 my $branches = GetBranches();
 999                 my @branchesloop;
1000                 foreach my $br ( keys %$branches ) {
1001                     #     now we work with the treatment of ip
1002                     my $domain = $branches->{$br}->{'branchip'};
1003                     if ( $domain && $ip =~ /^$domain/ ) {
1004                         $branchcode = $branches->{$br}->{'branchcode'};
1005
1006                         # new op dev : add the branchprinter and branchname in the cookie
1007                         $branchprinter = $branches->{$br}->{'branchprinter'};
1008                         $branchname    = $branches->{$br}->{'branchname'};
1009                     }
1010                 }
1011                 $session->param('number',$borrowernumber);
1012                 $session->param('id',$userid);
1013                 $session->param('cardnumber',$cardnumber);
1014                 $session->param('firstname',$firstname);
1015                 $session->param('surname',$surname);
1016                 $session->param('branch',$branchcode);
1017                 $session->param('branchname',$branchname);
1018                 $session->param('flags',$userflags);
1019                 $session->param('emailaddress',$emailaddress);
1020                 $session->param('ip',$session->remote_addr());
1021                 $session->param('lasttime',time());
1022             } elsif ( $return == 2 ) {
1023                 #We suppose the user is the superlibrarian
1024                 $session->param('number',0);
1025                 $session->param('id',C4::Context->config('user'));
1026                 $session->param('cardnumber',C4::Context->config('user'));
1027                 $session->param('firstname',C4::Context->config('user'));
1028                 $session->param('surname',C4::Context->config('user'));
1029                 $session->param('branch','NO_LIBRARY_SET');
1030                 $session->param('branchname','NO_LIBRARY_SET');
1031                 $session->param('flags',1);
1032                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1033                 $session->param('ip',$session->remote_addr());
1034                 $session->param('lasttime',time());
1035             }
1036             C4::Context::set_userenv(
1037                 $session->param('number'),       $session->param('id'),
1038                 $session->param('cardnumber'),   $session->param('firstname'),
1039                 $session->param('surname'),      $session->param('branch'),
1040                 $session->param('branchname'),   $session->param('flags'),
1041                 $session->param('emailaddress'), $session->param('branchprinter')
1042             );
1043             return ("ok", $cookie, $sessionID);
1044         } else {
1045             return ("failed", undef, undef);
1046         }
1047     }
1048 }
1049
1050 =item check_cookie_auth
1051
1052   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1053
1054 Given a CGISESSID cookie set during a previous login to Koha, determine
1055 if the user has the privileges specified by C<$userflags>.
1056
1057 C<check_cookie_auth> is meant for authenticating special services
1058 such as tools/upload-file.pl that are invoked by other pages that
1059 have been authenticated in the usual way.
1060
1061 Possible return values in C<$status> are:
1062
1063 =over 4
1064
1065 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1066
1067 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1068
1069 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1070
1071 =item "expired -- session cookie has expired; API user should resubmit userid and password
1072
1073 =back
1074
1075 =cut
1076
1077 sub check_cookie_auth {
1078     my $cookie = shift;
1079     my $flagsrequired = shift;
1080
1081     my $dbh     = C4::Context->dbh;
1082     my $timeout = C4::Context->preference('timeout');
1083     $timeout = 600 unless $timeout;
1084
1085     unless (C4::Context->preference('Version')) {
1086         # database has not been installed yet
1087         return ("maintenance", undef);
1088     }
1089     my $kohaversion=C4::Context::KOHAVERSION;
1090     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1091     if (C4::Context->preference('Version') < $kohaversion) {
1092         # database in need of version update; assume that
1093         # no API should be called while databsae is in
1094         # this condition.
1095         return ("maintenance", undef);
1096     }
1097
1098     # FIXME -- most of what follows is a copy-and-paste
1099     # of code from checkauth.  There is an obvious need
1100     # for refactoring to separate the various parts of
1101     # the authentication code, but as of 2007-11-23 this
1102     # is deferred so as to not introduce bugs into the
1103     # regular authentication code for Koha 3.0.
1104
1105     # see if we have a valid session cookie already
1106     # however, if a userid parameter is present (i.e., from
1107     # a form submission, assume that any current cookie
1108     # is to be ignored
1109     unless (defined $cookie and $cookie) {
1110         return ("failed", undef);
1111     }
1112     my $sessionID = $cookie;
1113     my $session = get_session($sessionID);
1114     C4::Context->_new_userenv($sessionID);
1115     if ($session) {
1116         C4::Context::set_userenv(
1117             $session->param('number'),       $session->param('id'),
1118             $session->param('cardnumber'),   $session->param('firstname'),
1119             $session->param('surname'),      $session->param('branch'),
1120             $session->param('branchname'),   $session->param('flags'),
1121             $session->param('emailaddress'), $session->param('branchprinter')
1122         );
1123
1124         my $ip = $session->param('ip');
1125         my $lasttime = $session->param('lasttime');
1126         my $userid = $session->param('id');
1127         if ( $lasttime < time() - $timeout ) {
1128             # time out
1129             $session->delete();
1130             C4::Context->_unset_userenv($sessionID);
1131             $userid    = undef;
1132             $sessionID = undef;
1133             return ("expired", undef);
1134         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1135             # IP address changed
1136             $session->delete();
1137             C4::Context->_unset_userenv($sessionID);
1138             $userid    = undef;
1139             $sessionID = undef;
1140             return ("expired", undef);
1141         } else {
1142             $session->param('lasttime',time());
1143             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1144             if ($flags) {
1145                 return ("ok", $sessionID);
1146             } else {
1147                 $session->delete();
1148                 C4::Context->_unset_userenv($sessionID);
1149                 $userid    = undef;
1150                 $sessionID = undef;
1151                 return ("failed", undef);
1152             }
1153         }
1154     } else {
1155         return ("expired", undef);
1156     }
1157 }
1158
1159 =item get_session
1160
1161   use CGI::Session;
1162   my $session = get_session($sessionID);
1163
1164 Given a session ID, retrieve the CGI::Session object used to store
1165 the session's state.  The session object can be used to store
1166 data that needs to be accessed by different scripts during a
1167 user's session.
1168
1169 If the C<$sessionID> parameter is an empty string, a new session
1170 will be created.
1171
1172 =cut
1173
1174 sub get_session {
1175     my $sessionID = shift;
1176     my $storage_method = C4::Context->preference('SessionStorage');
1177     my $dbh = C4::Context->dbh;
1178     my $session;
1179     if ($storage_method eq 'mysql'){
1180         $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1181     }
1182     elsif ($storage_method eq 'Pg') {
1183         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1184     }
1185     else {
1186         # catch all defaults to tmp should work on all systems
1187         $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1188     }
1189     return $session;
1190 }
1191
1192 sub checkpw {
1193
1194     my ( $dbh, $userid, $password ) = @_;
1195     if ($ldap) {
1196         $debug and print "## checkpw - checking LDAP\n";
1197         my ($retval,$retcard) = checkpw_ldap(@_);    # EXTERNAL AUTH
1198         ($retval) and return ($retval,$retcard);
1199     }
1200
1201     # INTERNAL AUTH
1202     my $sth =
1203       $dbh->prepare(
1204 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1205       );
1206     $sth->execute($userid);
1207     if ( $sth->rows ) {
1208         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1209             $surname, $branchcode, $flags )
1210           = $sth->fetchrow;
1211         if ( md5_base64($password) eq $md5password ) {
1212
1213             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1214                 $firstname, $surname, $branchcode, $flags );
1215             return 1, $cardnumber;
1216         }
1217     }
1218     $sth =
1219       $dbh->prepare(
1220 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1221       );
1222     $sth->execute($userid);
1223     if ( $sth->rows ) {
1224         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1225             $surname, $branchcode, $flags )
1226           = $sth->fetchrow;
1227         if ( md5_base64($password) eq $md5password ) {
1228
1229             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1230                 $firstname, $surname, $branchcode, $flags );
1231             return 1, $userid;
1232         }
1233     }
1234     if (   $userid && $userid eq C4::Context->config('user')
1235         && "$password" eq C4::Context->config('pass') )
1236     {
1237
1238 # Koha superuser account
1239 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1240         return 2;
1241     }
1242     if (   $userid && $userid eq 'demo'
1243         && "$password" eq 'demo'
1244         && C4::Context->config('demo') )
1245     {
1246
1247 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1248 # some features won't be effective : modify systempref, modify MARC structure,
1249         return 2;
1250     }
1251     return 0;
1252 }
1253
1254 =item getuserflags
1255
1256  $authflags = getuserflags($flags,$dbh);
1257 Translates integer flags into permissions strings hash.
1258
1259 C<$flags> is the integer userflags value ( borrowers.userflags )
1260 C<$authflags> is a hashref of permissions
1261
1262 =cut
1263
1264 sub getuserflags {
1265     my $flags   = shift;
1266     my $userid  = shift;
1267     my $dbh     = shift;
1268     my $userflags;
1269     $flags = 0 unless $flags;
1270     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1271     $sth->execute;
1272
1273     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1274         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1275             $userflags->{$flag} = 1;
1276         }
1277         else {
1278             $userflags->{$flag} = 0;
1279         }
1280     }
1281
1282     # get subpermissions and merge with top-level permissions
1283     my $user_subperms = get_user_subpermissions($userid);
1284     foreach my $module (keys %$user_subperms) {
1285         next if $userflags->{$module} == 1; # user already has permission for everything in this module
1286         $userflags->{$module} = $user_subperms->{$module};
1287     }
1288
1289     return $userflags;
1290 }
1291
1292 =item get_user_subpermissions
1293
1294 =over 4
1295
1296 my $user_perm_hashref = get_user_subpermissions($userid);
1297
1298 =back
1299
1300 Given the userid (note, not the borrowernumber) of a staff user,
1301 return a hashref of hashrefs of the specific subpermissions
1302 accorded to the user.  An example return is
1303
1304 {
1305     tools => {
1306         export_catalog => 1,
1307         import_patrons => 1,
1308     }
1309 }
1310
1311 The top-level hash-key is a module or function code from
1312 userflags.flag, while the second-level key is a code
1313 from permissions.
1314
1315 The results of this function do not give a complete picture
1316 of the functions that a staff user can access; it is also
1317 necessary to check borrowers.flags.
1318
1319 =cut
1320
1321 sub get_user_subpermissions {
1322     my $userid = shift;
1323
1324     my $dbh = C4::Context->dbh;
1325     my $sth = $dbh->prepare("SELECT flag, code
1326                              FROM user_permissions
1327                              JOIN permissions USING (module_bit, code)
1328                              JOIN userflags ON (module_bit = bit)
1329                              JOIN borrowers USING (borrowernumber)
1330                              WHERE userid = ?");
1331     $sth->execute($userid);
1332
1333     my $user_perms = {};
1334     while (my $perm = $sth->fetchrow_hashref) {
1335         $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1336     }
1337     return $user_perms;
1338 }
1339
1340 =item get_all_subpermissions
1341
1342 =over 4
1343
1344 my $perm_hashref = get_all_subpermissions();
1345
1346 =back
1347
1348 Returns a hashref of hashrefs defining all specific
1349 permissions currently defined.  The return value
1350 has the same structure as that of C<get_user_subpermissions>,
1351 except that the innermost hash value is the description
1352 of the subpermission.
1353
1354 =cut
1355
1356 sub get_all_subpermissions {
1357     my $dbh = C4::Context->dbh;
1358     my $sth = $dbh->prepare("SELECT flag, code, description
1359                              FROM permissions
1360                              JOIN userflags ON (module_bit = bit)");
1361     $sth->execute();
1362
1363     my $all_perms = {};
1364     while (my $perm = $sth->fetchrow_hashref) {
1365         $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1366     }
1367     return $all_perms;
1368 }
1369
1370 =item haspermission
1371
1372   $flags = ($dbh,$member,$flagsrequired);
1373
1374 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1375 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1376
1377 Returns member's flags or 0 if a permission is not met.
1378
1379 =cut
1380
1381 sub haspermission {
1382     my ( $dbh, $userid, $flagsrequired ) = @_;
1383     my ($flags,$intflags);
1384     $dbh=C4::Context->dbh unless($dbh);
1385     if(ref($userid)) {
1386         $intflags = $userid->{'flags'};
1387     } else {
1388         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1389         $sth->execute($userid);
1390         my ($intflags) = $sth->fetchrow;
1391         $flags = getuserflags( $intflags, $userid, $dbh );
1392     }
1393     if ( $userid eq C4::Context->config('user') ) {
1394         # Super User Account from /etc/koha.conf
1395         $flags->{'superlibrarian'} = 1;
1396     }
1397     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1398         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1399         $flags->{'superlibrarian'} = 1;
1400     }
1401     return $flags if $flags->{superlibrarian};
1402     foreach my $module ( keys %$flagsrequired ) {
1403         if (C4::Context->preference('GranularPermissions')) {
1404             my $subperm = $flagsrequired->{$module};
1405             if ($subperm eq '*') {
1406                 return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1407             } else {
1408                 return 0 unless ( $flags->{$module} == 1 or
1409                                     ( ref($flags->{$module}) and
1410                                       exists $flags->{$module}->{$subperm} and
1411                                       $flags->{$module}->{$subperm} == 1
1412                                     )
1413                                 );
1414             }
1415         } else {
1416             return 0 unless ( $flags->{$module} );
1417         }
1418     }
1419     return $flags;
1420     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1421 }
1422
1423
1424 sub getborrowernumber {
1425     my ($userid) = @_;
1426     my $dbh = C4::Context->dbh;
1427     for my $field ( 'userid', 'cardnumber' ) {
1428         my $sth =
1429           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1430         $sth->execute($userid);
1431         if ( $sth->rows ) {
1432             my ($bnumber) = $sth->fetchrow;
1433             return $bnumber;
1434         }
1435     }
1436     return 0;
1437 }
1438
1439 END { }    # module clean-up code here (global destructor)
1440 1;
1441 __END__
1442
1443 =back
1444
1445 =head1 SEE ALSO
1446
1447 CGI(3)
1448
1449 C4::Output(3)
1450
1451 Digest::MD5(3)
1452
1453 =cut