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