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