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 );
 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     );
 713     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 714
 715     my $self_url = $query->url( -absolute => 1 );
 716     $template->param(
 717         url         => $self_url,
 718         LibraryName => => C4::Context->preference("LibraryName"),
 719     );
 720     $template->param( \%info );
 721 #    $cookie = $query->cookie(CGISESSID => $session->id
 722 #   );
 723     print $query->header(
 724                 -type   => 'text/html',
 725         -charset => 'utf-8',
 726         -cookie => $cookie
 727       ),
 728       $template->output;
 729     exit;
 730 }
 731
 732 =item check_api_auth
 733
 734   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 735
 736 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 737 cookie, determine if the user has the privileges specified by C<$userflags>.
 738
 739 C<check_api_auth> is is meant for authenticating users of web services, and
 740 consequently will always return and will not attempt to redirect the user
 741 agent.
 742
 743 If a valid session cookie is already present, check_api_auth will return a status
 744 of "ok", the cookie, and the Koha session ID.
 745
 746 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 747 parameters and create a session cookie and Koha session if the supplied credentials
 748 are OK.
 749
 750 Possible return values in C<$status> are:
 751
 752 =over 4
 753
 754 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 755
 756 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 757
 758 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 759
 760 =item "expired -- session cookie has expired; API user should resubmit userid and password
 761
 762 =back
 763
 764 =cut
 765
 766 sub check_api_auth {
 767     my $query = shift;
 768     my $flagsrequired = shift;
 769
 770     my $dbh     = C4::Context->dbh;
 771     my $timeout = C4::Context->preference('timeout');
 772     $timeout = 600 unless $timeout;
 773
 774     unless (C4::Context->preference('Version')) {
 775         # database has not been installed yet
 776         return ("maintenance", undef, undef);
 777     }
 778     my $kohaversion=C4::Context::KOHAVERSION;
 779     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 780     if (C4::Context->preference('Version') < $kohaversion) {
 781         # database in need of version update; assume that
 782         # no API should be called while databsae is in
 783         # this condition.
 784         return ("maintenance", undef, undef);
 785     }
 786
 787     # FIXME -- most of what follows is a copy-and-paste
 788     # of code from checkauth.  There is an obvious need
 789     # for refactoring to separate the various parts of
 790     # the authentication code, but as of 2007-11-19 this
 791     # is deferred so as to not introduce bugs into the
 792     # regular authentication code for Koha 3.0.
 793
 794     # see if we have a valid session cookie already
 795     # however, if a userid parameter is present (i.e., from
 796     # a form submission, assume that any current cookie
 797     # is to be ignored
 798     my $sessionID = undef;
 799     unless ($query->param('userid')) {
 800         $sessionID = $query->cookie("CGISESSID");
 801     }
 802     if ($sessionID) {
 803         my $session = get_session($sessionID);
 804         C4::Context->_new_userenv($sessionID);
 805         if ($session) {
 806             C4::Context::set_userenv(
 807                 $session->param('number'),       $session->param('id'),
 808                 $session->param('cardnumber'),   $session->param('firstname'),
 809                 $session->param('surname'),      $session->param('branch'),
 810                 $session->param('branchname'),   $session->param('flags'),
 811                 $session->param('emailaddress'), $session->param('branchprinter')
 812             );
 813
 814             my $ip = $session->param('ip');
 815             my $lasttime = $session->param('lasttime');
 816             my $userid = $session->param('id');
 817             if ( $lasttime < time() - $timeout ) {
 818                 # time out
 819                 $session->delete();
 820                 C4::Context->_unset_userenv($sessionID);
 821                 $userid    = undef;
 822                 $sessionID = undef;
 823                 return ("expired", undef, undef);
 824             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 825                 # IP address changed
 826                 $session->delete();
 827                 C4::Context->_unset_userenv($sessionID);
 828                 $userid    = undef;
 829                 $sessionID = undef;
 830                 return ("expired", undef, undef);
 831             } else {
 832                 my $cookie = $query->cookie( CGISESSID => $session->id );
 833                 $session->param('lasttime',time());
 834                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 835                 if ($flags) {
 836                     return ("ok", $cookie, $sessionID);
 837                 } else {
 838                     $session->delete();
 839                     C4::Context->_unset_userenv($sessionID);
 840                     $userid    = undef;
 841                     $sessionID = undef;
 842                     return ("failed", undef, undef);
 843                 }
 844             }
 845         } else {
 846             return ("expired", undef, undef);
 847         }
 848     } else {
 849         # new login
 850         my $userid = $query->param('userid');
 851         my $password = $query->param('password');
 852         unless ($userid and $password) {
 853             # caller did something wrong, fail the authenticateion
 854             return ("failed", undef, undef);
 855         }
 856         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 857         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 858             my $session = get_session("");
 859             return ("failed", undef, undef) unless $session;
 860
 861             my $sessionID = $session->id;
 862             C4::Context->_new_userenv($sessionID);
 863             my $cookie = $query->cookie(CGISESSID => $sessionID);
 864             if ( $return == 1 ) {
 865                 my (
 866                     $borrowernumber, $firstname,  $surname,
 867                     $userflags,      $branchcode, $branchname,
 868                     $branchprinter,  $emailaddress
 869                 );
 870                 my $sth =
 871                   $dbh->prepare(
 872 "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=?"
 873                   );
 874                 $sth->execute($userid);
 875                 (
 876                     $borrowernumber, $firstname,  $surname,
 877                     $userflags,      $branchcode, $branchname,
 878                     $branchprinter,  $emailaddress
 879                 ) = $sth->fetchrow if ( $sth->rows );
 880
 881                 unless ($sth->rows ) {
 882                     my $sth = $dbh->prepare(
 883 "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=?"
 884                       );
 885                     $sth->execute($cardnumber);
 886                     (
 887                         $borrowernumber, $firstname,  $surname,
 888                         $userflags,      $branchcode, $branchname,
 889                         $branchprinter,  $emailaddress
 890                     ) = $sth->fetchrow if ( $sth->rows );
 891
 892                     unless ( $sth->rows ) {
 893                         $sth->execute($userid);
 894                         (
 895                             $borrowernumber, $firstname, $surname, $userflags,
 896                             $branchcode, $branchname, $branchprinter, $emailaddress
 897                         ) = $sth->fetchrow if ( $sth->rows );
 898                     }
 899                 }
 900
 901                 my $ip       = $ENV{'REMOTE_ADDR'};
 902                 # if they specify at login, use that
 903                 if ($query->param('branch')) {
 904                     $branchcode  = $query->param('branch');
 905                     $branchname = GetBranchName($branchcode);
 906                 }
 907                 my $branches = GetBranches();
 908                 my @branchesloop;
 909                 foreach my $br ( keys %$branches ) {
 910                     #     now we work with the treatment of ip
 911                     my $domain = $branches->{$br}->{'branchip'};
 912                     if ( $domain && $ip =~ /^$domain/ ) {
 913                         $branchcode = $branches->{$br}->{'branchcode'};
 914
 915                         # new op dev : add the branchprinter and branchname in the cookie
 916                         $branchprinter = $branches->{$br}->{'branchprinter'};
 917                         $branchname    = $branches->{$br}->{'branchname'};
 918                     }
 919                 }
 920                 $session->param('number',$borrowernumber);
 921                 $session->param('id',$userid);
 922                 $session->param('cardnumber',$cardnumber);
 923                 $session->param('firstname',$firstname);
 924                 $session->param('surname',$surname);
 925                 $session->param('branch',$branchcode);
 926                 $session->param('branchname',$branchname);
 927                 $session->param('flags',$userflags);
 928                 $session->param('emailaddress',$emailaddress);
 929                 $session->param('ip',$session->remote_addr());
 930                 $session->param('lasttime',time());
 931             } elsif ( $return == 2 ) {
 932                 #We suppose the user is the superlibrarian
 933                 $session->param('number',0);
 934                 $session->param('id',C4::Context->config('user'));
 935                 $session->param('cardnumber',C4::Context->config('user'));
 936                 $session->param('firstname',C4::Context->config('user'));
 937                 $session->param('surname',C4::Context->config('user'));
 938                 $session->param('branch','NO_LIBRARY_SET');
 939                 $session->param('branchname','NO_LIBRARY_SET');
 940                 $session->param('flags',1);
 941                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 942                 $session->param('ip',$session->remote_addr());
 943                 $session->param('lasttime',time());
 944             }
 945             C4::Context::set_userenv(
 946                 $session->param('number'),       $session->param('id'),
 947                 $session->param('cardnumber'),   $session->param('firstname'),
 948                 $session->param('surname'),      $session->param('branch'),
 949                 $session->param('branchname'),   $session->param('flags'),
 950                 $session->param('emailaddress'), $session->param('branchprinter')
 951             );
 952             return ("ok", $cookie, $sessionID);
 953         } else {
 954             return ("failed", undef, undef);
 955         }
 956     }
 957 }
 958
 959 =item check_cookie_auth
 960
 961   ($status, $sessionId) = check_api_auth($cookie, $userflags);
 962
 963 Given a CGISESSID cookie set during a previous login to Koha, determine
 964 if the user has the privileges specified by C<$userflags>.
 965
 966 C<check_cookie_auth> is meant for authenticating special services
 967 such as tools/upload-file.pl that are invoked by other pages that
 968 have been authenticated in the usual way.
 969
 970 Possible return values in C<$status> are:
 971
 972 =over 4
 973
 974 =item "ok" -- user authenticated; C<$sessionID> have valid values.
 975
 976 =item "failed" -- credentials are not correct; C<$sessionid> are undef
 977
 978 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 979
 980 =item "expired -- session cookie has expired; API user should resubmit userid and password
 981
 982 =back
 983
 984 =cut
 985
 986 sub check_cookie_auth {
 987     my $cookie = shift;
 988     my $flagsrequired = shift;
 989
 990     my $dbh     = C4::Context->dbh;
 991     my $timeout = C4::Context->preference('timeout');
 992     $timeout = 600 unless $timeout;
 993
 994     unless (C4::Context->preference('Version')) {
 995         # database has not been installed yet
 996         return ("maintenance", undef);
 997     }
 998     my $kohaversion=C4::Context::KOHAVERSION;
 999     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1000     if (C4::Context->preference('Version') < $kohaversion) {
1001         # database in need of version update; assume that
1002         # no API should be called while databsae is in
1003         # this condition.
1004         return ("maintenance", undef);
1005     }
1006
1007     # FIXME -- most of what follows is a copy-and-paste
1008     # of code from checkauth.  There is an obvious need
1009     # for refactoring to separate the various parts of
1010     # the authentication code, but as of 2007-11-23 this
1011     # is deferred so as to not introduce bugs into the
1012     # regular authentication code for Koha 3.0.
1013
1014     # see if we have a valid session cookie already
1015     # however, if a userid parameter is present (i.e., from
1016     # a form submission, assume that any current cookie
1017     # is to be ignored
1018     unless (defined $cookie and $cookie) {
1019         return ("failed", undef);
1020     }
1021     my $sessionID = $cookie;
1022     my $session = get_session($sessionID);
1023     C4::Context->_new_userenv($sessionID);
1024     if ($session) {
1025         C4::Context::set_userenv(
1026             $session->param('number'),       $session->param('id'),
1027             $session->param('cardnumber'),   $session->param('firstname'),
1028             $session->param('surname'),      $session->param('branch'),
1029             $session->param('branchname'),   $session->param('flags'),
1030             $session->param('emailaddress'), $session->param('branchprinter')
1031         );
1032
1033         my $ip = $session->param('ip');
1034         my $lasttime = $session->param('lasttime');
1035         my $userid = $session->param('id');
1036         if ( $lasttime < time() - $timeout ) {
1037             # time out
1038             $session->delete();
1039             C4::Context->_unset_userenv($sessionID);
1040             $userid    = undef;
1041             $sessionID = undef;
1042             return ("expired", undef);
1043         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1044             # IP address changed
1045             $session->delete();
1046             C4::Context->_unset_userenv($sessionID);
1047             $userid    = undef;
1048             $sessionID = undef;
1049             return ("expired", undef);
1050         } else {
1051             $session->param('lasttime',time());
1052             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1053             if ($flags) {
1054                 return ("ok", $sessionID);
1055             } else {
1056                 $session->delete();
1057                 C4::Context->_unset_userenv($sessionID);
1058                 $userid    = undef;
1059                 $sessionID = undef;
1060                 return ("failed", undef);
1061             }
1062         }
1063     } else {
1064         return ("expired", undef);
1065     }
1066 }
1067
1068 =item get_session
1069
1070   use CGI::Session;
1071   my $session = get_session($sessionID);
1072
1073 Given a session ID, retrieve the CGI::Session object used to store
1074 the session's state.  The session object can be used to store
1075 data that needs to be accessed by different scripts during a
1076 user's session.
1077
1078 If the C<$sessionID> parameter is an empty string, a new session
1079 will be created.
1080
1081 =cut
1082
1083 sub get_session {
1084     my $sessionID = shift;
1085     my $storage_method = C4::Context->preference('SessionStorage');
1086     my $dbh = C4::Context->dbh;
1087     my $session;
1088     if ($storage_method eq 'mysql'){
1089         $session = new CGI::Session("driver:MySQL", $sessionID, {Handle=>$dbh});
1090     }
1091     elsif ($storage_method eq 'Pg') {
1092         $session = new CGI::Session("driver:PostgreSQL", $sessionID, {Handle=>$dbh});
1093     }
1094     else {
1095         # catch all defaults to tmp should work on all systems
1096         $session = new CGI::Session("driver:File", $sessionID, {Directory=>'/tmp'});
1097     }
1098     return $session;
1099 }
1100
1101 sub checkpw {
1102
1103     my ( $dbh, $userid, $password ) = @_;
1104
1105     # INTERNAL AUTH
1106     my $sth =
1107       $dbh->prepare(
1108 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1109       );
1110     $sth->execute($userid);
1111     if ( $sth->rows ) {
1112         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1113             $surname, $branchcode, $flags )
1114           = $sth->fetchrow;
1115         if ( md5_base64($password) eq $md5password ) {
1116
1117             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1118                 $firstname, $surname, $branchcode, $flags );
1119             return 1, $cardnumber;
1120         }
1121     }
1122     $sth =
1123       $dbh->prepare(
1124 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1125       );
1126     $sth->execute($userid);
1127     if ( $sth->rows ) {
1128         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1129             $surname, $branchcode, $flags )
1130           = $sth->fetchrow;
1131         if ( md5_base64($password) eq $md5password ) {
1132
1133             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1134                 $firstname, $surname, $branchcode, $flags );
1135             return 1, $userid;
1136         }
1137     }
1138     if (   $userid && $userid eq C4::Context->config('user')
1139         && "$password" eq C4::Context->config('pass') )
1140     {
1141
1142 # Koha superuser account
1143 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1144         return 2;
1145     }
1146     if (   $userid && $userid eq 'demo'
1147         && "$password" eq 'demo'
1148         && C4::Context->config('demo') )
1149     {
1150
1151 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1152 # some features won't be effective : modify systempref, modify MARC structure,
1153         return 2;
1154     }
1155     return 0;
1156 }
1157
1158 =item getuserflags
1159
1160  $authflags = getuserflags($flags,$dbh);
1161 Translates integer flags into permissions strings hash.
1162
1163 C<$flags> is the integer userflags value ( borrowers.userflags )
1164 C<$authflags> is a hashref of permissions
1165
1166 =cut
1167
1168 sub getuserflags {
1169     my $flags   = shift;
1170     my $dbh     = shift;
1171     my $userflags;
1172         $flags = 0 unless $flags;
1173     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1174     $sth->execute;
1175
1176     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1177         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1178             $userflags->{$flag} = 1;
1179         }
1180         else {
1181             $userflags->{$flag} = 0;
1182         }
1183     }
1184     return $userflags;
1185 }
1186
1187 =item haspermission
1188
1189   $flags = ($dbh,$member,$flagsrequired);
1190
1191 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1192 C<$flags> is a hashref of required flags lik C<$borrower-&lt;{authflags}>
1193
1194 Returns member's flags or 0 if a permission is not met.
1195
1196 =cut
1197
1198 sub haspermission {
1199     my ( $dbh, $userid, $flagsrequired ) = @_;
1200         my ($flags,$intflags);
1201         $dbh=C4::Context->dbh unless($dbh);
1202         if(ref($userid)) {
1203                 $intflags = $userid->{'flags'};
1204         } else {
1205             my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1206             $sth->execute($userid);
1207             my ($intflags) = $sth->fetchrow;
1208             $flags = getuserflags( $intflags, $dbh );
1209         }
1210         if ( $userid eq C4::Context->config('user') ) {
1211         # Super User Account from /etc/koha.conf
1212         $flags->{'superlibrarian'} = 1;
1213     }
1214     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1215         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1216         $flags->{'superlibrarian'} = 1;
1217     }
1218     return $flags if $flags->{superlibrarian};
1219     foreach ( keys %$flagsrequired ) {
1220         return 0 unless( $flags->{$_} );
1221     }
1222     return $flags;
1223         #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1224 }
1225
1226
1227 sub getborrowernumber {
1228     my ($userid) = @_;
1229     my $dbh = C4::Context->dbh;
1230     for my $field ( 'userid', 'cardnumber' ) {
1231         my $sth =
1232           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1233         $sth->execute($userid);
1234         if ( $sth->rows ) {
1235             my ($bnumber) = $sth->fetchrow;
1236             return $bnumber;
1237         }
1238     }
1239     return 0;
1240 }
1241
1242 END { }    # module clean-up code here (global destructor)
1243 1;
1244 __END__
1245
1246 =back
1247
1248 =head1 SEE ALSO
1249
1250 CGI(3)
1251
1252 C4::Output(3)
1253
1254 Digest::MD5(3)
1255
1256 =cut