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