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