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