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