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