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