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