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