C4/Auth.pm

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