C4/Auth.pm

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