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