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