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