C4/Auth.pm

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