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