C4/Auth.pm

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