C4/Auth.pm

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