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