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