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