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         intranetcolorstylesheet =>
 714                                                                 C4::Context->preference("intranetcolorstylesheet"),
 715         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 716         IntranetNav        => C4::Context->preference("IntranetNav"),
 717         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 718         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 719         IndependantBranches=> C4::Context->preference("IndependantBranches"),
 720         AutoLocation       => C4::Context->preference("AutoLocation"),
 721         yuipath            => C4::Context->preference("yuipath"),
 722                 wrongip            => $info{'wrongip'}
 723     );
 724
 725     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 726
 727     my $self_url = $query->url( -absolute => 1 );
 728     $template->param(
 729         url         => $self_url,
 730         LibraryName => C4::Context->preference("LibraryName"),
 731     );
 732     $template->param( \%info );
 733 #    $cookie = $query->cookie(CGISESSID => $session->id
 734 #   );
 735     print $query->header(
 736         -type   => 'text/html',
 737         -charset => 'utf-8',
 738         -cookie => $cookie
 739       ),
 740       $template->output;
 741     exit;
 742 }
 743
 744 =item check_api_auth
 745
 746   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 747
 748 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 749 cookie, determine if the user has the privileges specified by C<$userflags>.
 750
 751 C<check_api_auth> is is meant for authenticating users of web services, and
 752 consequently will always return and will not attempt to redirect the user
 753 agent.
 754
 755 If a valid session cookie is already present, check_api_auth will return a status
 756 of "ok", the cookie, and the Koha session ID.
 757
 758 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 759 parameters and create a session cookie and Koha session if the supplied credentials
 760 are OK.
 761
 762 Possible return values in C<$status> are:
 763
 764 =over 4
 765
 766 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 767
 768 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 769
 770 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 771
 772 =item "expired -- session cookie has expired; API user should resubmit userid and password
 773
 774 =back
 775
 776 =cut
 777
 778 sub check_api_auth {
 779     my $query = shift;
 780     my $flagsrequired = shift;
 781
 782     my $dbh     = C4::Context->dbh;
 783     my $timeout = C4::Context->preference('timeout');
 784     $timeout = 600 unless $timeout;
 785
 786     unless (C4::Context->preference('Version')) {
 787         # database has not been installed yet
 788         return ("maintenance", undef, undef);
 789     }
 790     my $kohaversion=C4::Context::KOHAVERSION;
 791     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 792     if (C4::Context->preference('Version') < $kohaversion) {
 793         # database in need of version update; assume that
 794         # no API should be called while databsae is in
 795         # this condition.
 796         return ("maintenance", undef, undef);
 797     }
 798
 799     # FIXME -- most of what follows is a copy-and-paste
 800     # of code from checkauth.  There is an obvious need
 801     # for refactoring to separate the various parts of
 802     # the authentication code, but as of 2007-11-19 this
 803     # is deferred so as to not introduce bugs into the
 804     # regular authentication code for Koha 3.0.
 805
 806     # see if we have a valid session cookie already
 807     # however, if a userid parameter is present (i.e., from
 808     # a form submission, assume that any current cookie
 809     # is to be ignored
 810     my $sessionID = undef;
 811     unless ($query->param('userid')) {
 812         $sessionID = $query->cookie("CGISESSID");
 813     }
 814     if ($sessionID) {
 815         my $session = get_session($sessionID);
 816         C4::Context->_new_userenv($sessionID);
 817         if ($session) {
 818             C4::Context::set_userenv(
 819                 $session->param('number'),       $session->param('id'),
 820                 $session->param('cardnumber'),   $session->param('firstname'),
 821                 $session->param('surname'),      $session->param('branch'),
 822                 $session->param('branchname'),   $session->param('flags'),
 823                 $session->param('emailaddress'), $session->param('branchprinter')
 824             );
 825
 826             my $ip = $session->param('ip');
 827             my $lasttime = $session->param('lasttime');
 828             my $userid = $session->param('id');
 829             if ( $lasttime < time() - $timeout ) {
 830                 # time out
 831                 $session->delete();
 832                 C4::Context->_unset_userenv($sessionID);
 833                 $userid    = undef;
 834                 $sessionID = undef;
 835                 return ("expired", undef, undef);
 836             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 837                 # IP address changed
 838                 $session->delete();
 839                 C4::Context->_unset_userenv($sessionID);
 840                 $userid    = undef;
 841                 $sessionID = undef;
 842                 return ("expired", undef, undef);
 843             } else {
 844                 my $cookie = $query->cookie( CGISESSID => $session->id );
 845                 $session->param('lasttime',time());
 846                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 847                 if ($flags) {
 848                     return ("ok", $cookie, $sessionID);
 849                 } else {
 850                     $session->delete();
 851                     C4::Context->_unset_userenv($sessionID);
 852                     $userid    = undef;
 853                     $sessionID = undef;
 854                     return ("failed", undef, undef);
 855                 }
 856             }
 857         } else {
 858             return ("expired", undef, undef);
 859         }
 860     } else {
 861         # new login
 862         my $userid = $query->param('userid');
 863         my $password = $query->param('password');
 864         unless ($userid and $password) {
 865             # caller did something wrong, fail the authenticateion
 866             return ("failed", undef, undef);
 867         }
 868         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 869         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 870             my $session = get_session("");
 871             return ("failed", undef, undef) unless $session;
 872
 873             my $sessionID = $session->id;
 874             C4::Context->_new_userenv($sessionID);
 875             my $cookie = $query->cookie(CGISESSID => $sessionID);
 876             if ( $return == 1 ) {
 877                 my (
 878                     $borrowernumber, $firstname,  $surname,
 879                     $userflags,      $branchcode, $branchname,
 880                     $branchprinter,  $emailaddress
 881                 );
 882                 my $sth =
 883                   $dbh->prepare(
 884 "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=?"
 885                   );
 886                 $sth->execute($userid);
 887                 (
 888                     $borrowernumber, $firstname,  $surname,
 889                     $userflags,      $branchcode, $branchname,
 890                     $branchprinter,  $emailaddress
 891                 ) = $sth->fetchrow if ( $sth->rows );
 892
 893                 unless ($sth->rows ) {
 894                     my $sth = $dbh->prepare(
 895 "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=?"
 896                       );
 897                     $sth->execute($cardnumber);
 898                     (
 899                         $borrowernumber, $firstname,  $surname,
 900                         $userflags,      $branchcode, $branchname,
 901                         $branchprinter,  $emailaddress
 902                     ) = $sth->fetchrow if ( $sth->rows );
 903
 904                     unless ( $sth->rows ) {
 905                         $sth->execute($userid);
 906                         (
 907                             $borrowernumber, $firstname, $surname, $userflags,
 908                             $branchcode, $branchname, $branchprinter, $emailaddress
 909                         ) = $sth->fetchrow if ( $sth->rows );
 910                     }
 911                 }
 912
 913                 my $ip       = $ENV{'REMOTE_ADDR'};
 914                 # if they specify at login, use that
 915                 if ($query->param('branch')) {
 916                     $branchcode  = $query->param('branch');
 917                     $branchname = GetBranchName($branchcode);
 918                 }
 919                 my $branches = GetBranches();
 920                 my @branchesloop;
 921                 foreach my $br ( keys %$branches ) {
 922                     #     now we work with the treatment of ip
 923                     my $domain = $branches->{$br}->{'branchip'};
 924                     if ( $domain && $ip =~ /^$domain/ ) {
 925                         $branchcode = $branches->{$br}->{'branchcode'};
 926
 927                         # new op dev : add the branchprinter and branchname in the cookie
 928                         $branchprinter = $branches->{$br}->{'branchprinter'};
 929                         $branchname    = $branches->{$br}->{'branchname'};
 930                     }
 931                 }
 932                 $session->param('number',$borrowernumber);
 933                 $session->param('id',$userid);
 934                 $session->param('cardnumber',$cardnumber);
 935                 $session->param('firstname',$firstname);
 936                 $session->param('surname',$surname);
 937                 $session->param('branch',$branchcode);
 938                 $session->param('branchname',$branchname);
 939                 $session->param('flags',$userflags);
 940                 $session->param('emailaddress',$emailaddress);
 941                 $session->param('ip',$session->remote_addr());
 942                 $session->param('lasttime',time());
 943             } elsif ( $return == 2 ) {
 944                 #We suppose the user is the superlibrarian
 945                 $session->param('number',0);
 946                 $session->param('id',C4::Context->config('user'));
 947                 $session->param('cardnumber',C4::Context->config('user'));
 948                 $session->param('firstname',C4::Context->config('user'));
 949                 $session->param('surname',C4::Context->config('user'));
 950                 $session->param('branch','NO_LIBRARY_SET');
 951                 $session->param('branchname','NO_LIBRARY_SET');
 952                 $session->param('flags',1);
 953                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 954                 $session->param('ip',$session->remote_addr());
 955                 $session->param('lasttime',time());
 956             }
 957             C4::Context::set_userenv(
 958                 $session->param('number'),       $session->param('id'),
 959                 $session->param('cardnumber'),   $session->param('firstname'),
 960                 $session->param('surname'),      $session->param('branch'),
 961                 $session->param('branchname'),   $session->param('flags'),
 962                 $session->param('emailaddress'), $session->param('branchprinter')
 963             );
 964             return ("ok", $cookie, $sessionID);
 965         } else {
 966             return ("failed", undef, undef);
 967         }
 968     }
 969 }
 970
 971 =item check_cookie_auth
 972
 973   ($status, $sessionId) = check_api_auth($cookie, $userflags);
 974
 975 Given a CGISESSID cookie set during a previous login to Koha, determine
 976 if the user has the privileges specified by C<$userflags>.
 977
 978 C<check_cookie_auth> is meant for authenticating special services
 979 such as tools/upload-file.pl that are invoked by other pages that
 980 have been authenticated in the usual way.
 981
 982 Possible return values in C<$status> are:
 983
 984 =over 4
 985
 986 =item "ok" -- user authenticated; C<$sessionID> have valid values.
 987
 988 =item "failed" -- credentials are not correct; C<$sessionid> are undef
 989
 990 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 991
 992 =item "expired -- session cookie has expired; API user should resubmit userid and password
 993
 994 =back
 995
 996 =cut
 997
 998 sub check_cookie_auth {
 999     my $cookie = shift;
1000     my $flagsrequired = shift;
1001
1002     my $dbh     = C4::Context->dbh;
1003     my $timeout = C4::Context->preference('timeout');
1004     $timeout = 600 unless $timeout;
1005
1006     unless (C4::Context->preference('Version')) {
1007         # database has not been installed yet
1008         return ("maintenance", undef);
1009     }
1010     my $kohaversion=C4::Context::KOHAVERSION;
1011     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1012     if (C4::Context->preference('Version') < $kohaversion) {
1013         # database in need of version update; assume that
1014         # no API should be called while databsae is in
1015         # this condition.
1016         return ("maintenance", undef);
1017     }
1018
1019     # FIXME -- most of what follows is a copy-and-paste
1020     # of code from checkauth.  There is an obvious need
1021     # for refactoring to separate the various parts of
1022     # the authentication code, but as of 2007-11-23 this
1023     # is deferred so as to not introduce bugs into the
1024     # regular authentication code for Koha 3.0.
1025
1026     # see if we have a valid session cookie already
1027     # however, if a userid parameter is present (i.e., from
1028     # a form submission, assume that any current cookie
1029     # is to be ignored
1030     unless (defined $cookie and $cookie) {
1031         return ("failed", undef);
1032     }
1033     my $sessionID = $cookie;
1034     my $session = get_session($sessionID);
1035     C4::Context->_new_userenv($sessionID);
1036     if ($session) {
1037         C4::Context::set_userenv(
1038             $session->param('number'),       $session->param('id'),
1039             $session->param('cardnumber'),   $session->param('firstname'),
1040             $session->param('surname'),      $session->param('branch'),
1041             $session->param('branchname'),   $session->param('flags'),
1042             $session->param('emailaddress'), $session->param('branchprinter')
1043         );
1044
1045         my $ip = $session->param('ip');
1046         my $lasttime = $session->param('lasttime');
1047         my $userid = $session->param('id');
1048         if ( $lasttime < time() - $timeout ) {
1049             # time out
1050             $session->delete();
1051             C4::Context->_unset_userenv($sessionID);
1052             $userid    = undef;
1053             $sessionID = undef;
1054             return ("expired", undef);
1055         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1056             # IP address changed
1057             $session->delete();
1058             C4::Context->_unset_userenv($sessionID);
1059             $userid    = undef;
1060             $sessionID = undef;
1061             return ("expired", undef);
1062         } else {
1063             $session->param('lasttime',time());
1064             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1065             if ($flags) {
1066                 return ("ok", $sessionID);
1067             } else {
1068                 $session->delete();
1069                 C4::Context->_unset_userenv($sessionID);
1070                 $userid    = undef;
1071                 $sessionID = undef;
1072                 return ("failed", undef);
1073             }
1074         }
1075     } else {
1076         return ("expired", undef);
1077     }
1078 }
1079
1080 =item get_session
1081
1082   use CGI::Session;
1083   my $session = get_session($sessionID);
1084
1085 Given a session ID, retrieve the CGI::Session object used to store
1086 the session's state.  The session object can be used to store
1087 data that needs to be accessed by different scripts during a
1088 user's session.
1089
1090 If the C<$sessionID> parameter is an empty string, a new session
1091 will be created.
1092
1093 =cut
1094
1095 sub get_session {
1096     my $sessionID = shift;
1097     my $storage_method = C4::Context->preference('SessionStorage');
1098     my $dbh = C4::Context->dbh;
1099     my $session;
1100     if ($storage_method eq 'mysql'){
1101         $session = new CGI::Session("driver:MySQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1102     }
1103     elsif ($storage_method eq 'Pg') {
1104         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1105     }
1106     else {
1107         # catch all defaults to tmp should work on all systems
1108         $session = new CGI::Session("driver:File;serializer:yaml", $sessionID, {Directory=>'/tmp'});
1109     }
1110     return $session;
1111 }
1112
1113 sub checkpw {
1114
1115     my ( $dbh, $userid, $password ) = @_;
1116     if ($ldap) {
1117         $debug and print "## checkpw - checking LDAP\n";
1118         my ($retval,$retcard) = checkpw_ldap(@_);    # EXTERNAL AUTH
1119         ($retval) and return ($retval,$retcard);
1120     }
1121
1122     # INTERNAL AUTH
1123     my $sth =
1124       $dbh->prepare(
1125 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1126       );
1127     $sth->execute($userid);
1128     if ( $sth->rows ) {
1129         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1130             $surname, $branchcode, $flags )
1131           = $sth->fetchrow;
1132         if ( md5_base64($password) eq $md5password ) {
1133
1134             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1135                 $firstname, $surname, $branchcode, $flags );
1136             return 1, $cardnumber;
1137         }
1138     }
1139     $sth =
1140       $dbh->prepare(
1141 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1142       );
1143     $sth->execute($userid);
1144     if ( $sth->rows ) {
1145         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1146             $surname, $branchcode, $flags )
1147           = $sth->fetchrow;
1148         if ( md5_base64($password) eq $md5password ) {
1149
1150             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1151                 $firstname, $surname, $branchcode, $flags );
1152             return 1, $userid;
1153         }
1154     }
1155     if (   $userid && $userid eq C4::Context->config('user')
1156         && "$password" eq C4::Context->config('pass') )
1157     {
1158
1159 # Koha superuser account
1160 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1161         return 2;
1162     }
1163     if (   $userid && $userid eq 'demo'
1164         && "$password" eq 'demo'
1165         && C4::Context->config('demo') )
1166     {
1167
1168 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1169 # some features won't be effective : modify systempref, modify MARC structure,
1170         return 2;
1171     }
1172     return 0;
1173 }
1174
1175 =item getuserflags
1176
1177  $authflags = getuserflags($flags,$dbh);
1178 Translates integer flags into permissions strings hash.
1179
1180 C<$flags> is the integer userflags value ( borrowers.userflags )
1181 C<$authflags> is a hashref of permissions
1182
1183 =cut
1184
1185 sub getuserflags {
1186     my $flags   = shift;
1187     my $dbh     = shift;
1188     my $userflags;
1189     $flags = 0 unless $flags;
1190     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1191     $sth->execute;
1192
1193     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1194         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1195             $userflags->{$flag} = 1;
1196         }
1197         else {
1198             $userflags->{$flag} = 0;
1199         }
1200     }
1201     return $userflags;
1202 }
1203
1204 =item haspermission
1205
1206   $flags = ($dbh,$member,$flagsrequired);
1207
1208 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1209 C<$flags> is a hashref of required flags lik C<$borrower-&lt;{authflags}>
1210
1211 Returns member's flags or 0 if a permission is not met.
1212
1213 =cut
1214
1215 sub haspermission {
1216     my ( $dbh, $userid, $flagsrequired ) = @_;
1217     my ($flags,$intflags);
1218     $dbh=C4::Context->dbh unless($dbh);
1219     if(ref($userid)) {
1220         $intflags = $userid->{'flags'};
1221     } else {
1222         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1223         $sth->execute($userid);
1224         my ($intflags) = $sth->fetchrow;
1225         $flags = getuserflags( $intflags, $dbh );
1226     }
1227     if ( $userid eq C4::Context->config('user') ) {
1228         # Super User Account from /etc/koha.conf
1229         $flags->{'superlibrarian'} = 1;
1230     }
1231     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1232         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1233         $flags->{'superlibrarian'} = 1;
1234     }
1235     return $flags if $flags->{superlibrarian};
1236     foreach ( keys %$flagsrequired ) {
1237         return 0 unless( $flags->{$_} );
1238     }
1239     return $flags;
1240     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1241 }
1242
1243
1244 sub getborrowernumber {
1245     my ($userid) = @_;
1246     my $dbh = C4::Context->dbh;
1247     for my $field ( 'userid', 'cardnumber' ) {
1248         my $sth =
1249           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1250         $sth->execute($userid);
1251         if ( $sth->rows ) {
1252             my ($bnumber) = $sth->fetchrow;
1253             return $bnumber;
1254         }
1255     }
1256     return 0;
1257 }
1258
1259 END { }    # module clean-up code here (global destructor)
1260 1;
1261 __END__
1262
1263 =back
1264
1265 =head1 SEE ALSO
1266
1267 CGI(3)
1268
1269 C4::Output(3)
1270
1271 Digest::MD5(3)
1272
1273 =cut