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