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