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