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