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