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