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