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