C4/Auth.pm

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