C4/Auth.pm

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