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