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