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