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