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