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