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