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