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