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