C4/Auth.pm

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