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