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