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