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