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