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