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