C4/Auth.pm

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