C4/Auth.pm

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