C4/Auth.pm

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