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