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