C4/Auth.pm

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