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