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