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         );
 264     }
 265     else {
 266         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 267         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 268         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 269         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 270   $template->param(
 271             KohaAdminEmailAddress  => "" . C4::Context->preference("KohaAdminEmailAddress"),
 272             AnonSuggestions =>  "" . C4::Context->preference("AnonSuggestions"),
 273             suggestion             => "" . C4::Context->preference("suggestion"),
 274             OPACViewOthersSuggestions             => "" . C4::Context->preference("OPACViewOthersSuggestions"),
 275             virtualshelves         => "" . C4::Context->preference("virtualshelves"),
 276             OpacNav                => "" . C4::Context->preference("OpacNav"),
 277             opacheader             => "" . C4::Context->preference("opacheader"),
 278             opaccredits            => "" . C4::Context->preference("opaccredits"),
 279             opacsmallimage         => "" . C4::Context->preference("opacsmallimage"),
 280             opaclargeimage         => "" . C4::Context->preference("opaclargeimage"),
 281             opaclayoutstylesheet   => "". C4::Context->preference("opaclayoutstylesheet"),
 282             opaccolorstylesheet    => "". C4::Context->preference("opaccolorstylesheet"),
 283             OPACUserCSS    => "". C4::Context->preference("OPACUserCSS"),
 284             opaclanguagesdisplay   => "". C4::Context->preference("opaclanguagesdisplay"),
 285             opacuserlogin          => "" . C4::Context->preference("opacuserlogin"),
 286                         OpacMainUserBlock =>  "" . C4::Context->preference("OpacMainUserBlock"),
 287                         OPACURLOpenInNewWindow =>  "" . C4::Context->preference("OPACURLOpenInNewWindow"),
 288             opacbookbag            => "" . C4::Context->preference("opacbookbag"),
 289             TemplateEncoding       => "". C4::Context->preference("TemplateEncoding"),
 290             AmazonContent          => "" . C4::Context->preference("AmazonContent"),
 291             OPACShelfBrowser       => "". C4::Context->preference("OPACShelfBrowser"),
 292             OPACAmazonSimilarItems => "" . C4::Context->preference("OPACAmazonSimilarItems"),
 293             LibraryName            => "" . C4::Context->preference("LibraryName"),
 294             LibraryNameTitle       => "" . $LibraryNameTitle,
 295             LoginBranchcode        => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 296             LoginBranchname        => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 297             LoginFirstname        => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 298             LoginSurname        => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 299             OpacPasswordChange     => C4::Context->preference("OpacPasswordChange"),
 300             opacreadinghistory     => C4::Context->preference("opacreadinghistory"),
 301             opacuserjs             => C4::Context->preference("opacuserjs"),
 302             OpacCloud              => C4::Context->preference("OpacCloud"),
 303             OpacTopissue           => C4::Context->preference("OpacTopissue"),
 304             OpacAuthorities        => C4::Context->preference("OpacAuthorities"),
 305             OpacBrowser            => C4::Context->preference("OpacBrowser"),
 306             RequestOnOpac          => C4::Context->preference("RequestOnOpac"),
 307                         OPACItemHolds          => C4::Context->preference("OPACItemHolds"),
 308             reviewson              => C4::Context->preference("reviewson"),
 309             hide_marc              => C4::Context->preference("hide_marc"),
 310             patronimages           => C4::Context->preference("patronimages"),
 311             hidelostitems          => C4::Context->preference("hidelostitems"),
 312             mylibraryfirst   => C4::Context->preference("SearchMyLibraryFirst"),
 313             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 314             OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
 315             'item-level_itypes' => C4::Context->preference('item-level_itypes'),
 316             'Version' => C4::Context->preference('Version'),
 317                         yuipath => C4::Context->preference("yuipath"),
 318             singleBranchMode => C4::Context->preference("singleBranchMode"),
 319             XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
 320             XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
 321                         TagsEnabled => C4::Context->preference("TagsEnabled"),
 322                         GoogleJackets => C4::Context->preference("GoogleJackets"),
 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         intranetcolorstylesheet =>
 732                                                                 C4::Context->preference("intranetcolorstylesheet"),
 733         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 734         IntranetNav        => C4::Context->preference("IntranetNav"),
 735         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 736         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 737         IndependantBranches=> C4::Context->preference("IndependantBranches"),
 738         AutoLocation       => C4::Context->preference("AutoLocation"),
 739         yuipath            => C4::Context->preference("yuipath"),
 740                 wrongip            => $info{'wrongip'}
 741     );
 742
 743     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 744
 745     my $self_url = $query->url( -absolute => 1 );
 746     $template->param(
 747         url         => $self_url,
 748         LibraryName => C4::Context->preference("LibraryName"),
 749     );
 750     $template->param( \%info );
 751 #    $cookie = $query->cookie(CGISESSID => $session->id
 752 #   );
 753     print $query->header(
 754         -type   => 'text/html',
 755         -charset => 'utf-8',
 756         -cookie => $cookie
 757       ),
 758       $template->output;
 759     exit;
 760 }
 761
 762 =item check_api_auth
 763
 764   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 765
 766 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 767 cookie, determine if the user has the privileges specified by C<$userflags>.
 768
 769 C<check_api_auth> is is meant for authenticating users of web services, and
 770 consequently will always return and will not attempt to redirect the user
 771 agent.
 772
 773 If a valid session cookie is already present, check_api_auth will return a status
 774 of "ok", the cookie, and the Koha session ID.
 775
 776 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 777 parameters and create a session cookie and Koha session if the supplied credentials
 778 are OK.
 779
 780 Possible return values in C<$status> are:
 781
 782 =over 4
 783
 784 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 785
 786 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 787
 788 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 789
 790 =item "expired -- session cookie has expired; API user should resubmit userid and password
 791
 792 =back
 793
 794 =cut
 795
 796 sub check_api_auth {
 797     my $query = shift;
 798     my $flagsrequired = shift;
 799
 800     my $dbh     = C4::Context->dbh;
 801     my $timeout = C4::Context->preference('timeout');
 802     $timeout = 600 unless $timeout;
 803
 804     unless (C4::Context->preference('Version')) {
 805         # database has not been installed yet
 806         return ("maintenance", undef, undef);
 807     }
 808     my $kohaversion=C4::Context::KOHAVERSION;
 809     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 810     if (C4::Context->preference('Version') < $kohaversion) {
 811         # database in need of version update; assume that
 812         # no API should be called while databsae is in
 813         # this condition.
 814         return ("maintenance", undef, undef);
 815     }
 816
 817     # FIXME -- most of what follows is a copy-and-paste
 818     # of code from checkauth.  There is an obvious need
 819     # for refactoring to separate the various parts of
 820     # the authentication code, but as of 2007-11-19 this
 821     # is deferred so as to not introduce bugs into the
 822     # regular authentication code for Koha 3.0.
 823
 824     # see if we have a valid session cookie already
 825     # however, if a userid parameter is present (i.e., from
 826     # a form submission, assume that any current cookie
 827     # is to be ignored
 828     my $sessionID = undef;
 829     unless ($query->param('userid')) {
 830         $sessionID = $query->cookie("CGISESSID");
 831     }
 832     if ($sessionID) {
 833         my $session = get_session($sessionID);
 834         C4::Context->_new_userenv($sessionID);
 835         if ($session) {
 836             C4::Context::set_userenv(
 837                 $session->param('number'),       $session->param('id'),
 838                 $session->param('cardnumber'),   $session->param('firstname'),
 839                 $session->param('surname'),      $session->param('branch'),
 840                 $session->param('branchname'),   $session->param('flags'),
 841                 $session->param('emailaddress'), $session->param('branchprinter')
 842             );
 843
 844             my $ip = $session->param('ip');
 845             my $lasttime = $session->param('lasttime');
 846             my $userid = $session->param('id');
 847             if ( $lasttime < time() - $timeout ) {
 848                 # time out
 849                 $session->delete();
 850                 C4::Context->_unset_userenv($sessionID);
 851                 $userid    = undef;
 852                 $sessionID = undef;
 853                 return ("expired", undef, undef);
 854             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 855                 # IP address changed
 856                 $session->delete();
 857                 C4::Context->_unset_userenv($sessionID);
 858                 $userid    = undef;
 859                 $sessionID = undef;
 860                 return ("expired", undef, undef);
 861             } else {
 862                 my $cookie = $query->cookie( CGISESSID => $session->id );
 863                 $session->param('lasttime',time());
 864                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 865                 if ($flags) {
 866                     return ("ok", $cookie, $sessionID);
 867                 } else {
 868                     $session->delete();
 869                     C4::Context->_unset_userenv($sessionID);
 870                     $userid    = undef;
 871                     $sessionID = undef;
 872                     return ("failed", undef, undef);
 873                 }
 874             }
 875         } else {
 876             return ("expired", undef, undef);
 877         }
 878     } else {
 879         # new login
 880         my $userid = $query->param('userid');
 881         my $password = $query->param('password');
 882         unless ($userid and $password) {
 883             # caller did something wrong, fail the authenticateion
 884             return ("failed", undef, undef);
 885         }
 886         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 887         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 888             my $session = get_session("");
 889             return ("failed", undef, undef) unless $session;
 890
 891             my $sessionID = $session->id;
 892             C4::Context->_new_userenv($sessionID);
 893             my $cookie = $query->cookie(CGISESSID => $sessionID);
 894             if ( $return == 1 ) {
 895                 my (
 896                     $borrowernumber, $firstname,  $surname,
 897                     $userflags,      $branchcode, $branchname,
 898                     $branchprinter,  $emailaddress
 899                 );
 900                 my $sth =
 901                   $dbh->prepare(
 902 "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=?"
 903                   );
 904                 $sth->execute($userid);
 905                 (
 906                     $borrowernumber, $firstname,  $surname,
 907                     $userflags,      $branchcode, $branchname,
 908                     $branchprinter,  $emailaddress
 909                 ) = $sth->fetchrow if ( $sth->rows );
 910
 911                 unless ($sth->rows ) {
 912                     my $sth = $dbh->prepare(
 913 "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=?"
 914                       );
 915                     $sth->execute($cardnumber);
 916                     (
 917                         $borrowernumber, $firstname,  $surname,
 918                         $userflags,      $branchcode, $branchname,
 919                         $branchprinter,  $emailaddress
 920                     ) = $sth->fetchrow if ( $sth->rows );
 921
 922                     unless ( $sth->rows ) {
 923                         $sth->execute($userid);
 924                         (
 925                             $borrowernumber, $firstname, $surname, $userflags,
 926                             $branchcode, $branchname, $branchprinter, $emailaddress
 927                         ) = $sth->fetchrow if ( $sth->rows );
 928                     }
 929                 }
 930
 931                 my $ip       = $ENV{'REMOTE_ADDR'};
 932                 # if they specify at login, use that
 933                 if ($query->param('branch')) {
 934                     $branchcode  = $query->param('branch');
 935                     $branchname = GetBranchName($branchcode);
 936                 }
 937                 my $branches = GetBranches();
 938                 my @branchesloop;
 939                 foreach my $br ( keys %$branches ) {
 940                     #     now we work with the treatment of ip
 941                     my $domain = $branches->{$br}->{'branchip'};
 942                     if ( $domain && $ip =~ /^$domain/ ) {
 943                         $branchcode = $branches->{$br}->{'branchcode'};
 944
 945                         # new op dev : add the branchprinter and branchname in the cookie
 946                         $branchprinter = $branches->{$br}->{'branchprinter'};
 947                         $branchname    = $branches->{$br}->{'branchname'};
 948                     }
 949                 }
 950                 $session->param('number',$borrowernumber);
 951                 $session->param('id',$userid);
 952                 $session->param('cardnumber',$cardnumber);
 953                 $session->param('firstname',$firstname);
 954                 $session->param('surname',$surname);
 955                 $session->param('branch',$branchcode);
 956                 $session->param('branchname',$branchname);
 957                 $session->param('flags',$userflags);
 958                 $session->param('emailaddress',$emailaddress);
 959                 $session->param('ip',$session->remote_addr());
 960                 $session->param('lasttime',time());
 961             } elsif ( $return == 2 ) {
 962                 #We suppose the user is the superlibrarian
 963                 $session->param('number',0);
 964                 $session->param('id',C4::Context->config('user'));
 965                 $session->param('cardnumber',C4::Context->config('user'));
 966                 $session->param('firstname',C4::Context->config('user'));
 967                 $session->param('surname',C4::Context->config('user'));
 968                 $session->param('branch','NO_LIBRARY_SET');
 969                 $session->param('branchname','NO_LIBRARY_SET');
 970                 $session->param('flags',1);
 971                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 972                 $session->param('ip',$session->remote_addr());
 973                 $session->param('lasttime',time());
 974             }
 975             C4::Context::set_userenv(
 976                 $session->param('number'),       $session->param('id'),
 977                 $session->param('cardnumber'),   $session->param('firstname'),
 978                 $session->param('surname'),      $session->param('branch'),
 979                 $session->param('branchname'),   $session->param('flags'),
 980                 $session->param('emailaddress'), $session->param('branchprinter')
 981             );
 982             return ("ok", $cookie, $sessionID);
 983         } else {
 984             return ("failed", undef, undef);
 985         }
 986     }
 987 }
 988
 989 =item check_cookie_auth
 990
 991   ($status, $sessionId) = check_api_auth($cookie, $userflags);
 992
 993 Given a CGISESSID cookie set during a previous login to Koha, determine
 994 if the user has the privileges specified by C<$userflags>.
 995
 996 C<check_cookie_auth> is meant for authenticating special services
 997 such as tools/upload-file.pl that are invoked by other pages that
 998 have been authenticated in the usual way.
 999
1000 Possible return values in C<$status> are:
1001
1002 =over 4
1003
1004 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1005
1006 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1007
1008 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1009
1010 =item "expired -- session cookie has expired; API user should resubmit userid and password
1011
1012 =back
1013
1014 =cut
1015
1016 sub check_cookie_auth {
1017     my $cookie = shift;
1018     my $flagsrequired = shift;
1019
1020     my $dbh     = C4::Context->dbh;
1021     my $timeout = C4::Context->preference('timeout');
1022     $timeout = 600 unless $timeout;
1023
1024     unless (C4::Context->preference('Version')) {
1025         # database has not been installed yet
1026         return ("maintenance", undef);
1027     }
1028     my $kohaversion=C4::Context::KOHAVERSION;
1029     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1030     if (C4::Context->preference('Version') < $kohaversion) {
1031         # database in need of version update; assume that
1032         # no API should be called while databsae is in
1033         # this condition.
1034         return ("maintenance", undef);
1035     }
1036
1037     # FIXME -- most of what follows is a copy-and-paste
1038     # of code from checkauth.  There is an obvious need
1039     # for refactoring to separate the various parts of
1040     # the authentication code, but as of 2007-11-23 this
1041     # is deferred so as to not introduce bugs into the
1042     # regular authentication code for Koha 3.0.
1043
1044     # see if we have a valid session cookie already
1045     # however, if a userid parameter is present (i.e., from
1046     # a form submission, assume that any current cookie
1047     # is to be ignored
1048     unless (defined $cookie and $cookie) {
1049         return ("failed", undef);
1050     }
1051     my $sessionID = $cookie;
1052     my $session = get_session($sessionID);
1053     C4::Context->_new_userenv($sessionID);
1054     if ($session) {
1055         C4::Context::set_userenv(
1056             $session->param('number'),       $session->param('id'),
1057             $session->param('cardnumber'),   $session->param('firstname'),
1058             $session->param('surname'),      $session->param('branch'),
1059             $session->param('branchname'),   $session->param('flags'),
1060             $session->param('emailaddress'), $session->param('branchprinter')
1061         );
1062
1063         my $ip = $session->param('ip');
1064         my $lasttime = $session->param('lasttime');
1065         my $userid = $session->param('id');
1066         if ( $lasttime < time() - $timeout ) {
1067             # time out
1068             $session->delete();
1069             C4::Context->_unset_userenv($sessionID);
1070             $userid    = undef;
1071             $sessionID = undef;
1072             return ("expired", undef);
1073         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1074             # IP address changed
1075             $session->delete();
1076             C4::Context->_unset_userenv($sessionID);
1077             $userid    = undef;
1078             $sessionID = undef;
1079             return ("expired", undef);
1080         } else {
1081             $session->param('lasttime',time());
1082             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1083             if ($flags) {
1084                 return ("ok", $sessionID);
1085             } else {
1086                 $session->delete();
1087                 C4::Context->_unset_userenv($sessionID);
1088                 $userid    = undef;
1089                 $sessionID = undef;
1090                 return ("failed", undef);
1091             }
1092         }
1093     } else {
1094         return ("expired", undef);
1095     }
1096 }
1097
1098 =item get_session
1099
1100   use CGI::Session;
1101   my $session = get_session($sessionID);
1102
1103 Given a session ID, retrieve the CGI::Session object used to store
1104 the session's state.  The session object can be used to store
1105 data that needs to be accessed by different scripts during a
1106 user's session.
1107
1108 If the C<$sessionID> parameter is an empty string, a new session
1109 will be created.
1110
1111 =cut
1112
1113 sub get_session {
1114     my $sessionID = shift;
1115     my $storage_method = C4::Context->preference('SessionStorage');
1116     my $dbh = C4::Context->dbh;
1117     my $session;
1118     if ($storage_method eq 'mysql'){
1119         $session = new CGI::Session("driver:MySQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1120     }
1121     elsif ($storage_method eq 'Pg') {
1122         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1123     }
1124     else {
1125         # catch all defaults to tmp should work on all systems
1126         $session = new CGI::Session("driver:File;serializer:yaml", $sessionID, {Directory=>'/tmp'});
1127     }
1128     return $session;
1129 }
1130
1131 sub checkpw {
1132
1133     my ( $dbh, $userid, $password ) = @_;
1134     if ($ldap) {
1135         $debug and print "## checkpw - checking LDAP\n";
1136         my ($retval,$retcard) = checkpw_ldap(@_);    # EXTERNAL AUTH
1137         ($retval) and return ($retval,$retcard);
1138     }
1139
1140     # INTERNAL AUTH
1141     my $sth =
1142       $dbh->prepare(
1143 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1144       );
1145     $sth->execute($userid);
1146     if ( $sth->rows ) {
1147         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1148             $surname, $branchcode, $flags )
1149           = $sth->fetchrow;
1150         if ( md5_base64($password) eq $md5password ) {
1151
1152             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1153                 $firstname, $surname, $branchcode, $flags );
1154             return 1, $cardnumber;
1155         }
1156     }
1157     $sth =
1158       $dbh->prepare(
1159 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1160       );
1161     $sth->execute($userid);
1162     if ( $sth->rows ) {
1163         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1164             $surname, $branchcode, $flags )
1165           = $sth->fetchrow;
1166         if ( md5_base64($password) eq $md5password ) {
1167
1168             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1169                 $firstname, $surname, $branchcode, $flags );
1170             return 1, $userid;
1171         }
1172     }
1173     if (   $userid && $userid eq C4::Context->config('user')
1174         && "$password" eq C4::Context->config('pass') )
1175     {
1176
1177 # Koha superuser account
1178 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1179         return 2;
1180     }
1181     if (   $userid && $userid eq 'demo'
1182         && "$password" eq 'demo'
1183         && C4::Context->config('demo') )
1184     {
1185
1186 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1187 # some features won't be effective : modify systempref, modify MARC structure,
1188         return 2;
1189     }
1190     return 0;
1191 }
1192
1193 =item getuserflags
1194
1195  $authflags = getuserflags($flags,$dbh);
1196 Translates integer flags into permissions strings hash.
1197
1198 C<$flags> is the integer userflags value ( borrowers.userflags )
1199 C<$authflags> is a hashref of permissions
1200
1201 =cut
1202
1203 sub getuserflags {
1204     my $flags   = shift;
1205     my $userid  = shift;
1206     my $dbh     = shift;
1207     my $userflags;
1208     $flags = 0 unless $flags;
1209     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1210     $sth->execute;
1211
1212     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1213         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1214             $userflags->{$flag} = 1;
1215         }
1216         else {
1217             $userflags->{$flag} = 0;
1218         }
1219     }
1220
1221     # get subpermissions and merge with top-level permissions
1222     my $user_subperms = get_user_subpermissions($userid);
1223     foreach my $module (keys %$user_subperms) {
1224         next if $userflags->{$module} == 1; # user already has permission for everything in this module
1225         $userflags->{$module} = $user_subperms->{$module};
1226     }
1227
1228     return $userflags;
1229 }
1230
1231 =item get_user_subpermissions
1232
1233 =over 4
1234
1235 my $user_perm_hashref = get_user_subpermissions($userid);
1236
1237 =back
1238
1239 Given the userid (note, not the borrowernumber) of a staff user,
1240 return a hashref of hashrefs of the specific subpermissions
1241 accorded to the user.  An example return is
1242
1243 {
1244     tools => {
1245         export_catalog => 1,
1246         import_patrons => 1,
1247     }
1248 }
1249
1250 The top-level hash-key is a module or function code from
1251 userflags.flag, while the second-level key is a code
1252 from permissions.
1253
1254 The results of this function do not give a complete picture
1255 of the functions that a staff user can access; it is also
1256 necessary to check borrowers.flags.
1257
1258 =cut
1259
1260 sub get_user_subpermissions {
1261     my $userid = shift;
1262
1263     my $dbh = C4::Context->dbh;
1264     my $sth = $dbh->prepare("SELECT flag, code
1265                              FROM user_permissions
1266                              JOIN permissions USING (module_bit, code)
1267                              JOIN userflags ON (module_bit = bit)
1268                              JOIN borrowers USING (borrowernumber)
1269                              WHERE userid = ?");
1270     $sth->execute($userid);
1271
1272     my $user_perms = {};
1273     while (my $perm = $sth->fetchrow_hashref) {
1274         $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1275     }
1276     return $user_perms;
1277 }
1278
1279 =item get_all_subpermissions
1280
1281 =over 4
1282
1283 my $perm_hashref = get_all_subpermissions();
1284
1285 =back
1286
1287 Returns a hashref of hashrefs defining all specific
1288 permissions currently defined.  The return value
1289 has the same structure as that of C<get_user_subpermissions>,
1290 except that the innermost hash value is the description
1291 of the subpermission.
1292
1293 =cut
1294
1295 sub get_all_subpermissions {
1296     my $dbh = C4::Context->dbh;
1297     my $sth = $dbh->prepare("SELECT flag, code, description
1298                              FROM permissions
1299                              JOIN userflags ON (module_bit = bit)");
1300     $sth->execute();
1301
1302     my $all_perms = {};
1303     while (my $perm = $sth->fetchrow_hashref) {
1304         $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1305     }
1306     return $all_perms;
1307 }
1308
1309 =item haspermission
1310
1311   $flags = ($dbh,$member,$flagsrequired);
1312
1313 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1314 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1315
1316 Returns member's flags or 0 if a permission is not met.
1317
1318 =cut
1319
1320 sub haspermission {
1321     my ( $dbh, $userid, $flagsrequired ) = @_;
1322     my ($flags,$intflags);
1323     $dbh=C4::Context->dbh unless($dbh);
1324     if(ref($userid)) {
1325         $intflags = $userid->{'flags'};
1326     } else {
1327         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1328         $sth->execute($userid);
1329         my ($intflags) = $sth->fetchrow;
1330         $flags = getuserflags( $intflags, $userid, $dbh );
1331     }
1332     if ( $userid eq C4::Context->config('user') ) {
1333         # Super User Account from /etc/koha.conf
1334         $flags->{'superlibrarian'} = 1;
1335     }
1336     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1337         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1338         $flags->{'superlibrarian'} = 1;
1339     }
1340     return $flags if $flags->{superlibrarian};
1341     foreach my $module ( keys %$flagsrequired ) {
1342         if (C4::Context->preference('GranularPermissions')) {
1343             my $subperm = $flagsrequired->{$module};
1344             if ($subperm eq '*') {
1345                 return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1346             } else {
1347                 return 0 unless ( $flags->{$module} == 1 or
1348                                     ( ref($flags->{$module}) and
1349                                       exists $flags->{$module}->{$subperm} and
1350                                       $flags->{$module}->{$subperm} == 1
1351                                     )
1352                                 );
1353             }
1354         } else {
1355             return 0 unless ( $flags->{$module} );
1356         }
1357     }
1358     return $flags;
1359     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1360 }
1361
1362
1363 sub getborrowernumber {
1364     my ($userid) = @_;
1365     my $dbh = C4::Context->dbh;
1366     for my $field ( 'userid', 'cardnumber' ) {
1367         my $sth =
1368           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1369         $sth->execute($userid);
1370         if ( $sth->rows ) {
1371             my ($bnumber) = $sth->fetchrow;
1372             return $bnumber;
1373         }
1374     }
1375     return 0;
1376 }
1377
1378 END { }    # module clean-up code here (global destructor)
1379 1;
1380 __END__
1381
1382 =back
1383
1384 =head1 SEE ALSO
1385
1386 CGI(3)
1387
1388 C4::Output(3)
1389
1390 Digest::MD5(3)
1391
1392 =cut