C4/Auth.pm

   1 # -*- tab-width: 8 -*-
   2 # NOTE: This file uses 8-character tabs; do not change the tab size!
   3
   4 package C4::Auth;
   5
   6 # Copyright 2000-2002 Katipo Communications
   7 #
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it under the
  11 # terms of the GNU General Public License as published by the Free Software
  12 # Foundation; either version 2 of the License, or (at your option) any later
  13 # version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along with
  20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  21 # Suite 330, Boston, MA  02111-1307 USA
  22
  23 use strict;
  24 use Digest::MD5 qw(md5_base64);
  25
  26 require Exporter;
  27 use C4::Context;
  28 use C4::Output;    # to get the template
  29 use C4::Interface::CGI::Output;
  30 use C4::Circulation::Circ2;    # getpatroninformation
  31 use C4::Koha;
  32
  33 # use Net::LDAP;
  34 # use Net::LDAP qw(:all);
  35
  36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  37
  38 # set the version for version checking
  39 $VERSION = 0.01;
  40
  41 =head1 NAME
  42
  43 C4::Auth - Authenticates Koha users
  44
  45 =head1 SYNOPSIS
  46
  47   use CGI;
  48   use C4::Auth;
  49
  50   my $query = new CGI;
  51
  52   my ($template, $borrowernumber, $cookie)
  53     = get_template_and_user({template_name   => "opac-main.tmpl",
  54                              query           => $query,
  55                              type            => "opac",
  56                              authnotrequired => 1,
  57                              flagsrequired   => {borrow => 1},
  58                           });
  59
  60   print $query->header(
  61     -type => guesstype($template->output),
  62     -cookie => $cookie
  63   ), $template->output;
  64
  65
  66 =head1 DESCRIPTION
  67
  68     The main function of this module is to provide
  69     authentification. However the get_template_and_user function has
  70     been provided so that a users login information is passed along
  71     automatically. This gets loaded into the template.
  72
  73 =head1 FUNCTIONS
  74
  75 =over 2
  76
  77 =cut
  78
  79 @ISA    = qw(Exporter);
  80 @EXPORT = qw(
  81   &checkauth
  82   &get_template_and_user
  83 );
  84
  85 =item get_template_and_user
  86
  87   my ($template, $borrowernumber, $cookie)
  88     = get_template_and_user({template_name   => "opac-main.tmpl",
  89                              query           => $query,
  90                              type            => "opac",
  91                              authnotrequired => 1,
  92                              flagsrequired   => {borrow => 1},
  93                           });
  94
  95     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
  96     to C<&checkauth> (in this module) to perform authentification.
  97     See C<&checkauth> for an explanation of these parameters.
  98
  99     The C<template_name> is then used to find the correct template for
 100     the page. The authenticated users details are loaded onto the
 101     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 102     C<sessionID> is passed to the template. This can be used in templates
 103     if cookies are disabled. It needs to be put as and input to every
 104     authenticated page.
 105
 106     More information on the C<gettemplate> sub can be found in the
 107     Output.pm module.
 108
 109 =cut
 110
 111 sub get_template_and_user {
 112     my $in       = shift;
 113     my $template =
 114       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 115     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
 116         $in->{'query'},
 117         $in->{'authnotrequired'},
 118         $in->{'flagsrequired'},
 119         $in->{'type'}
 120     );
 121
 122     my $borrowernumber;
 123     if ($user) {
 124         $template->param( loggedinusername => $user );
 125         $template->param( sessionID        => $sessionID );
 126
 127         $borrowernumber = getborrowernumber($user);
 128         my ( $borr, $alternativeflags ) =
 129           getpatroninformation( undef, $borrowernumber );
 130         my @bordat;
 131         $bordat[0] = $borr;
 132         $template->param( USER_INFO => \@bordat, );
 133
 134         # We are going to use the $flags returned by checkauth
 135         # to create the template's parameters that will indicate
 136         # which menus the user can access.
 137         if ( $flags && $flags->{superlibrarian} == 1 ) {
 138             $template->param( CAN_user_circulate        => 1 );
 139             $template->param( CAN_user_catalogue        => 1 );
 140             $template->param( CAN_user_parameters       => 1 );
 141             $template->param( CAN_user_borrowers        => 1 );
 142             $template->param( CAN_user_permission       => 1 );
 143             $template->param( CAN_user_reserveforothers => 1 );
 144             $template->param( CAN_user_borrow           => 1 );
 145             $template->param( CAN_user_reserveforself   => 1 );
 146             $template->param( CAN_user_editcatalogue    => 1 );
 147             $template->param( CAN_user_updatecharge     => 1 );
 148             $template->param( CAN_user_acquisition      => 1 );
 149             $template->param( CAN_user_management       => 1 );
 150             $template->param( CAN_user_tools            => 1 );
 151         }
 152
 153         if ( $flags && $flags->{circulate} == 1 ) {
 154             $template->param( CAN_user_circulate => 1 );
 155         }
 156
 157         if ( $flags && $flags->{catalogue} == 1 ) {
 158             $template->param( CAN_user_catalogue => 1 );
 159         }
 160
 161         if ( $flags && $flags->{parameters} == 1 ) {
 162             $template->param( CAN_user_parameters => 1 );
 163             $template->param( CAN_user_management => 1 );
 164             $template->param( CAN_user_tools      => 1 );
 165         }
 166
 167         if ( $flags && $flags->{borrowers} == 1 ) {
 168             $template->param( CAN_user_borrowers => 1 );
 169         }
 170
 171         if ( $flags && $flags->{permissions} == 1 ) {
 172             $template->param( CAN_user_permission => 1 );
 173         }
 174
 175         if ( $flags && $flags->{reserveforothers} == 1 ) {
 176             $template->param( CAN_user_reserveforothers => 1 );
 177         }
 178
 179         if ( $flags && $flags->{borrow} == 1 ) {
 180             $template->param( CAN_user_borrow => 1 );
 181         }
 182
 183         if ( $flags && $flags->{reserveforself} == 1 ) {
 184             $template->param( CAN_user_reserveforself => 1 );
 185         }
 186
 187         if ( $flags && $flags->{editcatalogue} == 1 ) {
 188             $template->param( CAN_user_editcatalogue => 1 );
 189         }
 190
 191         if ( $flags && $flags->{updatecharges} == 1 ) {
 192             $template->param( CAN_user_updatecharge => 1 );
 193         }
 194
 195         if ( $flags && $flags->{acquisition} == 1 ) {
 196             $template->param( CAN_user_acquisition => 1 );
 197         }
 198
 199         if ( $flags && $flags->{management} == 1 ) {
 200             $template->param( CAN_user_management => 1 );
 201             $template->param( CAN_user_tools      => 1 );
 202         }
 203
 204         if ( $flags && $flags->{tools} == 1 ) {
 205             $template->param( CAN_user_tools => 1 );
 206         }
 207
 208     }
 209     unless ( $in->{'type'} eq "intranet" ) {
 210         $template->param(
 211             suggestion           => C4::Context->preference("suggestion"),
 212             virtualshelves       => C4::Context->preference("virtualshelves"),
 213             OpacNav              => C4::Context->preference("OpacNav"),
 214             opacheader           => C4::Context->preference("opacheader"),
 215             opaccredits          => C4::Context->preference("opaccredits"),
 216             opacsmallimage       => C4::Context->preference("opacsmallimage"),
 217             opaclayoutstylesheet =>
 218               C4::Context->preference("opaclayoutstylesheet"),
 219             opaccolorstylesheet =>
 220               C4::Context->preference("opaccolorstylesheet"),
 221             opaclanguagesdisplay =>
 222               C4::Context->preference("opaclanguagesdisplay"),
 223             TemplateEncoding => C4::Context->preference("TemplateEncoding"),
 224             opacuserlogin    => C4::Context->preference("opacuserlogin"),
 225             opacbookbag      => C4::Context->preference("opacbookbag"),
 226         );
 227     }
 228     $template->param(
 229         TemplateEncoding => C4::Context->preference("TemplateEncoding"),
 230         AmazonContent    => C4::Context->preference("AmazonContent"),
 231         LibraryName      => C4::Context->preference("LibraryName"),
 232         branchname       => C4::Context->userenv->{'branchname'},
 233     );
 234     return ( $template, $borrowernumber, $cookie );
 235 }
 236
 237 =item checkauth
 238
 239   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 240
 241 Verifies that the user is authorized to run this script.  If
 242 the user is authorized, a (userid, cookie, session-id, flags)
 243 quadruple is returned.  If the user is not authorized but does
 244 not have the required privilege (see $flagsrequired below), it
 245 displays an error page and exits.  Otherwise, it displays the
 246 login page and exits.
 247
 248 Note that C<&checkauth> will return if and only if the user
 249 is authorized, so it should be called early on, before any
 250 unfinished operations (e.g., if you've opened a file, then
 251 C<&checkauth> won't close it for you).
 252
 253 C<$query> is the CGI object for the script calling C<&checkauth>.
 254
 255 The C<$noauth> argument is optional. If it is set, then no
 256 authorization is required for the script.
 257
 258 C<&checkauth> fetches user and session information from C<$query> and
 259 ensures that the user is authorized to run scripts that require
 260 authorization.
 261
 262 The C<$flagsrequired> argument specifies the required privileges
 263 the user must have if the username and password are correct.
 264 It should be specified as a reference-to-hash; keys in the hash
 265 should be the "flags" for the user, as specified in the Members
 266 intranet module. Any key specified must correspond to a "flag"
 267 in the userflags table. E.g., { circulate => 1 } would specify
 268 that the user must have the "circulate" privilege in order to
 269 proceed. To make sure that access control is correct, the
 270 C<$flagsrequired> parameter must be specified correctly.
 271
 272 The C<$type> argument specifies whether the template should be
 273 retrieved from the opac or intranet directory tree.  "opac" is
 274 assumed if it is not specified; however, if C<$type> is specified,
 275 "intranet" is assumed if it is not "opac".
 276
 277 If C<$query> does not have a valid session ID associated with it
 278 (i.e., the user has not logged in) or if the session has expired,
 279 C<&checkauth> presents the user with a login page (from the point of
 280 view of the original script, C<&checkauth> does not return). Once the
 281 user has authenticated, C<&checkauth> restarts the original script
 282 (this time, C<&checkauth> returns).
 283
 284 The login page is provided using a HTML::Template, which is set in the
 285 systempreferences table or at the top of this file. The variable C<$type>
 286 selects which template to use, either the opac or the intranet
 287 authentification template.
 288
 289 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 290 cookie should be sent back to the browser; it verifies that the user
 291 has authenticated.
 292
 293 =cut
 294
 295 sub checkauth {
 296     my $query = shift;
 297
 298 # $authnotrequired will be set for scripts which will run without authentication
 299     my $authnotrequired = shift;
 300     my $flagsrequired   = shift;
 301     my $type            = shift;
 302     $type = 'opac' unless $type;
 303
 304     my $dbh     = C4::Context->dbh;
 305     my $timeout = C4::Context->preference('timeout');
 306     $timeout = 600 unless $timeout;
 307
 308     my $template_name;
 309     if ( $type eq 'opac' ) {
 310         $template_name = "opac-auth.tmpl";
 311     }
 312     else {
 313         $template_name = "auth.tmpl";
 314     }
 315
 316     # state variables
 317     my $loggedin = 0;
 318     my %info;
 319     my ( $userid, $cookie, $sessionID, $flags, $envcookie );
 320     my $logout = $query->param('logout.x');
 321     if ( $userid = $ENV{'REMOTE_USER'} ) {
 322
 323         # Using Basic Authentication, no cookies required
 324         $cookie = $query->cookie(
 325             -name    => 'sessionID',
 326             -value   => '',
 327             -expires => ''
 328         );
 329         $loggedin = 1;
 330     }
 331     elsif ( $sessionID = $query->cookie('sessionID') ) {
 332         C4::Context->_new_userenv($sessionID);
 333         if ( my %hash = $query->cookie('userenv') ) {
 334             C4::Context::set_userenv(
 335                 $hash{number},       $hash{id},
 336                 $hash{cardnumber},   $hash{firstname},
 337                 $hash{surname},      $hash{branch},
 338                 $hash{branchname},   $hash{flags},
 339                 $hash{emailaddress}, $hash{branchprinter}
 340             );
 341         }
 342         my ( $ip, $lasttime );
 343
 344         ( $userid, $ip, $lasttime ) =
 345           $dbh->selectrow_array(
 346             "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
 347             undef, $sessionID );
 348         if ($logout) {
 349
 350             # voluntary logout the user
 351             $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 352                 undef, $sessionID );
 353             C4::Context->_unset_userenv($sessionID);
 354             $sessionID = undef;
 355             $userid    = undef;
 356             open L, ">>/tmp/sessionlog";
 357             my $time = localtime( time() );
 358             printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
 359               $ip, $time;
 360             close L;
 361         }
 362         if ($userid) {
 363             if ( $lasttime < time() - $timeout ) {
 364
 365                 # timed logout
 366                 $info{'timed_out'} = 1;
 367                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 368                     undef, $sessionID );
 369                 C4::Context->_unset_userenv($sessionID);
 370                 $userid    = undef;
 371                 $sessionID = undef;
 372                 open L, ">>/tmp/sessionlog";
 373                 my $time = localtime( time() );
 374                 printf L "%20s from %16s logged out at %30s (inactivity).\n",
 375                   $userid, $ip, $time;
 376                 close L;
 377             }
 378             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 379
 380                 # Different ip than originally logged in from
 381                 $info{'oldip'}        = $ip;
 382                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 383                 $info{'different_ip'} = 1;
 384                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 385                     undef, $sessionID );
 386                 C4::Context->_unset_userenv($sessionID);
 387                 $sessionID = undef;
 388                 $userid    = undef;
 389                 open L, ">>/tmp/sessionlog";
 390                 my $time = localtime( time() );
 391                 printf L
 392 "%20s from logged out at %30s (ip changed from %16s to %16s).\n",
 393                   $userid, $time, $ip, $info{'newip'};
 394                 close L;
 395             }
 396             else {
 397                 $cookie = $query->cookie(
 398                     -name    => 'sessionID',
 399                     -value   => $sessionID,
 400                     -expires => ''
 401                 );
 402                 $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?",
 403                     undef, ( time(), $sessionID ) );
 404                 $flags = haspermission( $dbh, $userid, $flagsrequired );
 405                 if ($flags) {
 406                     $loggedin = 1;
 407                 }
 408                 else {
 409                     $info{'nopermission'} = 1;
 410                 }
 411             }
 412         }
 413     }
 414     unless ($userid) {
 415         $sessionID = int( rand() * 100000 ) . '-' . time();
 416         $userid    = $query->param('userid');
 417         C4::Context->_new_userenv($sessionID);
 418         my $password = $query->param('password');
 419         C4::Context->_new_userenv($sessionID);
 420         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 421         if ($return) {
 422             $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?",
 423                 undef, ( $sessionID, $userid ) );
 424             $dbh->do(
 425 "INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
 426                 undef,
 427                 ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() )
 428             );
 429             open L, ">>/tmp/sessionlog";
 430             my $time = localtime( time() );
 431             printf L "%20s from %16s logged in  at %30s.\n", $userid,
 432               $ENV{'REMOTE_ADDR'}, $time;
 433             close L;
 434             $cookie = $query->cookie(
 435                 -name    => 'sessionID',
 436                 -value   => $sessionID,
 437                 -expires => ''
 438             );
 439             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 440                 $loggedin = 1;
 441             }
 442             else {
 443                 $info{'nopermission'} = 1;
 444                 C4::Context->_unset_userenv($sessionID);
 445             }
 446             if ( $return == 1 ) {
 447                 my ( $bornum, $firstname, $surname, $userflags, $branchcode,
 448                     $branchname, $branchprinter, $emailaddress );
 449                 my $sth =
 450                   $dbh->prepare(
 451 "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=?"
 452                   );
 453                 $sth->execute($userid);
 454                 (
 455                     $bornum, $firstname, $surname, $userflags, $branchcode,
 456                     $branchname, $branchprinter, $emailaddress
 457                   )
 458                   = $sth->fetchrow
 459                   if ( $sth->rows );
 460
 461 #                               warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 462                 unless ( $sth->rows ) {
 463                     my $sth =
 464                       $dbh->prepare(
 465 "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=?"
 466                       );
 467                     $sth->execute($cardnumber);
 468                     (
 469                         $bornum, $firstname, $surname, $userflags, $branchcode,
 470                         $branchcode, $branchprinter, $emailaddress
 471                       )
 472                       = $sth->fetchrow
 473                       if ( $sth->rows );
 474
 475 #                                       warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 476                     unless ( $sth->rows ) {
 477                         $sth->execute($userid);
 478                         (
 479                             $bornum, $firstname, $surname, $userflags,
 480                             $branchcode, $branchprinter, $emailaddress
 481                           )
 482                           = $sth->fetchrow
 483                           if ( $sth->rows );
 484                     }
 485
 486 #                                       warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 487                 }
 488
 489 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 490 #  new op dev :
 491 # launch a sequence to check if we have a ip for the branch, if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 492                 my $ip       = $ENV{'REMOTE_ADDR'};
 493                 my $branches = getbranches();
 494                 my @branchesloop;
 495                 my $branchprinter;
 496                 foreach my $br ( keys %$branches ) {
 497
 498                     #           now we work with the treatment of ip
 499                     my $domain = $branches->{$br}->{branchip};
 500                     if ( $domain && $ip =~ /^$domain/ ) {
 501                         $branchcode = $branches->{$br}->{'branchcode'};
 502
 503             #                   new op dev : add the branchprinter and branchname in the cookie
 504                         $branchprinter = $branches->{$br}->{'branchprinter'};
 505                         $branchname    = $branches->{$br}->{'branchname'};
 506                     }
 507                 }
 508
 509                 my $hash = C4::Context::set_userenv(
 510                     $bornum,     $userid,    $cardnumber,
 511                     $firstname,  $surname,   $branchcode,
 512                     $branchname, $userflags, $emailaddress,
 513                     $branchprinter,
 514                 );
 515
 516                 $envcookie = $query->cookie(
 517                     -name    => 'userenv',
 518                     -value   => $hash,
 519                     -expires => ''
 520                 );
 521             }
 522             elsif ( $return == 2 ) {
 523
 524                 #We suppose the user is the superlibrarian
 525                 my $hash = C4::Context::set_userenv(
 526                     0,
 527                     0,
 528                     C4::Context->config('user'),
 529                     C4::Context->config('user'),
 530                     C4::Context->config('user'),
 531                     "",
 532                     1,
 533                     C4::Context->preference('KohaAdminEmailAddress')
 534                 );
 535                 $envcookie = $query->cookie(
 536                     -name    => 'userenv',
 537                     -value   => $hash,
 538                     -expires => ''
 539                 );
 540             }
 541         }
 542         else {
 543             if ($userid) {
 544                 $info{'invalid_username_or_password'} = 1;
 545                 C4::Context->_unset_userenv($sessionID);
 546             }
 547         }
 548     }
 549     my $insecure = C4::Context->boolean_preference('insecure');
 550
 551     # finished authentification, now respond
 552     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 553     {
 554
 555         # successful login
 556         unless ($cookie) {
 557             $cookie = $query->cookie(
 558                 -name    => 'sessionID',
 559                 -value   => '',
 560                 -expires => ''
 561             );
 562         }
 563         if ($envcookie) {
 564             return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags );
 565         }
 566         else {
 567             return ( $userid, $cookie, $sessionID, $flags );
 568         }
 569     }
 570
 571     # else we have a problem...
 572     # get the inputs from the incoming query
 573     my @inputs = ();
 574     foreach my $name ( param $query) {
 575         (next) if ( $name eq 'userid' || $name eq 'password' );
 576         my $value = $query->param($name);
 577         push @inputs, { name => $name, value => $value };
 578     }
 579
 580     my $template = gettemplate( $template_name, $type, $query );
 581     $template->param(
 582         INPUTS                  => \@inputs,
 583         intranetcolorstylesheet =>
 584           C4::Context->preference("intranetcolorstylesheet"),
 585         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 586         IntranetNav        => C4::Context->preference("IntranetNav"),
 587         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 588
 589     );
 590     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 591
 592     my $self_url = $query->url( -absolute => 1 );
 593     $template->param(
 594         url         => $self_url,
 595         LibraryName => => C4::Context->preference("LibraryName"),
 596     );
 597     $template->param( \%info );
 598     $cookie = $query->cookie(
 599         -name    => 'sessionID',
 600         -value   => $sessionID,
 601         -expires => ''
 602     );
 603     print $query->header(
 604         -type   => guesstype( $template->output ),
 605         -cookie => $cookie
 606       ),
 607       $template->output;
 608     exit;
 609 }
 610
 611 sub checkpw {
 612
 613     my ( $dbh, $userid, $password ) = @_;
 614
 615     # INTERNAL AUTH
 616     my $sth =
 617       $dbh->prepare("select password,cardnumber from borrowers where userid=?");
 618     $sth->execute($userid);
 619     if ( $sth->rows ) {
 620         my ( $md5password, $cardnumber ) = $sth->fetchrow;
 621         if ( md5_base64($password) eq $md5password ) {
 622
 623 #                       C4::Context->set_userenv("$bornum",$userid,$cardnumber,$firstname,$surname,$branchcode,$userflags);
 624             return 1, $cardnumber;
 625         }
 626     }
 627     $sth = $dbh->prepare("select password from borrowers where cardnumber=?");
 628     $sth->execute($userid);
 629     if ( $sth->rows ) {
 630         my ($md5password) = $sth->fetchrow;
 631         if ( md5_base64($password) eq $md5password ) {
 632
 633 #                       C4::Context->set_userenv($bornum,$userid,$cardnumber,$firstname,$surname,$branchcode,$userflags);
 634             return 1, $userid;
 635         }
 636     }
 637     if (   $userid eq C4::Context->config('user')
 638         && $password eq C4::Context->config('pass') )
 639     {
 640
 641 # Koha superuser account
 642 #               C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
 643         return 2;
 644     }
 645     if (   $userid eq 'demo'
 646         && $password eq 'demo'
 647         && C4::Context->config('demo') )
 648     {
 649
 650 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
 651 # some features won't be effective : modify systempref, modify MARC structure,
 652         return 2;
 653     }
 654     return 0;
 655 }
 656
 657 sub getuserflags {
 658     my $cardnumber = shift;
 659     my $dbh        = shift;
 660     my $userflags;
 661     my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
 662     $sth->execute($cardnumber);
 663     my ($flags) = $sth->fetchrow;
 664     $flags = 0 unless $flags;
 665     $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
 666     $sth->execute;
 667
 668     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
 669         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
 670             $userflags->{$flag} = 1;
 671         }
 672         else {
 673             $userflags->{$flag} = 0;
 674         }
 675     }
 676     return $userflags;
 677 }
 678
 679 sub haspermission {
 680     my ( $dbh, $userid, $flagsrequired ) = @_;
 681     my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
 682     $sth->execute($userid);
 683     my ($cardnumber) = $sth->fetchrow;
 684     ($cardnumber) || ( $cardnumber = $userid );
 685     my $flags = getuserflags( $cardnumber, $dbh );
 686     my $configfile;
 687     if ( $userid eq C4::Context->config('user') ) {
 688
 689         # Super User Account from /etc/koha.conf
 690         $flags->{'superlibrarian'} = 1;
 691     }
 692     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
 693
 694         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
 695         $flags->{'superlibrarian'} = 1;
 696     }
 697     return $flags if $flags->{superlibrarian};
 698     foreach ( keys %$flagsrequired ) {
 699         return $flags if $flags->{$_};
 700     }
 701     return 0;
 702 }
 703
 704 sub getborrowernumber {
 705     my ($userid) = @_;
 706     my $dbh = C4::Context->dbh;
 707     for my $field ( 'userid', 'cardnumber' ) {
 708         my $sth =
 709           $dbh->prepare("select borrowernumber from borrowers where $field=?");
 710         $sth->execute($userid);
 711         if ( $sth->rows ) {
 712             my ($bnumber) = $sth->fetchrow;
 713             return $bnumber;
 714         }
 715     }
 716     return 0;
 717 }
 718
 719 END { }    # module clean-up code here (global destructor)
 720 1;
 721 __END__
 722
 723 =back
 724
 725 =head1 SEE ALSO
 726
 727 CGI(3)
 728
 729 C4::Output(3)
 730
 731 Digest::MD5(3)
 732
 733 =cut