C4/Auth.pm

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