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