koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Auth.pm

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