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             opacbookbag            => "" . C4::Context->preference("opacbookbag"),
 300             TemplateEncoding       => "". C4::Context->preference("TemplateEncoding"),
 301             AmazonContent          => "" . C4::Context->preference("AmazonContent"),
 302             OPACAmazonSimilarItems => "" . C4::Context->preference("OPACAmazonSimilarItems"),
 303             LibraryName            => "" . C4::Context->preference("LibraryName"),
 304             LibraryNameTitle       => "" . $LibraryNameTitle,
 305             LoginBranchcode        => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 306             LoginBranchname        => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 307             LoginFirstname        => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 308             LoginSurname        => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 309             OpacPasswordChange     => C4::Context->preference("OpacPasswordChange"),
 310             opacreadinghistory     => C4::Context->preference("opacreadinghistory"),
 311             opacuserjs             => C4::Context->preference("opacuserjs"),
 312             OpacCloud              => C4::Context->preference("OpacCloud"),
 313             OpacTopissue           => C4::Context->preference("OpacTopissue"),
 314             OpacAuthorities        => C4::Context->preference("OpacAuthorities"),
 315             OpacBrowser            => C4::Context->preference("OpacBrowser"),
 316             RequestOnOpac          => C4::Context->preference("RequestOnOpac"),
 317             reviewson              => C4::Context->preference("reviewson"),
 318             hide_marc              => C4::Context->preference("hide_marc"),
 319             patronimages           => C4::Context->preference("patronimages"),
 320             mylibraryfirst   => C4::Context->preference("SearchMyLibraryFirst"),
 321             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 322             OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
 323             'item-level_itypes' => C4::Context->preference('item-level_itypes'),
 324                         yuipath => C4::Context->preference("yuipath"),
 325         );
 326     }
 327         $template->param(listloop=>[{shelfname=>"Freelist", shelfnumber=>110}]);
 328     return ( $template, $borrowernumber, $cookie, $flags);
 329 }
 330
 331 =item checkauth
 332
 333   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 334
 335 Verifies that the user is authorized to run this script.  If
 336 the user is authorized, a (userid, cookie, session-id, flags)
 337 quadruple is returned.  If the user is not authorized but does
 338 not have the required privilege (see $flagsrequired below), it
 339 displays an error page and exits.  Otherwise, it displays the
 340 login page and exits.
 341
 342 Note that C<&checkauth> will return if and only if the user
 343 is authorized, so it should be called early on, before any
 344 unfinished operations (e.g., if you've opened a file, then
 345 C<&checkauth> won't close it for you).
 346
 347 C<$query> is the CGI object for the script calling C<&checkauth>.
 348
 349 The C<$noauth> argument is optional. If it is set, then no
 350 authorization is required for the script.
 351
 352 C<&checkauth> fetches user and session information from C<$query> and
 353 ensures that the user is authorized to run scripts that require
 354 authorization.
 355
 356 The C<$flagsrequired> argument specifies the required privileges
 357 the user must have if the username and password are correct.
 358 It should be specified as a reference-to-hash; keys in the hash
 359 should be the "flags" for the user, as specified in the Members
 360 intranet module. Any key specified must correspond to a "flag"
 361 in the userflags table. E.g., { circulate => 1 } would specify
 362 that the user must have the "circulate" privilege in order to
 363 proceed. To make sure that access control is correct, the
 364 C<$flagsrequired> parameter must be specified correctly.
 365
 366 The C<$type> argument specifies whether the template should be
 367 retrieved from the opac or intranet directory tree.  "opac" is
 368 assumed if it is not specified; however, if C<$type> is specified,
 369 "intranet" is assumed if it is not "opac".
 370
 371 If C<$query> does not have a valid session ID associated with it
 372 (i.e., the user has not logged in) or if the session has expired,
 373 C<&checkauth> presents the user with a login page (from the point of
 374 view of the original script, C<&checkauth> does not return). Once the
 375 user has authenticated, C<&checkauth> restarts the original script
 376 (this time, C<&checkauth> returns).
 377
 378 The login page is provided using a HTML::Template, which is set in the
 379 systempreferences table or at the top of this file. The variable C<$type>
 380 selects which template to use, either the opac or the intranet
 381 authentification template.
 382
 383 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 384 cookie should be sent back to the browser; it verifies that the user
 385 has authenticated.
 386
 387 =cut
 388
 389 sub _version_check ($$) {
 390     my $type = shift;
 391     my $query = shift;
 392     my $version;
 393     # If Version syspref is unavailable, it means Koha is beeing installed,
 394     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 395     #warn "about to check version";
 396     unless ($version = C4::Context->preference('Version')) {    # assignment, not comparison
 397       if ($type ne 'opac') {
 398         warn "Install required, redirecting to Installer";
 399         print $query->redirect("/cgi-bin/koha/installer/install.pl");
 400       }
 401       else {
 402         warn "OPAC Install required, redirecting to maintenance";
 403         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 404       }
 405       exit;
 406     }
 407
 408     # check that database and koha version are the same
 409     # there is no DB version, it's a fresh install,
 410     # go to web installer
 411     # there is a DB version, compare it to the code version
 412     my $kohaversion=C4::Context::KOHAVERSION;
 413     # remove the 3 last . to have a Perl number
 414     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 415     $debug and print STDERR "kohaversion : $kohaversion\n";
 416     if ($version < $kohaversion){
 417         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is "
 418             . C4::Context->config("kohaversion");
 419         if ($type ne 'opac'){
 420             warn sprintf($warning, 'Installer');
 421             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 422         } else {
 423             warn sprintf("OPAC: " . $warning, 'maintenance');
 424             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 425         }
 426         exit;
 427     }
 428 }
 429
 430 sub _session_log {
 431     (@_) or return 0;
 432     open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 433     printf L join("\n",@_);
 434     close L;
 435 }
 436
 437 sub checkauth {
 438     my $query = shift;
 439         $debug and warn "Checking Auth";
 440     # $authnotrequired will be set for scripts which will run without authentication
 441     my $authnotrequired = shift;
 442     my $flagsrequired   = shift;
 443     my $type            = shift;
 444     $type = 'opac' unless $type;
 445
 446     my $dbh     = C4::Context->dbh;
 447     my $timeout = C4::Context->preference('timeout');
 448     # days
 449     if ($timeout =~ /(\d+)[dD]/) {
 450         $timeout = $1 * 86400;
 451     };
 452     $timeout = 600 unless $timeout;
 453
 454     _version_check($type,$query);
 455     # state variables
 456     my $loggedin = 0;
 457     my %info;
 458     my ( $userid, $cookie, $sessionID, $flags, $shelves );
 459     my $logout = $query->param('logout.x');
 460     if ( $userid = $ENV{'REMOTE_USER'} ) {
 461         # Using Basic Authentication, no cookies required
 462         $cookie = $query->cookie(
 463             -name    => 'CGISESSID',
 464             -value   => '',
 465             -expires => ''
 466         );
 467         $loggedin = 1;
 468     }
 469     elsif ( $sessionID = $query->cookie("CGISESSID")) {     # assignment, not comparison
 470         my $session = get_session($sessionID);
 471         C4::Context->_new_userenv($sessionID);
 472         my ($ip, $lasttime);
 473         if ($session){
 474             C4::Context::set_userenv(
 475                 $session->param('number'),       $session->param('id'),
 476                 $session->param('cardnumber'),   $session->param('firstname'),
 477                 $session->param('surname'),      $session->param('branch'),
 478                 $session->param('branchname'),   $session->param('flags'),
 479                 $session->param('emailaddress'), $session->param('branchprinter')
 480             );
 481             C4::Context::set_shelves_userenv($session->param('shelves'));
 482             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 483             $ip       = $session->param('ip');
 484             $lasttime = $session->param('lasttime');
 485             $userid   = $session->param('id');
 486         }
 487
 488         if ($logout) {
 489             # voluntary logout the user
 490             $session->flush;
 491             $session->delete();
 492             C4::Context->_unset_userenv($sessionID);
 493             _session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,localtime);
 494             $sessionID = undef;
 495             $userid    = undef;
 496         }
 497                 elsif ( $lasttime < time() - $timeout ) {
 498                         # timed logout
 499                         $info{'timed_out'} = 1;
 500                         $session->delete();
 501                         C4::Context->_unset_userenv($sessionID);
 502                         _session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,localtime);
 503                         $userid    = undef;
 504                         $sessionID = undef;
 505                 }
 506                 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 507                         # Different ip than originally logged in from
 508                         $info{'oldip'}        = $ip;
 509                         $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 510                         $info{'different_ip'} = 1;
 511                         $session->delete();
 512                         C4::Context->_unset_userenv($sessionID);
 513                         _session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,localtime, $info{'newip'});
 514                         $sessionID = undef;
 515                         $userid    = undef;
 516                 }
 517                 else {
 518                         $cookie = $query->cookie( CGISESSID => $session->id );
 519                         $session->param('lasttime',time());
 520                         $flags = haspermission( $dbh, $userid, $flagsrequired );
 521                         if ($flags) {
 522                                 $loggedin = 1;
 523                         } else {
 524                                 $info{'nopermission'} = 1;
 525                         }
 526                 }
 527     }
 528     unless ($userid) {
 529         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 530         my $sessionID = $session->id;
 531         $userid    = $query->param('userid');
 532         my $password = $query->param('password');
 533         C4::Context->_new_userenv($sessionID);
 534         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 535         if ($return) {
 536             _session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},localtime);
 537             $cookie = $query->cookie(CGISESSID => $sessionID);
 538             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 539                                 $loggedin = 1;
 540             }
 541             else {
 542                 $info{'nopermission'} = 1;
 543                 C4::Context->_unset_userenv($sessionID);
 544             }
 545
 546                         my ($borrowernumber, $firstname, $surname, $userflags,
 547                                 $branchcode, $branchname, $branchprinter, $emailaddress);
 548
 549             if ( $return == 1 ) {
 550                 my $select = "
 551                 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 552                         branches.branchname    as branchname,
 553                         branches.branchprinter as branchprinter,
 554                         email
 555                 FROM borrowers
 556                 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 557                 ";
 558                 my $sth = $dbh->prepare("$select where userid=?");
 559                 $sth->execute($userid);
 560                                 unless ($sth->rows) {
 561                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 562                                         $sth = $dbh->prepare("$select where cardnumber=?");
 563                     $sth->execute($cardnumber);
 564                                         unless ($sth->rows) {
 565                                 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 566                         $sth->execute($userid);
 567                                                 unless ($sth->rows) {
 568                                         $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 569                                                 }
 570                                         }
 571                                 }
 572                 if ($sth->rows) {
 573                     ($borrowernumber, $firstname, $surname, $userflags,
 574                         $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 575                                         $debug and print STDERR "AUTH_3 results: " .
 576                                                 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 577                                 } else {
 578                                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 579                                 }
 580
 581 # launch a sequence to check if we have a ip for the branch, i
 582 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 583
 584                 my $ip       = $ENV{'REMOTE_ADDR'};
 585                 # if they specify at login, use that
 586                 if ($query->param('branch')) {
 587                     $branchcode  = $query->param('branch');
 588                     $branchname = GetBranchName($branchcode);
 589                 }
 590                 my $branches = GetBranches();
 591                 if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 592                                     # we have to check they are coming from the right ip range
 593                                         my $domain = $branches->{$branchcode}->{'branchip'};
 594                                         if ($ip !~ /^$domain/){
 595                                                 $loggedin=0;
 596                                                 $info{'wrongip'} = 1;
 597                                         }
 598                                 }
 599
 600                 my @branchesloop;
 601                 foreach my $br ( keys %$branches ) {
 602                     #     now we work with the treatment of ip
 603                     my $domain = $branches->{$br}->{'branchip'};
 604                     if ( $domain && $ip =~ /^$domain/ ) {
 605                         $branchcode = $branches->{$br}->{'branchcode'};
 606
 607                         # new op dev : add the branchprinter and branchname in the cookie
 608                         $branchprinter = $branches->{$br}->{'branchprinter'};
 609                         $branchname    = $branches->{$br}->{'branchname'};
 610                     }
 611                 }
 612                 $session->param('number',$borrowernumber);
 613                 $session->param('id',$userid);
 614                 $session->param('cardnumber',$cardnumber);
 615                 $session->param('firstname',$firstname);
 616                 $session->param('surname',$surname);
 617                 $session->param('branch',$branchcode);
 618                 $session->param('branchname',$branchname);
 619                 $session->param('flags',$userflags);
 620                 $session->param('emailaddress',$emailaddress);
 621                 $session->param('ip',$session->remote_addr());
 622                 $session->param('lasttime',time());
 623                 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 624             }
 625             elsif ( $return == 2 ) {
 626                 #We suppose the user is the superlibrarian
 627                                 $borrowernumber = 0;
 628                 $session->param('number',0);
 629                 $session->param('id',C4::Context->config('user'));
 630                 $session->param('cardnumber',C4::Context->config('user'));
 631                 $session->param('firstname',C4::Context->config('user'));
 632                 $session->param('surname',C4::Context->config('user'));
 633                 $session->param('branch','NO_LIBRARY_SET');
 634                 $session->param('branchname','NO_LIBRARY_SET');
 635                 $session->param('flags',1);
 636                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 637                 $session->param('ip',$session->remote_addr());
 638                 $session->param('lasttime',time());
 639             }
 640             C4::Context::set_userenv(
 641                 $session->param('number'),       $session->param('id'),
 642                 $session->param('cardnumber'),   $session->param('firstname'),
 643                 $session->param('surname'),      $session->param('branch'),
 644                 $session->param('branchname'),   $session->param('flags'),
 645                 $session->param('emailaddress'), $session->param('branchprinter')
 646             );
 647                         $shelves = GetShelvesSummary($borrowernumber,2,10);
 648                         $session->param('shelves', $shelves);
 649                         C4::Context::set_shelves_userenv($shelves);
 650         }
 651         else {
 652             if ($userid) {
 653                 $info{'invalid_username_or_password'} = 1;
 654                 C4::Context->_unset_userenv($sessionID);
 655             }
 656
 657         }
 658     }   # END unless ($userid)
 659     my $insecure = C4::Context->boolean_preference('insecure');
 660
 661     # finished authentification, now respond
 662     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 663     {
 664         # successful login
 665         unless ($cookie) {
 666             $cookie = $query->cookie( CGISESSID => '' );
 667         }
 668         return ( $userid, $cookie, $sessionID, $flags );
 669     }
 670
 671 #
 672 #
 673 # AUTH rejected, show the login/password template, after checking the DB.
 674 #
 675 #
 676
 677     # get the inputs from the incoming query
 678     my @inputs = ();
 679     foreach my $name ( param $query) {
 680         (next) if ( $name eq 'userid' || $name eq 'password' );
 681         my $value = $query->param($name);
 682         push @inputs, { name => $name, value => $value };
 683     }
 684     # get the branchloop, which we need for authentication
 685     my $branches = GetBranches();
 686     my @branch_loop;
 687     for my $branch_hash (sort keys %$branches) {
 688                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
 689     }
 690
 691     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
 692     my $template = gettemplate( $template_name, $type, $query );
 693     $template->param(branchloop => \@branch_loop,);
 694     $template->param(
 695     login        => 1,
 696         INPUTS               => \@inputs,
 697         suggestion           => C4::Context->preference("suggestion"),
 698         virtualshelves       => C4::Context->preference("virtualshelves"),
 699         opaclargeimage       => C4::Context->preference("opaclargeimage"),
 700         LibraryName          => C4::Context->preference("LibraryName"),
 701         opacuserlogin        => C4::Context->preference("opacuserlogin"),
 702         OpacNav              => C4::Context->preference("OpacNav"),
 703         opaccredits          => C4::Context->preference("opaccredits"),
 704         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 705         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 706         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 707         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 708         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 709         opacuserjs           => C4::Context->preference("opacuserjs"),
 710         intranetcolorstylesheet =>
 711                                                                 C4::Context->preference("intranetcolorstylesheet"),
 712         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 713         IntranetNav        => C4::Context->preference("IntranetNav"),
 714         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 715         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 716         IndependantBranches=> C4::Context->preference("IndependantBranches"),
 717         AutoLocation       => C4::Context->preference("AutoLocation"),
 718         yuipath            => C4::Context->preference("yuipath"),
 719                 wrongip            => $info{'wrongip'}
 720     );
 721
 722     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 723
 724     my $self_url = $query->url( -absolute => 1 );
 725     $template->param(
 726         url         => $self_url,
 727         LibraryName => C4::Context->preference("LibraryName"),
 728     );
 729     $template->param( \%info );
 730 #    $cookie = $query->cookie(CGISESSID => $session->id
 731 #   );
 732     print $query->header(
 733         -type   => 'text/html',
 734         -charset => 'utf-8',
 735         -cookie => $cookie
 736       ),
 737       $template->output;
 738     exit;
 739 }
 740
 741 =item check_api_auth
 742
 743   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 744
 745 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 746 cookie, determine if the user has the privileges specified by C<$userflags>.
 747
 748 C<check_api_auth> is is meant for authenticating users of web services, and
 749 consequently will always return and will not attempt to redirect the user
 750 agent.
 751
 752 If a valid session cookie is already present, check_api_auth will return a status
 753 of "ok", the cookie, and the Koha session ID.
 754
 755 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 756 parameters and create a session cookie and Koha session if the supplied credentials
 757 are OK.
 758
 759 Possible return values in C<$status> are:
 760
 761 =over 4
 762
 763 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 764
 765 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 766
 767 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 768
 769 =item "expired -- session cookie has expired; API user should resubmit userid and password
 770
 771 =back
 772
 773 =cut
 774
 775 sub check_api_auth {
 776     my $query = shift;
 777     my $flagsrequired = shift;
 778
 779     my $dbh     = C4::Context->dbh;
 780     my $timeout = C4::Context->preference('timeout');
 781     $timeout = 600 unless $timeout;
 782
 783     unless (C4::Context->preference('Version')) {
 784         # database has not been installed yet
 785         return ("maintenance", undef, undef);
 786     }
 787     my $kohaversion=C4::Context::KOHAVERSION;
 788     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 789     if (C4::Context->preference('Version') < $kohaversion) {
 790         # database in need of version update; assume that
 791         # no API should be called while databsae is in
 792         # this condition.
 793         return ("maintenance", undef, undef);
 794     }
 795
 796     # FIXME -- most of what follows is a copy-and-paste
 797     # of code from checkauth.  There is an obvious need
 798     # for refactoring to separate the various parts of
 799     # the authentication code, but as of 2007-11-19 this
 800     # is deferred so as to not introduce bugs into the
 801     # regular authentication code for Koha 3.0.
 802
 803     # see if we have a valid session cookie already
 804     # however, if a userid parameter is present (i.e., from
 805     # a form submission, assume that any current cookie
 806     # is to be ignored
 807     my $sessionID = undef;
 808     unless ($query->param('userid')) {
 809         $sessionID = $query->cookie("CGISESSID");
 810     }
 811     if ($sessionID) {
 812         my $session = get_session($sessionID);
 813         C4::Context->_new_userenv($sessionID);
 814         if ($session) {
 815             C4::Context::set_userenv(
 816                 $session->param('number'),       $session->param('id'),
 817                 $session->param('cardnumber'),   $session->param('firstname'),
 818                 $session->param('surname'),      $session->param('branch'),
 819                 $session->param('branchname'),   $session->param('flags'),
 820                 $session->param('emailaddress'), $session->param('branchprinter')
 821             );
 822
 823             my $ip = $session->param('ip');
 824             my $lasttime = $session->param('lasttime');
 825             my $userid = $session->param('id');
 826             if ( $lasttime < time() - $timeout ) {
 827                 # time out
 828                 $session->delete();
 829                 C4::Context->_unset_userenv($sessionID);
 830                 $userid    = undef;
 831                 $sessionID = undef;
 832                 return ("expired", undef, undef);
 833             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 834                 # IP address changed
 835                 $session->delete();
 836                 C4::Context->_unset_userenv($sessionID);
 837                 $userid    = undef;
 838                 $sessionID = undef;
 839                 return ("expired", undef, undef);
 840             } else {
 841                 my $cookie = $query->cookie( CGISESSID => $session->id );
 842                 $session->param('lasttime',time());
 843                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 844                 if ($flags) {
 845                     return ("ok", $cookie, $sessionID);
 846                 } else {
 847                     $session->delete();
 848                     C4::Context->_unset_userenv($sessionID);
 849                     $userid    = undef;
 850                     $sessionID = undef;
 851                     return ("failed", undef, undef);
 852                 }
 853             }
 854         } else {
 855             return ("expired", undef, undef);
 856         }
 857     } else {
 858         # new login
 859         my $userid = $query->param('userid');
 860         my $password = $query->param('password');
 861         unless ($userid and $password) {
 862             # caller did something wrong, fail the authenticateion
 863             return ("failed", undef, undef);
 864         }
 865         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 866         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 867             my $session = get_session("");
 868             return ("failed", undef, undef) unless $session;
 869
 870             my $sessionID = $session->id;
 871             C4::Context->_new_userenv($sessionID);
 872             my $cookie = $query->cookie(CGISESSID => $sessionID);
 873             if ( $return == 1 ) {
 874                 my (
 875                     $borrowernumber, $firstname,  $surname,
 876                     $userflags,      $branchcode, $branchname,
 877                     $branchprinter,  $emailaddress
 878                 );
 879                 my $sth =
 880                   $dbh->prepare(
 881 "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=?"
 882                   );
 883                 $sth->execute($userid);
 884                 (
 885                     $borrowernumber, $firstname,  $surname,
 886                     $userflags,      $branchcode, $branchname,
 887                     $branchprinter,  $emailaddress
 888                 ) = $sth->fetchrow if ( $sth->rows );
 889
 890                 unless ($sth->rows ) {
 891                     my $sth = $dbh->prepare(
 892 "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=?"
 893                       );
 894                     $sth->execute($cardnumber);
 895                     (
 896                         $borrowernumber, $firstname,  $surname,
 897                         $userflags,      $branchcode, $branchname,
 898                         $branchprinter,  $emailaddress
 899                     ) = $sth->fetchrow if ( $sth->rows );
 900
 901                     unless ( $sth->rows ) {
 902                         $sth->execute($userid);
 903                         (
 904                             $borrowernumber, $firstname, $surname, $userflags,
 905                             $branchcode, $branchname, $branchprinter, $emailaddress
 906                         ) = $sth->fetchrow if ( $sth->rows );
 907                     }
 908                 }
 909
 910                 my $ip       = $ENV{'REMOTE_ADDR'};
 911                 # if they specify at login, use that
 912                 if ($query->param('branch')) {
 913                     $branchcode  = $query->param('branch');
 914                     $branchname = GetBranchName($branchcode);
 915                 }
 916                 my $branches = GetBranches();
 917                 my @branchesloop;
 918                 foreach my $br ( keys %$branches ) {
 919                     #     now we work with the treatment of ip
 920                     my $domain = $branches->{$br}->{'branchip'};
 921                     if ( $domain && $ip =~ /^$domain/ ) {
 922                         $branchcode = $branches->{$br}->{'branchcode'};
 923
 924                         # new op dev : add the branchprinter and branchname in the cookie
 925                         $branchprinter = $branches->{$br}->{'branchprinter'};
 926                         $branchname    = $branches->{$br}->{'branchname'};
 927                     }
 928                 }
 929                 $session->param('number',$borrowernumber);
 930                 $session->param('id',$userid);
 931                 $session->param('cardnumber',$cardnumber);
 932                 $session->param('firstname',$firstname);
 933                 $session->param('surname',$surname);
 934                 $session->param('branch',$branchcode);
 935                 $session->param('branchname',$branchname);
 936                 $session->param('flags',$userflags);
 937                 $session->param('emailaddress',$emailaddress);
 938                 $session->param('ip',$session->remote_addr());
 939                 $session->param('lasttime',time());
 940             } elsif ( $return == 2 ) {
 941                 #We suppose the user is the superlibrarian
 942                 $session->param('number',0);
 943                 $session->param('id',C4::Context->config('user'));
 944                 $session->param('cardnumber',C4::Context->config('user'));
 945                 $session->param('firstname',C4::Context->config('user'));
 946                 $session->param('surname',C4::Context->config('user'));
 947                 $session->param('branch','NO_LIBRARY_SET');
 948                 $session->param('branchname','NO_LIBRARY_SET');
 949                 $session->param('flags',1);
 950                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 951                 $session->param('ip',$session->remote_addr());
 952                 $session->param('lasttime',time());
 953             }
 954             C4::Context::set_userenv(
 955                 $session->param('number'),       $session->param('id'),
 956                 $session->param('cardnumber'),   $session->param('firstname'),
 957                 $session->param('surname'),      $session->param('branch'),
 958                 $session->param('branchname'),   $session->param('flags'),
 959                 $session->param('emailaddress'), $session->param('branchprinter')
 960             );
 961             return ("ok", $cookie, $sessionID);
 962         } else {
 963             return ("failed", undef, undef);
 964         }
 965     }
 966 }
 967
 968 =item check_cookie_auth
 969
 970   ($status, $sessionId) = check_api_auth($cookie, $userflags);
 971
 972 Given a CGISESSID cookie set during a previous login to Koha, determine
 973 if the user has the privileges specified by C<$userflags>.
 974
 975 C<check_cookie_auth> is meant for authenticating special services
 976 such as tools/upload-file.pl that are invoked by other pages that
 977 have been authenticated in the usual way.
 978
 979 Possible return values in C<$status> are:
 980
 981 =over 4
 982
 983 =item "ok" -- user authenticated; C<$sessionID> have valid values.
 984
 985 =item "failed" -- credentials are not correct; C<$sessionid> are undef
 986
 987 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 988
 989 =item "expired -- session cookie has expired; API user should resubmit userid and password
 990
 991 =back
 992
 993 =cut
 994
 995 sub check_cookie_auth {
 996     my $cookie = shift;
 997     my $flagsrequired = shift;
 998
 999     my $dbh     = C4::Context->dbh;
1000     my $timeout = C4::Context->preference('timeout');
1001     $timeout = 600 unless $timeout;
1002
1003     unless (C4::Context->preference('Version')) {
1004         # database has not been installed yet
1005         return ("maintenance", undef);
1006     }
1007     my $kohaversion=C4::Context::KOHAVERSION;
1008     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1009     if (C4::Context->preference('Version') < $kohaversion) {
1010         # database in need of version update; assume that
1011         # no API should be called while databsae is in
1012         # this condition.
1013         return ("maintenance", undef);
1014     }
1015
1016     # FIXME -- most of what follows is a copy-and-paste
1017     # of code from checkauth.  There is an obvious need
1018     # for refactoring to separate the various parts of
1019     # the authentication code, but as of 2007-11-23 this
1020     # is deferred so as to not introduce bugs into the
1021     # regular authentication code for Koha 3.0.
1022
1023     # see if we have a valid session cookie already
1024     # however, if a userid parameter is present (i.e., from
1025     # a form submission, assume that any current cookie
1026     # is to be ignored
1027     unless (defined $cookie and $cookie) {
1028         return ("failed", undef);
1029     }
1030     my $sessionID = $cookie;
1031     my $session = get_session($sessionID);
1032     C4::Context->_new_userenv($sessionID);
1033     if ($session) {
1034         C4::Context::set_userenv(
1035             $session->param('number'),       $session->param('id'),
1036             $session->param('cardnumber'),   $session->param('firstname'),
1037             $session->param('surname'),      $session->param('branch'),
1038             $session->param('branchname'),   $session->param('flags'),
1039             $session->param('emailaddress'), $session->param('branchprinter')
1040         );
1041
1042         my $ip = $session->param('ip');
1043         my $lasttime = $session->param('lasttime');
1044         my $userid = $session->param('id');
1045         if ( $lasttime < time() - $timeout ) {
1046             # time out
1047             $session->delete();
1048             C4::Context->_unset_userenv($sessionID);
1049             $userid    = undef;
1050             $sessionID = undef;
1051             return ("expired", undef);
1052         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1053             # IP address changed
1054             $session->delete();
1055             C4::Context->_unset_userenv($sessionID);
1056             $userid    = undef;
1057             $sessionID = undef;
1058             return ("expired", undef);
1059         } else {
1060             $session->param('lasttime',time());
1061             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1062             if ($flags) {
1063                 return ("ok", $sessionID);
1064             } else {
1065                 $session->delete();
1066                 C4::Context->_unset_userenv($sessionID);
1067                 $userid    = undef;
1068                 $sessionID = undef;
1069                 return ("failed", undef);
1070             }
1071         }
1072     } else {
1073         return ("expired", undef);
1074     }
1075 }
1076
1077 =item get_session
1078
1079   use CGI::Session;
1080   my $session = get_session($sessionID);
1081
1082 Given a session ID, retrieve the CGI::Session object used to store
1083 the session's state.  The session object can be used to store
1084 data that needs to be accessed by different scripts during a
1085 user's session.
1086
1087 If the C<$sessionID> parameter is an empty string, a new session
1088 will be created.
1089
1090 =cut
1091
1092 sub get_session {
1093     my $sessionID = shift;
1094     my $storage_method = C4::Context->preference('SessionStorage');
1095     my $dbh = C4::Context->dbh;
1096     my $session;
1097     if ($storage_method eq 'mysql'){
1098         $session = new CGI::Session("driver:MySQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1099     }
1100     elsif ($storage_method eq 'Pg') {
1101         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml", $sessionID, {Handle=>$dbh});
1102     }
1103     else {
1104         # catch all defaults to tmp should work on all systems
1105         $session = new CGI::Session("driver:File;serializer:yaml", $sessionID, {Directory=>'/tmp'});
1106     }
1107     return $session;
1108 }
1109
1110 sub checkpw {
1111
1112     my ( $dbh, $userid, $password ) = @_;
1113     if ($ldap) {
1114         $debug and print "## checkpw - checking LDAP\n";
1115         my ($retval,$retcard) = checkpw_ldap(@_);    # EXTERNAL AUTH
1116         ($retval) and return ($retval,$retcard);
1117     }
1118
1119     # INTERNAL AUTH
1120     my $sth =
1121       $dbh->prepare(
1122 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1123       );
1124     $sth->execute($userid);
1125     if ( $sth->rows ) {
1126         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1127             $surname, $branchcode, $flags )
1128           = $sth->fetchrow;
1129         if ( md5_base64($password) eq $md5password ) {
1130
1131             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1132                 $firstname, $surname, $branchcode, $flags );
1133             return 1, $cardnumber;
1134         }
1135     }
1136     $sth =
1137       $dbh->prepare(
1138 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1139       );
1140     $sth->execute($userid);
1141     if ( $sth->rows ) {
1142         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1143             $surname, $branchcode, $flags )
1144           = $sth->fetchrow;
1145         if ( md5_base64($password) eq $md5password ) {
1146
1147             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1148                 $firstname, $surname, $branchcode, $flags );
1149             return 1, $userid;
1150         }
1151     }
1152     if (   $userid && $userid eq C4::Context->config('user')
1153         && "$password" eq C4::Context->config('pass') )
1154     {
1155
1156 # Koha superuser account
1157 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1158         return 2;
1159     }
1160     if (   $userid && $userid eq 'demo'
1161         && "$password" eq 'demo'
1162         && C4::Context->config('demo') )
1163     {
1164
1165 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1166 # some features won't be effective : modify systempref, modify MARC structure,
1167         return 2;
1168     }
1169     return 0;
1170 }
1171
1172 =item getuserflags
1173
1174  $authflags = getuserflags($flags,$dbh);
1175 Translates integer flags into permissions strings hash.
1176
1177 C<$flags> is the integer userflags value ( borrowers.userflags )
1178 C<$authflags> is a hashref of permissions
1179
1180 =cut
1181
1182 sub getuserflags {
1183     my $flags   = shift;
1184     my $dbh     = shift;
1185     my $userflags;
1186     $flags = 0 unless $flags;
1187     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1188     $sth->execute;
1189
1190     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1191         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1192             $userflags->{$flag} = 1;
1193         }
1194         else {
1195             $userflags->{$flag} = 0;
1196         }
1197     }
1198     return $userflags;
1199 }
1200
1201 =item haspermission
1202
1203   $flags = ($dbh,$member,$flagsrequired);
1204
1205 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1206 C<$flags> is a hashref of required flags lik C<$borrower-&lt;{authflags}>
1207
1208 Returns member's flags or 0 if a permission is not met.
1209
1210 =cut
1211
1212 sub haspermission {
1213     my ( $dbh, $userid, $flagsrequired ) = @_;
1214     my ($flags,$intflags);
1215     $dbh=C4::Context->dbh unless($dbh);
1216     if(ref($userid)) {
1217         $intflags = $userid->{'flags'};
1218     } else {
1219         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1220         $sth->execute($userid);
1221         my ($intflags) = $sth->fetchrow;
1222         $flags = getuserflags( $intflags, $dbh );
1223     }
1224     if ( $userid eq C4::Context->config('user') ) {
1225         # Super User Account from /etc/koha.conf
1226         $flags->{'superlibrarian'} = 1;
1227     }
1228     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1229         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1230         $flags->{'superlibrarian'} = 1;
1231     }
1232     return $flags if $flags->{superlibrarian};
1233     foreach ( keys %$flagsrequired ) {
1234         return 0 unless( $flags->{$_} );
1235     }
1236     return $flags;
1237     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1238 }
1239
1240
1241 sub getborrowernumber {
1242     my ($userid) = @_;
1243     my $dbh = C4::Context->dbh;
1244     for my $field ( 'userid', 'cardnumber' ) {
1245         my $sth =
1246           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1247         $sth->execute($userid);
1248         if ( $sth->rows ) {
1249             my ($bnumber) = $sth->fetchrow;
1250             return $bnumber;
1251         }
1252     }
1253     return 0;
1254 }
1255
1256 END { }    # module clean-up code here (global destructor)
1257 1;
1258 __END__
1259
1260 =back
1261
1262 =head1 SEE ALSO
1263
1264 CGI(3)
1265
1266 C4::Output(3)
1267
1268 Digest::MD5(3)
1269
1270 =cut