koha-dev.rot13.org Git - srvgit/blob - C4/Auth.pm

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