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