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