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