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