C4/Auth.pm

   1
   2 # -*- tab-width: 8 -*-
   3 # NOTE: This file uses 8-character tabs; do not change the tab size!
   4
   5 package C4::Auth;
   6
   7 # Copyright 2000-2002 Katipo Communications
   8 #
   9 # This file is part of Koha.
  10 #
  11 # Koha is free software; you can redistribute it and/or modify it under the
  12 # terms of the GNU General Public License as published by the Free Software
  13 # Foundation; either version 2 of the License, or (at your option) any later
  14 # version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  17 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  18 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License along with
  21 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  22 # Suite 330, Boston, MA  02111-1307 USA
  23
  24 use strict;
  25 use Digest::MD5 qw(md5_base64);
  26 use CGI::Session;
  27
  28 require Exporter;
  29 use C4::Context;
  30 use C4::Output;    # to get the template
  31 use C4::Members;
  32 use C4::Koha;
  33 use C4::Branch; # GetBranches
  34 use C4::VirtualShelves 3.02 qw(GetShelvesSummary);
  35
  36 # use utf8;
  37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap);
  38
  39 BEGIN {
  40     $VERSION = 3.02;        # set version for version checking
  41     $debug = $ENV{DEBUG} || 0 ;
  42     @ISA   = qw(Exporter);
  43     @EXPORT    = qw(&checkauth &get_template_and_user);
  44     @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw);
  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
  61   my $query = new CGI;
  62
  63   my ($template, $borrowernumber, $cookie)
  64     = get_template_and_user(
  65         {
  66             template_name   => "opac-main.tmpl",
  67             query           => $query,
  68       type            => "opac",
  69       authnotrequired => 1,
  70       flagsrequired   => {borrow => 1},
  71   }
  72     );
  73
  74   print $query->header(
  75     -type => 'utf-8',
  76     -cookie => $cookie
  77   ), $template->output;
  78
  79
  80 =head1 DESCRIPTION
  81
  82     The main function of this module is to provide
  83     authentification. However the get_template_and_user function has
  84     been provided so that a users login information is passed along
  85     automatically. This gets loaded into the template.
  86
  87 =head1 FUNCTIONS
  88
  89 =over 2
  90
  91 =item get_template_and_user
  92
  93     my ($template, $borrowernumber, $cookie)
  94         = get_template_and_user(
  95           {
  96             template_name   => "opac-main.tmpl",
  97             query           => $query,
  98             type            => "opac",
  99             authnotrequired => 1,
 100             flagsrequired   => {borrow => 1},
 101           }
 102         );
 103
 104     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
 105     to C<&checkauth> (in this module) to perform authentification.
 106     See C<&checkauth> for an explanation of these parameters.
 107
 108     The C<template_name> is then used to find the correct template for
 109     the page. The authenticated users details are loaded onto the
 110     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 111     C<sessionID> is passed to the template. This can be used in templates
 112     if cookies are disabled. It needs to be put as and input to every
 113     authenticated page.
 114
 115     More information on the C<gettemplate> sub can be found in the
 116     Output.pm module.
 117
 118 =cut
 119
 120 sub get_template_and_user {
 121     my $in       = shift;
 122     my $template =
 123       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 124     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
 125         $in->{'query'},
 126         $in->{'authnotrequired'},
 127         $in->{'flagsrequired'},
 128         $in->{'type'}
 129     ) unless ($in->{'template_name'}=~/maintenance/);
 130
 131     my $borrowernumber;
 132     my $insecure = C4::Context->preference('insecure');
 133     if ($user or $insecure) {
 134
 135         # load the template variables for stylesheets and JavaScript
 136         $template->param( css_libs => $in->{'css_libs'} );
 137         $template->param( css_module => $in->{'css_module'} );
 138         $template->param( css_page => $in->{'css_page'} );
 139         $template->param( css_widgets => $in->{'css_widgets'} );
 140
 141         $template->param( js_libs => $in->{'js_libs'} );
 142         $template->param( js_module => $in->{'js_module'} );
 143         $template->param( js_page => $in->{'js_page'} );
 144         $template->param( js_widgets => $in->{'js_widgets'} );
 145
 146         # user info
 147         $template->param( loggedinusername => $user );
 148         $template->param( sessionID        => $sessionID );
 149                 my $shelves;
 150                 if ($shelves = C4::Context->get_shelves_userenv()) {
 151                 $template->param( barshelves     => scalar (@$shelves));
 152                 $template->param( barshelvesloop => $shelves);
 153                 }
 154
 155         $borrowernumber = getborrowernumber($user);
 156         my ( $borr, $alternativeflags ) =
 157           GetMemberDetails( $borrowernumber );
 158         my @bordat;
 159         $bordat[0] = $borr;
 160         $template->param( "USER_INFO" => \@bordat );
 161
 162         my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
 163                             editcatalogue updatecharges management tools editauthorities serials reports);
 164         # We are going to use the $flags returned by checkauth
 165         # to create the template's parameters that will indicate
 166         # which menus the user can access.
 167         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
 168             $template->param( CAN_user_circulate        => 1 );
 169             $template->param( CAN_user_catalogue        => 1 );
 170             $template->param( CAN_user_parameters       => 1 );
 171             $template->param( CAN_user_borrowers        => 1 );
 172             $template->param( CAN_user_permission       => 1 );
 173             $template->param( CAN_user_reserveforothers => 1 );
 174             $template->param( CAN_user_borrow           => 1 );
 175             $template->param( CAN_user_editcatalogue    => 1 );
 176             $template->param( CAN_user_updatecharges     => 1 );
 177             $template->param( CAN_user_acquisition      => 1 );
 178             $template->param( CAN_user_management       => 1 );
 179             $template->param( CAN_user_tools            => 1 );
 180             $template->param( CAN_user_editauthorities  => 1 );
 181             $template->param( CAN_user_serials          => 1 );
 182             $template->param( CAN_user_reports          => 1 );
 183             $template->param( CAN_user_staffaccess      => 1 );
 184         }
 185
 186         if ( $flags && $flags->{circulate} == 1 ) {
 187             $template->param( CAN_user_circulate => 1 );
 188         }
 189
 190         if ( $flags && $flags->{catalogue} == 1 ) {
 191             $template->param( CAN_user_catalogue => 1 );
 192         }
 193
 194         if ( $flags && $flags->{parameters} == 1 ) {
 195             $template->param( CAN_user_parameters => 1 );
 196             $template->param( CAN_user_management => 1 );
 197         }
 198
 199         if ( $flags && $flags->{borrowers} == 1 ) {
 200             $template->param( CAN_user_borrowers => 1 );
 201         }
 202
 203         if ( $flags && $flags->{permissions} == 1 ) {
 204             $template->param( CAN_user_permission => 1 );
 205         }
 206
 207         if ( $flags && $flags->{reserveforothers} == 1 ) {
 208             $template->param( CAN_user_reserveforothers => 1 );
 209         }
 210
 211         if ( $flags && $flags->{borrow} == 1 ) {
 212             $template->param( CAN_user_borrow => 1 );
 213         }
 214
 215         if ( $flags && $flags->{editcatalogue} == 1 ) {
 216             $template->param( CAN_user_editcatalogue => 1 );
 217         }
 218
 219         if ( $flags && $flags->{updatecharges} == 1 ) {
 220             $template->param( CAN_user_updatecharges => 1 );
 221         }
 222
 223         if ( $flags && $flags->{acquisition} == 1 ) {
 224             $template->param( CAN_user_acquisition => 1 );
 225         }
 226
 227         if ( $flags && $flags->{tools} == 1 ) {
 228             $template->param( CAN_user_tools => 1 );
 229         }
 230
 231         if ( $flags && $flags->{editauthorities} == 1 ) {
 232             $template->param( CAN_user_editauthorities => 1 );
 233         }
 234
 235         if ( $flags && $flags->{serials} == 1 ) {
 236             $template->param( CAN_user_serials => 1 );
 237         }
 238
 239         if ( $flags && $flags->{reports} == 1 ) {
 240             $template->param( CAN_user_reports => 1 );
 241         }
 242         if ( $flags && $flags->{staffaccess} == 1 ) {
 243             $template->param( CAN_user_staffaccess => 1 );
 244         }
 245     }
 246     if ( $in->{'type'} eq "intranet" ) {
 247         $template->param(
 248             intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
 249             intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 250             IntranetNav        => C4::Context->preference("IntranetNav"),
 251             intranetuserjs     => C4::Context->preference("intranetuserjs"),
 252             TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 253             AmazonContent      => C4::Context->preference("AmazonContent"),
 254             LibraryName        => C4::Context->preference("LibraryName"),
 255             LoginBranchcode    => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 256             LoginBranchname    => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
 257             LoginFirstname     => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 258             LoginSurname       => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 259             AutoLocation       => C4::Context->preference("AutoLocation"),
 260             hide_marc          => C4::Context->preference("hide_marc"),
 261             patronimages       => C4::Context->preference("patronimages"),
 262             "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
 263             advancedMARCEditor      => C4::Context->preference("advancedMARCEditor"),
 264             suggestion              => C4::Context->preference("suggestion"),
 265             virtualshelves          => C4::Context->preference("virtualshelves"),
 266             LibraryName             => C4::Context->preference("LibraryName"),
 267             KohaAdminEmailAddress   => "" . C4::Context->preference("KohaAdminEmailAddress"),
 268             IntranetmainUserblock   => C4::Context->preference("IntranetmainUserblock"),
 269             IndependantBranches     => C4::Context->preference("IndependantBranches"),
 270                         CircAutocompl => C4::Context->preference("CircAutocompl"),
 271                         yuipath => C4::Context->preference("yuipath"),
 272                         FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
 273                         AmazonSimilarItems => C4::Context->preference("AmazonSimilarItems"),
 274                         'item-level_itypes' => C4::Context->preference('item-level_itypes'),
 275                         canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
 276                         intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
 277                         noItemTypeImages => C4::Context->preference("noItemTypeImages"),
 278         );
 279     }
 280     else {
 281         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 282         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 283         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 284         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 285   $template->param(
 286             KohaAdminEmailAddress  => "" . C4::Context->preference("KohaAdminEmailAddress"),
 287             AnonSuggestions =>  "" . C4::Context->preference("AnonSuggestions"),
 288             suggestion             => "" . C4::Context->preference("suggestion"),
 289             virtualshelves         => "" . C4::Context->preference("virtualshelves"),
 290             OpacNav                => "" . C4::Context->preference("OpacNav"),
 291             opacheader             => "" . C4::Context->preference("opacheader"),
 292             opaccredits            => "" . C4::Context->preference("opaccredits"),
 293             opacsmallimage         => "" . C4::Context->preference("opacsmallimage"),
 294             opaclargeimage         => "" . C4::Context->preference("opaclargeimage"),
 295             opaclayoutstylesheet   => "". C4::Context->preference("opaclayoutstylesheet"),
 296             opaccolorstylesheet    => "". C4::Context->preference("opaccolorstylesheet"),
 297             opaclanguagesdisplay   => "". C4::Context->preference("opaclanguagesdisplay"),
 298             opacuserlogin          => "" . C4::Context->preference("opacuserlogin"),
 299                         OpacMainUserBlock =>  "" . C4::Context->preference("OpacMainUserBlock"),
 300             opacbookbag            => "" . C4::Context->preference("opacbookbag"),
 301             TemplateEncoding       => "". C4::Context->preference("TemplateEncoding"),
 302             AmazonContent          => "" . C4::Context->preference("AmazonContent"),
 303             OPACShelfBrowser       => "". C4::Context->preference("OPACShelfBrowser"),
 304             OPACAmazonSimilarItems => "" . C4::Context->preference("OPACAmazonSimilarItems"),
 305             LibraryName            => "" . C4::Context->preference("LibraryName"),
 306             LibraryNameTitle       => "" . $LibraryNameTitle,
 307             LoginBranchcode        => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 308             LoginBranchname        => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 309             LoginFirstname        => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 310             LoginSurname        => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 311             OpacPasswordChange     => C4::Context->preference("OpacPasswordChange"),
 312             opacreadinghistory     => C4::Context->preference("opacreadinghistory"),
 313             opacuserjs             => C4::Context->preference("opacuserjs"),
 314             OpacCloud              => C4::Context->preference("OpacCloud"),
 315             OpacTopissue           => C4::Context->preference("OpacTopissue"),
 316             OpacAuthorities        => C4::Context->preference("OpacAuthorities"),
 317             OpacBrowser            => C4::Context->preference("OpacBrowser"),
 318             RequestOnOpac          => C4::Context->preference("RequestOnOpac"),
 319             reviewson              => C4::Context->preference("reviewson"),
 320             hide_marc              => C4::Context->preference("hide_marc"),
 321             patronimages           => C4::Context->preference("patronimages"),
 322             hidelostitems          => C4::Context->preference("hidelostitems"),
 323             mylibraryfirst   => C4::Context->preference("SearchMyLibraryFirst"),
 324             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 325             OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
 326             'item-level_itypes' => C4::Context->preference('item-level_itypes'),
 327                         yuipath => C4::Context->preference("yuipath"),
 328         );
 329     }
 330         $template->param(listloop=>[{shelfname=>"Freelist", shelfnumber=>110}]);
 331     return ( $template, $borrowernumber, $cookie, $flags);
 332 }
 333
 334 =item checkauth
 335
 336   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 337
 338 Verifies that the user is authorized to run this script.  If
 339 the user is authorized, a (userid, cookie, session-id, flags)
 340 quadruple is returned.  If the user is not authorized but does
 341 not have the required privilege (see $flagsrequired below), it
 342 displays an error page and exits.  Otherwise, it displays the
 343 login page and exits.
 344
 345 Note that C<&checkauth> will return if and only if the user
 346 is authorized, so it should be called early on, before any
 347 unfinished operations (e.g., if you've opened a file, then
 348 C<&checkauth> won't close it for you).
 349
 350 C<$query> is the CGI object for the script calling C<&checkauth>.
 351
 352 The C<$noauth> argument is optional. If it is set, then no
 353 authorization is required for the script.
 354
 355 C<&checkauth> fetches user and session information from C<$query> and
 356 ensures that the user is authorized to run scripts that require
 357 authorization.
 358
 359 The C<$flagsrequired> argument specifies the required privileges
 360 the user must have if the username and password are correct.
 361 It should be specified as a reference-to-hash; keys in the hash
 362 should be the "flags" for the user, as specified in the Members
 363 intranet module. Any key specified must correspond to a "flag"
 364 in the userflags table. E.g., { circulate => 1 } would specify
 365 that the user must have the "circulate" privilege in order to
 366 proceed. To make sure that access control is correct, the
 367 C<$flagsrequired> parameter must be specified correctly.
 368
 369 The C<$type> argument specifies whether the template should be
 370 retrieved from the opac or intranet directory tree.  "opac" is
 371 assumed if it is not specified; however, if C<$type> is specified,
 372 "intranet" is assumed if it is not "opac".
 373
 374 If C<$query> does not have a valid session ID associated with it
 375 (i.e., the user has not logged in) or if the session has expired,
 376 C<&checkauth> presents the user with a login page (from the point of
 377 view of the original script, C<&checkauth> does not return). Once the
 378 user has authenticated, C<&checkauth> restarts the original script
 379 (this time, C<&checkauth> returns).
 380
 381 The login page is provided using a HTML::Template, which is set in the
 382 systempreferences table or at the top of this file. The variable C<$type>
 383 selects which template to use, either the opac or the intranet
 384 authentification template.
 385
 386 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 387 cookie should be sent back to the browser; it verifies that the user
 388 has authenticated.
 389
 390 =cut
 391
 392 sub _version_check ($$) {
 393     my $type = shift;
 394     my $query = shift;
 395     my $version;
 396     # If Version syspref is unavailable, it means Koha is beeing installed,
 397     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 398     #warn "about to check version";
 399     unless ($version = C4::Context->preference('Version')) {    # assignment, not comparison
 400       if ($type ne 'opac') {
 401         warn "Install required, redirecting to Installer";
 402         print $query->redirect("/cgi-bin/koha/installer/install.pl");
 403       }
 404       else {
 405         warn "OPAC Install required, redirecting to maintenance";
 406         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 407       }
 408       exit;
 409     }
 410
 411     # check that database and koha version are the same
 412     # there is no DB version, it's a fresh install,
 413     # go to web installer
 414     # there is a DB version, compare it to the code version
 415     my $kohaversion=C4::Context::KOHAVERSION;
 416     # remove the 3 last . to have a Perl number
 417     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 418     $debug and print STDERR "kohaversion : $kohaversion\n";
 419     if ($version < $kohaversion){
 420         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is "
 421             . C4::Context->config("kohaversion");
 422         if ($type ne 'opac'){
 423             warn sprintf($warning, 'Installer');
 424             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 425         } else {
 426             warn sprintf("OPAC: " . $warning, 'maintenance');
 427             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 428         }
 429         exit;
 430     }
 431 }
 432
 433 sub _session_log {
 434     (@_) or return 0;
 435     open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 436     printf L join("\n",@_);
 437     close L;
 438 }
 439
 440 sub checkauth {
 441     my $query = shift;
 442         $debug and warn "Checking Auth";
 443     # $authnotrequired will be set for scripts which will run without authentication
 444     my $authnotrequired = shift;
 445     my $flagsrequired   = shift;
 446     my $type            = shift;
 447     $type = 'opac' unless $type;
 448
 449     my $dbh     = C4::Context->dbh;
 450     my $timeout = C4::Context->preference('timeout');
 451     # days
 452     if ($timeout =~ /(\d+)[dD]/) {
 453         $timeout = $1 * 86400;
 454     };
 455     $timeout = 600 unless $timeout;
 456
 457     _version_check($type,$query);
 458     # state variables
 459     my $loggedin = 0;
 460     my %info;
 461     my ( $userid, $cookie, $sessionID, $flags, $shelves );
 462     my $logout = $query->param('logout.x');
 463     if ( $userid = $ENV{'REMOTE_USER'} ) {
 464         # Using Basic Authentication, no cookies required
 465         $cookie = $query->cookie(
 466             -name    => 'CGISESSID',
 467             -value   => '',
 468             -expires => ''
 469         );
 470         $loggedin = 1;
 471     }
 472     elsif ( $sessionID = $query->cookie("CGISESSID")) {     # assignment, not comparison
 473         my $session = get_session($sessionID);
 474         C4::Context->_new_userenv($sessionID);
 475         my ($ip, $lasttime);
 476         if ($session){
 477             C4::Context::set_userenv(
 478                 $session->param('number'),       $session->param('id'),
 479                 $session->param('cardnumber'),   $session->param('firstname'),
 480                 $session->param('surname'),      $session->param('branch'),
 481                 $session->param('branchname'),   $session->param('flags'),
 482                 $session->param('emailaddress'), $session->param('branchprinter')
 483             );
 484             C4::Context::set_shelves_userenv($session->param('shelves'));
 485             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 486             $ip       = $session->param('ip');
 487             $lasttime = $session->param('lasttime');
 488             $userid   = $session->param('id');
 489         }
 490
 491         if ($logout) {
 492             # voluntary logout the user
 493             $session->flush;
 494             $session->delete();
 495             C4::Context->_unset_userenv($sessionID);
 496             _session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,localtime);
 497             $sessionID = undef;
 498             $userid    = undef;
 499         }
 500                 elsif ( $lasttime < time() - $timeout ) {
 501                         # timed logout
 502                         $info{'timed_out'} = 1;
 503                         $session->delete();
 504                         C4::Context->_unset_userenv($sessionID);
 505                         _session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,localtime);
 506                         $userid    = undef;
 507                         $sessionID = undef;
 508                 }
 509                 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 510                         # Different ip than originally logged in from
 511                         $info{'oldip'}        = $ip;
 512                         $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 513                         $info{'different_ip'} = 1;
 514                         $session->delete();
 515                         C4::Context->_unset_userenv($sessionID);
 516                         _session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,localtime, $info{'newip'});
 517                         $sessionID = undef;
 518                         $userid    = undef;
 519                 }
 520                 else {
 521                         $cookie = $query->cookie( CGISESSID => $session->id );
 522                         $session->param('lasttime',time());
 523                         $flags = haspermission( $dbh, $userid, $flagsrequired );
 524                         if ($flags) {
 525                                 $loggedin = 1;
 526                         } else {
 527                                 $info{'nopermission'} = 1;
 528                         }
 529                 }
 530     }
 531     unless ($userid) {
 532         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 533         my $sessionID = $session->id;
 534         $userid    = $query->param('userid');
 535         my $password = $query->param('password');
 536         C4::Context->_new_userenv($sessionID);
 537         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 538         if ($return) {
 539             _session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},localtime);
 540             $cookie = $query->cookie(CGISESSID => $sessionID);
 541             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 542                                 $loggedin = 1;
 543             }
 544             else {
 545                 $info{'nopermission'} = 1;
 546                 C4::Context->_unset_userenv($sessionID);
 547             }
 548
 549                         my ($borrowernumber, $firstname, $surname, $userflags,
 550                                 $branchcode, $branchname, $branchprinter, $emailaddress);
 551
 552             if ( $return == 1 ) {
 553                 my $select = "
 554                 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 555                         branches.branchname    as branchname,
 556                         branches.branchprinter as branchprinter,
 557                         email
 558                 FROM borrowers
 559                 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 560                 ";
 561                 my $sth = $dbh->prepare("$select where userid=?");
 562                 $sth->execute($userid);
 563                                 unless ($sth->rows) {
 564                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 565                                         $sth = $dbh->prepare("$select where cardnumber=?");
 566                     $sth->execute($cardnumber);
 567                                         unless ($sth->rows) {
 568                                 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 569                         $sth->execute($userid);
 570                                                 unless ($sth->rows) {
 571                                         $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 572                                                 }
 573                                         }
 574                                 }
 575                 if ($sth->rows) {
 576                     ($borrowernumber, $firstname, $surname, $userflags,
 577                         $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 578                                         $debug and print STDERR "AUTH_3 results: " .
 579                                                 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 580                                 } else {
 581                                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 582                                 }
 583
 584 # launch a sequence to check if we have a ip for the branch, i
 585 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 586
 587                 my $ip       = $ENV{'REMOTE_ADDR'};
 588                 # if they specify at login, use that
 589                 if ($query->param('branch')) {
 590                     $branchcode  = $query->param('branch');
 591                     $branchname = GetBranchName($branchcode);
 592                 }
 593                 my $branches = GetBranches();
 594                 if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 595                                     # we have to check they are coming from the right ip range
 596                                         my $domain = $branches->{$branchcode}->{'branchip'};
 597                                         if ($ip !~ /^$domain/){
 598                                                 $loggedin=0;
 599                                                 $info{'wrongip'} = 1;
 600                                         }
 601                                 }
 602
 603                 my @branchesloop;
 604                 foreach my $br ( keys %$branches ) {
 605                     #     now we work with the treatment of ip
 606                     my $domain = $branches->{$br}->{'branchip'};
 607                     if ( $domain && $ip =~ /^$domain/ ) {
 608                         $branchcode = $branches->{$br}->{'branchcode'};
 609
 610                         # new op dev : add the branchprinter and branchname in the cookie
 611                         $branchprinter = $branches->{$br}->{'branchprinter'};
 612                         $branchname    = $branches->{$br}->{'branchname'};
 613                     }
 614                 }
 615                 $session->param('number',$borrowernumber);
 616                 $session->param('id',$userid);
 617                 $session->param('cardnumber',$cardnumber);
 618                 $session->param('firstname',$firstname);
 619                 $session->param('surname',$surname);
 620                 $session->param('branch',$branchcode);
 621                 $session->param('branchname',$branchname);
 622                 $session->param('flags',$userflags);
 623                 $session->param('emailaddress',$emailaddress);
 624                 $session->param('ip',$session->remote_addr());
 625                 $session->param('lasttime',time());
 626                 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 627             }
 628             elsif ( $return == 2 ) {
 629                 #We suppose the user is the superlibrarian
 630                                 $borrowernumber = 0;
 631                 $session->param('number',0);
 632                 $session->param('id',C4::Context->config('user'));
 633                 $session->param('cardnumber',C4::Context->config('user'));
 634                 $session->param('firstname',C4::Context->config('user'));
 635                 $session->param('surname',C4::Context->config('user'));
 636                 $session->param('branch','NO_LIBRARY_SET');
 637                 $session->param('branchname','NO_LIBRARY_SET');
 638                 $session->param('flags',1);
 639                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 640                 $session->param('ip',$session->remote_addr());
 641                 $session->param('lasttime',time());
 642             }
 643             C4::Context::set_userenv(
 644                 $session->param('number'),       $session->param('id'),
 645                 $session->param('cardnumber'),   $session->param('firstname'),
 646                 $session->param('surname'),      $session->param('branch'),
 647                 $session->param('branchname'),   $session->param('flags'),
 648                 $session->param('emailaddress'), $session->param('branchprinter')
 649             );
 650                         $shelves = GetShelvesSummary($borrowernumber,2,10);
 651                         $session->param('shelves', $shelves);
 652                         C4::Context::set_shelves_userenv($shelves);
 653         }
 654         else {
 655             if ($userid) {
 656                 $info{'invalid_username_or_password'} = 1;
 657                 C4::Context->_unset_userenv($sessionID);
 658             }
 659
 660         }
 661     }   # END unless ($userid)
 662     my $insecure = C4::Context->boolean_preference('insecure');
 663
 664     # finished authentification, now respond
 665     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 666     {
 667         # successful login
 668         unless ($cookie) {
 669             $cookie = $query->cookie( CGISESSID => '' );
 670         }
 671         return ( $userid, $cookie, $sessionID, $flags );
 672     }
 673
 674 #
 675 #
 676 # AUTH rejected, show the login/password template, after checking the DB.
 677 #
 678 #
 679
 680     # get the inputs from the incoming query
 681     my @inputs = ();
 682     foreach my $name ( param $query) {
 683         (next) if ( $name eq 'userid' || $name eq 'password' );
 684         my $value = $query->param($name);
 685         push @inputs, { name => $name, value => $value };
 686     }
 687     # get the branchloop, which we need for authentication
 688     my $branches = GetBranches();
 689     my @branch_loop;
 690     for my $branch_hash (sort keys %$branches) {
 691                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
 692     }
 693
 694     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
 695     my $template = gettemplate( $template_name, $type, $query );
 696     $template->param(branchloop => \@branch_loop,);
 697     $template->param(
 698     login        => 1,
 699         INPUTS               => \@inputs,
 700         suggestion           => C4::Context->preference("suggestion"),
 701         virtualshelves       => C4::Context->preference("virtualshelves"),
 702         opaclargeimage       => C4::Context->preference("opaclargeimage"),
 703         LibraryName          => C4::Context->preference("LibraryName"),
 704         opacuserlogin        => C4::Context->preference("opacuserlogin"),
 705         OpacNav              => C4::Context->preference("OpacNav"),
 706         opaccredits          => C4::Context->preference("opaccredits"),
 707         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 708         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 709         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 710         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 711         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 712         opacuserjs           => C4::Context->preference("opacuserjs"),
 713         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
 714         OpacCloud            => C4::Context->preference("OpacCloud"),
 715         OpacTopissue         => C4::Context->preference("OpacTopissue"),
 716         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
 717         OpacBrowser          => C4::Context->preference("OpacBrowser"),
 718         intranetcolorstylesheet =>
 719                                                                 C4::Context->preference("intranetcolorstylesheet"),
 720         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 721         IntranetNav        => C4::Context->preference("IntranetNav"),
 722         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 723         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 724         IndependantBranches=> C4::Context->preference("IndependantBranches"),
 725         AutoLocation       => C4::Context->preference("AutoLocation"),
 726         yuipath            => C4::Context->preference("yuipath"),
 727                 wrongip            => $info{'wrongip'}
 728     );
 729
 730     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 731
 732     my $self_url = $query->url( -absolute => 1 );
 733     $template->param(
 734         url         => $self_url,
 735         LibraryName => C4::Context->preference("LibraryName"),
 736     );
 737     $template->param( \%info );
 738 #    $cookie = $query->cookie(CGISESSID => $session->id
 739 #   );
 740     print $query->header(
 741         -type   => 'text/html',
 742         -charset => 'utf-8',
 743         -cookie => $cookie
 744       ),
 745       $template->output;
 746     exit;
 747 }
 748
 749 =item check_api_auth
 750
 751   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 752
 753 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 754 cookie, determine if the user has the privileges specified by C<$userflags>.
 755
 756 C<check_api_auth> is is meant for authenticating users of web services, and
 757 consequently will always return and will not attempt to redirect the user
 758 agent.
 759
 760 If a valid session cookie is already present, check_api_auth will return a status
 761 of "ok", the cookie, and the Koha session ID.
 762
 763 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 764 parameters and create a session cookie and Koha session if the supplied credentials
 765 are OK.
 766
 767 Possible return values in C<$status> are:
 768
 769 =over 4
 770
 771 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 772
 773 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 774
 775 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 776
 777 =item "expired -- session cookie has expired; API user should resubmit userid and password
 778
 779 =back
 780
 781 =cut
 782
 783 sub check_api_auth {
 784     my $query = shift;
 785     my $flagsrequired = shift;
 786
 787     my $dbh     = C4::Context->dbh;
 788     my $timeout = C4::Context->preference('timeout');
 789     $timeout = 600 unless $timeout;
 790
 791     unless (C4::Context->preference('Version')) {
 792         # database has not been installed yet
 793         return ("maintenance", undef, undef);
 794     }
 795     my $kohaversion=C4::Context::KOHAVERSION;
 796     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 797     if (C4::Context->preference('Version') < $kohaversion) {
 798         # database in need of version update; assume that
 799         # no API should be called while databsae is in
 800         # this condition.
 801         return ("maintenance", undef, undef);
 802     }
 803
 804     # FIXME -- most of what follows is a copy-and-paste
 805     # of code from checkauth.  There is an obvious need
 806     # for refactoring to separate the various parts of
 807     # the authentication code, but as of 2007-11-19 this
 808     # is deferred so as to not introduce bugs into the
 809     # regular authentication code for Koha 3.0.
 810
 811     # see if we have a valid session cookie already
 812     # however, if a userid parameter is present (i.e., from
 813     # a form submission, assume that any current cookie
 814     # is to be ignored
 815     my $sessionID = undef;
 816     unless ($query->param('userid')) {
 817         $sessionID = $query->cookie("CGISESSID");
 818     }
 819     if ($sessionID) {
 820         my $session = get_session($sessionID);
 821         C4::Context->_new_userenv($sessionID);
 822         if ($session) {
 823             C4::Context::set_userenv(
 824                 $session->param('number'),       $session->param('id'),
 825                 $session->param('cardnumber'),   $session->param('firstname'),
 826                 $session->param('surname'),      $session->param('branch'),
 827                 $session->param('branchname'),   $session->param('flags'),
 828                 $session->param('emailaddress'), $session->param('branchprinter')
 829             );
 830
 831             my $ip = $session->param('ip');
 832             my $lasttime = $session->param('lasttime');
 833             my $userid = $session->param('id');
 834             if ( $lasttime < time() - $timeout ) {
 835                 # time out
 836                 $session->delete();
 837                 C4::Context->_unset_userenv($sessionID);
 838                 $userid    = undef;
 839                 $sessionID = undef;
 840                 return ("expired", undef, undef);
 841             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 842                 # IP address changed
 843                 $session->delete();
 844                 C4::Context->_unset_userenv($sessionID);
 845                 $userid    = undef;
 846                 $sessionID = undef;
 847                 return ("expired", undef, undef);
 848             } else {
 849                 my $cookie = $query->cookie( CGISESSID => $session->id );
 850                 $session->param('lasttime',time());
 851                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 852                 if ($flags) {
 853                     return ("ok", $cookie, $sessionID);
 854                 } else {
 855                     $session->delete();
 856                     C4::Context->_unset_userenv($sessionID);
 857                     $userid    = undef;
 858                     $sessionID = undef;
 859                     return ("failed", undef, undef);
 860                 }
 861             }
 862         } else {
 863             return ("expired", undef, undef);
 864         }
 865     } else {
 866         # new login
 867         my $userid = $query->param('userid');
 868         my $password = $query->param('password');
 869         unless ($userid and $password) {
 870             # caller did something wrong, fail the authenticateion
 871             return ("failed", undef, undef);
 872         }
 873         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 874         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 875             my $session = get_session("");
 876             return ("failed", undef, undef) unless $session;
 877
 878             my $sessionID = $session->id;
 879             C4::Context->_new_userenv($sessionID);
 880             my $cookie = $query->cookie(CGISESSID => $sessionID);
 881             if ( $return == 1 ) {
 882                 my (
 883                     $borrowernumber, $firstname,  $surname,
 884                     $userflags,      $branchcode, $branchname,
 885                     $branchprinter,  $emailaddress
 886                 );
 887                 my $sth =
 888                   $dbh->prepare(
 889 "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=?"
 890                   );
 891                 $sth->execute($userid);
 892                 (
 893                     $borrowernumber, $firstname,  $surname,
 894                     $userflags,      $branchcode, $branchname,
 895                     $branchprinter,  $emailaddress
 896                 ) = $sth->fetchrow if ( $sth->rows );
 897
 898                 unless ($sth->rows ) {
 899                     my $sth = $dbh->prepare(
 900 "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=?"
 901                       );
 902                     $sth->execute($cardnumber);
 903                     (
 904                         $borrowernumber, $firstname,  $surname,
 905                         $userflags,      $branchcode, $branchname,
 906                         $branchprinter,  $emailaddress
 907                     ) = $sth->fetchrow if ( $sth->rows );
 908
 909                     unless ( $sth->rows ) {
 910                         $sth->execute($userid);
 911                         (
 912                             $borrowernumber, $firstname, $surname, $userflags,
 913                             $branchcode, $branchname, $branchprinter, $emailaddress
 914                         ) = $sth->fetchrow if ( $sth->rows );
 915                     }
 916                 }
 917
 918                 my $ip       = $ENV{'REMOTE_ADDR'};
 919                 # if they specify at login, use that
 920                 if ($query->param('branch')) {
 921                     $branchcode  = $query->param('branch');
 922                     $branchname = GetBranchName($branchcode);
 923                 }
 924                 my $branches = GetBranches();
 925                 my @branchesloop;
 926                 foreach my $br ( keys %$branches ) {
 927                     #     now we work with the treatment of ip
 928                     my $domain = $branches->{$br}->{'branchip'};
 929                     if ( $domain && $ip =~ /^$domain/ ) {
 930                         $branchcode = $branches->{$br}->{'branchcode'};
 931
 932                         # new op dev : add the branchprinter and branchname in the cookie
 933                         $branchprinter = $branches->{$br}->{'branchprinter'};
 934                         $branchname    = $branches->{$br}->{'branchname'};
 935                     }
 936                 }
 937                 $session->param('number',$borrowernumber);
 938                 $session->param('id',$userid);
 939                 $session->param('cardnumber',$cardnumber);
 940                 $session->param('firstname',$firstname);
 941                 $session->param('surname',$surname);
 942                 $session->param('branch',$branchcode);
 943                 $session->param('branchname',$branchname);
 944                 $session->param('flags',$userflags);
 945                 $session->param('emailaddress',$emailaddress);
 946                 $session->param('ip',$session->remote_addr());
 947                 $session->param('lasttime',time());
 948             } elsif ( $return == 2 ) {
 949                 #We suppose the user is the superlibrarian
 950                 $session->param('number',0);
 951                 $session->param('id',C4::Context->config('user'));
 952                 $session->param('cardnumber',C4::Context->config('user'));
 953                 $session->param('firstname',C4::Context->config('user'));
 954                 $session->param('surname',C4::Context->config('user'));
 955                 $session->param('branch','NO_LIBRARY_SET');
 956                 $session->param('branchname','NO_LIBRARY_SET');
 957                 $session->param('flags',1);
 958                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 959                 $session->param('ip',$session->remote_addr());
 960                 $session->param('lasttime',time());
 961             }
 962             C4::Context::set_userenv(
 963                 $session->param('number'),       $session->param('id'),
 964                 $session->param('cardnumber'),   $session->param('firstname'),
 965                 $session->param('surname'),      $session->param('branch'),
 966                 $session->param('branchname'),   $session->param('flags'),
 967                 $session->param('emailaddress'), $session->param('branchprinter')
 968             );
 969             return ("ok", $cookie, $sessionID);
 970         } else {
 971             return ("failed", undef, undef);
 972         }
 973     }
 974 }
 975
 976 =item check_cookie_auth
 977
 978   ($status, $sessionId) = check_api_auth($cookie, $userflags);
 979
 980 Given a CGISESSID cookie set during a previous login to Koha, determine
 981 if the user has the privileges specified by C<$userflags>.
 982
 983 C<check_cookie_auth> is meant for authenticating special services
 984 such as tools/upload-file.pl that are invoked by other pages that
 985 have been authenticated in the usual way.
 986
 987 Possible return values in C<$status> are:
 988
 989 =over 4
 990
 991 =item "ok" -- user authenticated; C<$sessionID> have valid values.
 992
 993 =item "failed" -- credentials are not correct; C<$sessionid> are undef
 994
 995 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 996
 997 =item "expired -- session cookie has expired; API user should resubmit userid and password
 998
 999 =back
1000
1001 =cut
1002
1003 sub check_cookie_auth {
1004     my $cookie = shift;
1005     my $flagsrequired = shift;
1006
1007     my $dbh     = C4::Context->dbh;
1008     my $timeout = C4::Context->preference('timeout');
1009     $timeout = 600 unless $timeout;
1010
1011     unless (C4::Context->preference('Version')) {
1012         # database has not been installed yet
1013         return ("maintenance", undef);
1014     }
1015     my $kohaversion=C4::Context::KOHAVERSION;
1016     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1017     if (C4::Context->preference('Version') < $kohaversion) {
1018         # database in need of version update; assume that
1019         # no API should be called while databsae is in
1020         # this condition.
1021         return ("maintenance", undef);
1022     }
1023
1024     # FIXME -- most of what follows is a copy-and-paste
1025     # of code from checkauth.  There is an obvious need
1026     # for refactoring to separate the various parts of
1027     # the authentication code, but as of 2007-11-23 this
1028     # is deferred so as to not introduce bugs into the
1029     # regular authentication code for Koha 3.0.
1030
1031     # see if we have a valid session cookie already
1032     # however, if a userid parameter is present (i.e., from
1033     # a form submission, assume that any current cookie
1034     # is to be ignored
1035     unless (defined $cookie and $cookie) {
1036         return ("failed", undef);
1037     }
1038     my $sessionID = $cookie;
1039     my $session = get_session($sessionID);
1040     C4::Context->_new_userenv($sessionID);
1041     if ($session) {
1042         C4::Context::set_userenv(
1043             $session->param('number'),       $session->param('id'),
1044             $session->param('cardnumber'),   $session->param('firstname'),
1045             $session->param('surname'),      $session->param('branch'),
1046             $session->param('branchname'),   $session->param('flags'),
1047             $session->param('emailaddress'), $session->param('branchprinter')
1048         );
1049
1050         my $ip = $session->param('ip');
1051         my $lasttime = $session->param('lasttime');
1052         my $userid = $session->param('id');
1053         if ( $lasttime < time() - $timeout ) {
1054             # time out
1055             $session->delete();
1056             C4::Context->_unset_userenv($sessionID);
1057             $userid    = undef;
1058             $sessionID = undef;
1059             return ("expired", undef);
1060         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1061             # IP address changed
1062             $session->delete();
1063             C4::Context->_unset_userenv($sessionID);
1064             $userid    = undef;
1065             $sessionID = undef;
1066             return ("expired", undef);
1067         } else {
1068             $session->param('lasttime',time());
1069             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1070             if ($flags) {
1071                 return ("ok", $sessionID);
1072             } else {
1073                 $session->delete();
1074                 C4::Context->_unset_userenv($sessionID);
1075                 $userid    = undef;
1076                 $sessionID = undef;
1077                 return ("failed", undef);
1078             }
1079         }
1080     } else {
1081         return ("expired", undef);
1082     }
1083 }
1084
1085 =item get_session
1086
1087   use CGI::Session;
1088   my $session = get_session($sessionID);
1089
1090 Given a session ID, retrieve the CGI::Session object used to store
1091 the session's state.  The session object can be used to store
1092 data that needs to be accessed by different scripts during a
1093 user's session.
1094
1095 If the C<$sessionID> parameter is an empty string, a new session
1096 will be created.
1097
1098 =cut
1099
1100 sub get_session {
1101     my $sessionID = shift;
1102     my $storage_method = C4::Context->preference('SessionStorage');
1103     my $dbh = C4::Context->dbh;
1104     my $session;
1105     if ($storage_method eq 'mysql'){
1106         $session = new CGI::Session("driver:MySQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1107     }
1108     elsif ($storage_method eq 'Pg') {
1109         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1110     }
1111     else {
1112         # catch all defaults to tmp should work on all systems
1113         $session = new CGI::Session("driver:File;serializer:yaml", $sessionID, {Directory=>'/tmp'});
1114     }
1115     return $session;
1116 }
1117
1118 sub checkpw {
1119
1120     my ( $dbh, $userid, $password ) = @_;
1121     if ($ldap) {
1122         $debug and print "## checkpw - checking LDAP\n";
1123         my ($retval,$retcard) = checkpw_ldap(@_);    # EXTERNAL AUTH
1124         ($retval) and return ($retval,$retcard);
1125     }
1126
1127     # INTERNAL AUTH
1128     my $sth =
1129       $dbh->prepare(
1130 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1131       );
1132     $sth->execute($userid);
1133     if ( $sth->rows ) {
1134         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1135             $surname, $branchcode, $flags )
1136           = $sth->fetchrow;
1137         if ( md5_base64($password) eq $md5password ) {
1138
1139             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1140                 $firstname, $surname, $branchcode, $flags );
1141             return 1, $cardnumber;
1142         }
1143     }
1144     $sth =
1145       $dbh->prepare(
1146 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1147       );
1148     $sth->execute($userid);
1149     if ( $sth->rows ) {
1150         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1151             $surname, $branchcode, $flags )
1152           = $sth->fetchrow;
1153         if ( md5_base64($password) eq $md5password ) {
1154
1155             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1156                 $firstname, $surname, $branchcode, $flags );
1157             return 1, $userid;
1158         }
1159     }
1160     if (   $userid && $userid eq C4::Context->config('user')
1161         && "$password" eq C4::Context->config('pass') )
1162     {
1163
1164 # Koha superuser account
1165 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1166         return 2;
1167     }
1168     if (   $userid && $userid eq 'demo'
1169         && "$password" eq 'demo'
1170         && C4::Context->config('demo') )
1171     {
1172
1173 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1174 # some features won't be effective : modify systempref, modify MARC structure,
1175         return 2;
1176     }
1177     return 0;
1178 }
1179
1180 =item getuserflags
1181
1182  $authflags = getuserflags($flags,$dbh);
1183 Translates integer flags into permissions strings hash.
1184
1185 C<$flags> is the integer userflags value ( borrowers.userflags )
1186 C<$authflags> is a hashref of permissions
1187
1188 =cut
1189
1190 sub getuserflags {
1191     my $flags   = shift;
1192     my $dbh     = shift;
1193     my $userflags;
1194     $flags = 0 unless $flags;
1195     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1196     $sth->execute;
1197
1198     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1199         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1200             $userflags->{$flag} = 1;
1201         }
1202         else {
1203             $userflags->{$flag} = 0;
1204         }
1205     }
1206     return $userflags;
1207 }
1208
1209 =item haspermission
1210
1211   $flags = ($dbh,$member,$flagsrequired);
1212
1213 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1214 C<$flags> is a hashref of required flags lik C<$borrower-&lt;{authflags}>
1215
1216 Returns member's flags or 0 if a permission is not met.
1217
1218 =cut
1219
1220 sub haspermission {
1221     my ( $dbh, $userid, $flagsrequired ) = @_;
1222     my ($flags,$intflags);
1223     $dbh=C4::Context->dbh unless($dbh);
1224     if(ref($userid)) {
1225         $intflags = $userid->{'flags'};
1226     } else {
1227         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1228         $sth->execute($userid);
1229         my ($intflags) = $sth->fetchrow;
1230         $flags = getuserflags( $intflags, $dbh );
1231     }
1232     if ( $userid eq C4::Context->config('user') ) {
1233         # Super User Account from /etc/koha.conf
1234         $flags->{'superlibrarian'} = 1;
1235     }
1236     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1237         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1238         $flags->{'superlibrarian'} = 1;
1239     }
1240     return $flags if $flags->{superlibrarian};
1241     foreach ( keys %$flagsrequired ) {
1242         return 0 unless( $flags->{$_} );
1243     }
1244     return $flags;
1245     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1246 }
1247
1248
1249 sub getborrowernumber {
1250     my ($userid) = @_;
1251     my $dbh = C4::Context->dbh;
1252     for my $field ( 'userid', 'cardnumber' ) {
1253         my $sth =
1254           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1255         $sth->execute($userid);
1256         if ( $sth->rows ) {
1257             my ($bnumber) = $sth->fetchrow;
1258             return $bnumber;
1259         }
1260     }
1261     return 0;
1262 }
1263
1264 END { }    # module clean-up code here (global destructor)
1265 1;
1266 __END__
1267
1268 =back
1269
1270 =head1 SEE ALSO
1271
1272 CGI(3)
1273
1274 C4::Output(3)
1275
1276 Digest::MD5(3)
1277
1278 =cut