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