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