C4/Auth.pm

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