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