C4/Auth.pm

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