koha-dev.rot13.org Git - koha_fer/blob - C4/Auth.pm

   1 # -*- tab-width: 8 -*-
   2 # NOTE: This file uses 8-character tabs; do not change the tab size!
   3
   4 package C4::Auth;
   5
   6 # Copyright 2000-2002 Katipo Communications
   7 #
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it under the
  11 # terms of the GNU General Public License as published by the Free Software
  12 # Foundation; either version 2 of the License, or (at your option) any later
  13 # version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along with
  20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  21 # Suite 330, Boston, MA  02111-1307 USA
  22
  23 use strict;
  24 use Digest::MD5 qw(md5_base64);
  25
  26 require Exporter;
  27 use C4::Context;
  28 use C4::Output;    # to get the template
  29 use C4::Members;
  30 use C4::Koha;
  31 use C4::Branch; # GetBranches
  32
  33 # use Net::LDAP;
  34 # use Net::LDAP qw(:all);
  35
  36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  37
  38 # set the version for version checking
  39 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  40     shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
  41 };
  42
  43 =head1 NAME
  44
  45 C4::Auth - Authenticates Koha users
  46
  47 =head1 SYNOPSIS
  48
  49   use CGI;
  50   use C4::Auth;
  51
  52   my $query = new CGI;
  53
  54   my ($template, $borrowernumber, $cookie)
  55     = get_template_and_user({template_name   => "opac-main.tmpl",
  56                              query           => $query,
  57                              type            => "opac",
  58                              authnotrequired => 1,
  59                              flagsrequired   => {borrow => 1},
  60                           });
  61
  62   print $query->header(
  63     -type => 'utf-8',
  64     -cookie => $cookie
  65   ), $template->output;
  66
  67
  68 =head1 DESCRIPTION
  69
  70     The main function of this module is to provide
  71     authentification. However the get_template_and_user function has
  72     been provided so that a users login information is passed along
  73     automatically. This gets loaded into the template.
  74
  75 =head1 FUNCTIONS
  76
  77 =over 2
  78
  79 =cut
  80
  81 @ISA    = qw(Exporter);
  82 @EXPORT = qw(
  83   &checkauth
  84   &get_template_and_user
  85 );
  86
  87 =item get_template_and_user
  88
  89   my ($template, $borrowernumber, $cookie)
  90     = get_template_and_user({template_name   => "opac-main.tmpl",
  91                              query           => $query,
  92                              type            => "opac",
  93                              authnotrequired => 1,
  94                              flagsrequired   => {borrow => 1},
  95                           });
  96
  97     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
  98     to C<&checkauth> (in this module) to perform authentification.
  99     See C<&checkauth> for an explanation of these parameters.
 100
 101     The C<template_name> is then used to find the correct template for
 102     the page. The authenticated users details are loaded onto the
 103     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 104     C<sessionID> is passed to the template. This can be used in templates
 105     if cookies are disabled. It needs to be put as and input to every
 106     authenticated page.
 107
 108     More information on the C<gettemplate> sub can be found in the
 109     Output.pm module.
 110
 111 =cut
 112
 113 sub get_template_and_user {
 114     my $in       = shift;
 115     my $template =
 116       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 117     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
 118         $in->{'query'},
 119         $in->{'authnotrequired'},
 120         $in->{'flagsrequired'},
 121         $in->{'type'}
 122     ) unless ($in->{'template_name'}=~/maintenance/);
 123
 124     my $borrowernumber;
 125     my $insecure = C4::Context->preference('insecure');
 126     if ($user or $insecure) {
 127         $template->param( loggedinusername => $user );
 128         $template->param( sessionID        => $sessionID );
 129
 130         $borrowernumber = getborrowernumber($user);
 131         my ( $borr, $alternativeflags ) =
 132           GetMemberDetails( $borrowernumber );
 133         my @bordat;
 134         $bordat[0] = $borr;
 135         $template->param( "USER_INFO" => \@bordat );
 136
 137         # We are going to use the $flags returned by checkauth
 138         # to create the template's parameters that will indicate
 139         # which menus the user can access.
 140         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
 141             $template->param( CAN_user_circulate        => 1 );
 142             $template->param( CAN_user_catalogue        => 1 );
 143             $template->param( CAN_user_parameters       => 1 );
 144             $template->param( CAN_user_borrowers        => 1 );
 145             $template->param( CAN_user_permission       => 1 );
 146             $template->param( CAN_user_reserveforothers => 1 );
 147             $template->param( CAN_user_borrow           => 1 );
 148             $template->param( CAN_user_editcatalogue    => 1 );
 149             $template->param( CAN_user_updatecharge     => 1 );
 150             $template->param( CAN_user_acquisition      => 1 );
 151             $template->param( CAN_user_management       => 1 );
 152             $template->param( CAN_user_tools            => 1 );
 153             $template->param( CAN_user_editauthorities  => 1 );
 154             $template->param( CAN_user_serials          => 1 );
 155             $template->param( CAN_user_reports          => 1 );
 156         }
 157
 158         if ( $flags && $flags->{circulate} == 1 ) {
 159             $template->param( CAN_user_circulate => 1 );
 160         }
 161
 162         if ( $flags && $flags->{catalogue} == 1 ) {
 163             $template->param( CAN_user_catalogue => 1 );
 164         }
 165
 166         if ( $flags && $flags->{parameters} == 1 ) {
 167             $template->param( CAN_user_parameters => 1 );
 168             $template->param( CAN_user_management => 1 );
 169         }
 170
 171         if ( $flags && $flags->{borrowers} == 1 ) {
 172             $template->param( CAN_user_borrowers => 1 );
 173         }
 174
 175         if ( $flags && $flags->{permissions} == 1 ) {
 176             $template->param( CAN_user_permission => 1 );
 177         }
 178
 179         if ( $flags && $flags->{reserveforothers} == 1 ) {
 180             $template->param( CAN_user_reserveforothers => 1 );
 181         }
 182
 183         if ( $flags && $flags->{borrow} == 1 ) {
 184             $template->param( CAN_user_borrow => 1 );
 185         }
 186
 187         if ( $flags && $flags->{editcatalogue} == 1 ) {
 188             $template->param( CAN_user_editcatalogue => 1 );
 189         }
 190
 191         if ( $flags && $flags->{updatecharges} == 1 ) {
 192             $template->param( CAN_user_updatecharge => 1 );
 193         }
 194
 195         if ( $flags && $flags->{acquisition} == 1 ) {
 196             $template->param( CAN_user_acquisition => 1 );
 197         }
 198
 199         if ( $flags && $flags->{tools} == 1 ) {
 200             $template->param( CAN_user_tools => 1 );
 201         }
 202
 203         if ( $flags && $flags->{editauthorities} == 1 ) {
 204             $template->param( CAN_user_editauthorities => 1 );
 205         }
 206
 207         if ( $flags && $flags->{serials} == 1 ) {
 208             $template->param( CAN_user_serials => 1 );
 209         }
 210
 211         if ( $flags && $flags->{reports} == 1 ) {
 212             $template->param( CAN_user_reports => 1 );
 213         }
 214     }
 215     if ( $in->{'type'} eq "intranet" ) {
 216         $template->param(
 217             intranetcolorstylesheet =>
 218               C4::Context->preference("intranetcolorstylesheet"),
 219             intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 220             IntranetNav        => C4::Context->preference("IntranetNav"),
 221             intranetuserjs     => C4::Context->preference("intranetuserjs"),
 222             TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 223             AmazonContent      => C4::Context->preference("AmazonContent"),
 224             LibraryName        => C4::Context->preference("LibraryName"),
 225             LoginBranchcode    => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 226             LoginBranchname    => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
 227             AutoLocation       => C4::Context->preference("AutoLocation"),
 228             hide_marc          => C4::Context->preference("hide_marc"),
 229             patronimages       => C4::Context->preference("patronimages"),
 230             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 231             advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
 232             suggestion => C4::Context->preference("suggestion"),
 233             virtualshelves => C4::Context->preference("virtualshelves"),
 234             LibraryName => C4::Context->preference("LibraryName"),
 235             KohaAdminEmailAddress     => "" . C4::Context->preference("KohaAdminEmailAddress"),
 236         );
 237     }
 238     else {
 239         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]"
 240           unless ( $in->{'type'} eq 'opac' );
 241         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 242         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 243         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 244         $template->param(
 245             KohaAdminEmailAddress     => "" . C4::Context->preference("KohaAdminEmailAddress"),
 246             suggestion     => "" . C4::Context->preference("suggestion"),
 247             virtualshelves => "" . C4::Context->preference("virtualshelves"),
 248             OpacNav        => "" . C4::Context->preference("OpacNav"),
 249             opacheader     => "" . C4::Context->preference("opacheader"),
 250             opaccredits    => "" . C4::Context->preference("opaccredits"),
 251             opacsmallimage => "" . C4::Context->preference("opacsmallimage"),
 252             opaclargeimage => "" . C4::Context->preference("opaclargeimage"),
 253             opaclayoutstylesheet => "". C4::Context->preference("opaclayoutstylesheet"),
 254             opaccolorstylesheet => "". C4::Context->preference("opaccolorstylesheet"),
 255             opaclanguagesdisplay => "". C4::Context->preference("opaclanguagesdisplay"),
 256             opacuserlogin    => "" . C4::Context->preference("opacuserlogin"),
 257             opacbookbag      => "" . C4::Context->preference("opacbookbag"),
 258             TemplateEncoding => "". C4::Context->preference("TemplateEncoding"),
 259             AmazonContent => "" . C4::Context->preference("AmazonContent"),
 260             LibraryName   => "" . C4::Context->preference("LibraryName"),
 261             LibraryNameTitle   => "" . $LibraryNameTitle,
 262             LoginBranchcode    => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 263             LoginBranchname    => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 264             OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
 265             opacreadinghistory => C4::Context->preference("opacreadinghistory"),
 266             opacuserjs         => C4::Context->preference("opacuserjs"),
 267             OpacCloud          => C4::Context->preference("OpacCloud"),
 268             OpacTopissue       => C4::Context->preference("OpacTopissue"),
 269             OpacAuthorities    => C4::Context->preference("OpacAuthorities"),
 270             OpacBrowser        => C4::Context->preference("OpacBrowser"),
 271             RequestOnOpac      => C4::Context->preference("RequestOnOpac"),
 272             reviewson          => C4::Context->preference("reviewson"),
 273             hide_marc          => C4::Context->preference("hide_marc"),
 274             patronimages       => C4::Context->preference("patronimages"),
 275             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 276         );
 277     }
 278     return ( $template, $borrowernumber, $cookie );
 279 }
 280
 281 =item checkauth
 282
 283   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 284
 285 Verifies that the user is authorized to run this script.  If
 286 the user is authorized, a (userid, cookie, session-id, flags)
 287 quadruple is returned.  If the user is not authorized but does
 288 not have the required privilege (see $flagsrequired below), it
 289 displays an error page and exits.  Otherwise, it displays the
 290 login page and exits.
 291
 292 Note that C<&checkauth> will return if and only if the user
 293 is authorized, so it should be called early on, before any
 294 unfinished operations (e.g., if you've opened a file, then
 295 C<&checkauth> won't close it for you).
 296
 297 C<$query> is the CGI object for the script calling C<&checkauth>.
 298
 299 The C<$noauth> argument is optional. If it is set, then no
 300 authorization is required for the script.
 301
 302 C<&checkauth> fetches user and session information from C<$query> and
 303 ensures that the user is authorized to run scripts that require
 304 authorization.
 305
 306 The C<$flagsrequired> argument specifies the required privileges
 307 the user must have if the username and password are correct.
 308 It should be specified as a reference-to-hash; keys in the hash
 309 should be the "flags" for the user, as specified in the Members
 310 intranet module. Any key specified must correspond to a "flag"
 311 in the userflags table. E.g., { circulate => 1 } would specify
 312 that the user must have the "circulate" privilege in order to
 313 proceed. To make sure that access control is correct, the
 314 C<$flagsrequired> parameter must be specified correctly.
 315
 316 The C<$type> argument specifies whether the template should be
 317 retrieved from the opac or intranet directory tree.  "opac" is
 318 assumed if it is not specified; however, if C<$type> is specified,
 319 "intranet" is assumed if it is not "opac".
 320
 321 If C<$query> does not have a valid session ID associated with it
 322 (i.e., the user has not logged in) or if the session has expired,
 323 C<&checkauth> presents the user with a login page (from the point of
 324 view of the original script, C<&checkauth> does not return). Once the
 325 user has authenticated, C<&checkauth> restarts the original script
 326 (this time, C<&checkauth> returns).
 327
 328 The login page is provided using a HTML::Template, which is set in the
 329 systempreferences table or at the top of this file. The variable C<$type>
 330 selects which template to use, either the opac or the intranet
 331 authentification template.
 332
 333 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 334 cookie should be sent back to the browser; it verifies that the user
 335 has authenticated.
 336
 337 =cut
 338
 339 sub checkauth {
 340     my $query = shift;
 341
 342 # $authnotrequired will be set for scripts which will run without authentication
 343     my $authnotrequired = shift;
 344     my $flagsrequired   = shift;
 345     my $type            = shift;
 346     $type = 'opac' unless $type;
 347
 348     my $dbh     = C4::Context->dbh;
 349     # check that database and koha version are the same
 350     unless (C4::Context->preference('Version')){
 351       if ($type ne 'opac'){
 352         warn "Install required, redirecting to Installer";
 353         print $query->redirect("/cgi-bin/koha/installer/install.pl");
 354       } else {
 355         warn "OPAC Install required, redirecting to maintenance";
 356         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 357       }
 358       exit;
 359     }
 360     if (C4::Context->preference('Version') < C4::Context->config("kohaversion")){
 361       if ($type ne 'opac'){
 362       warn "Database update needed, redirecting to Installer. Database is ".C4::Context->preference('Version')." and Koha is : ".C4::Context->config("kohaversion");
 363         print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 364       } else {
 365       warn "OPAC :Database update needed, redirecting to maintenance. Database is ".C4::Context->preference('Version')." and Koha is : ".C4::Context->config("kohaversion");
 366         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 367       }
 368       exit;
 369     }
 370     my $timeout = C4::Context->preference('timeout');
 371     $timeout = 600 unless $timeout;
 372
 373     my $template_name;
 374     if ( $type eq 'opac' ) {
 375         $template_name = "opac-auth.tmpl";
 376     }
 377     else {
 378         $template_name = "auth.tmpl";
 379     }
 380
 381     # state variables
 382     my $loggedin = 0;
 383     my %info;
 384     my ( $userid, $cookie, $sessionID, $flags, $envcookie );
 385     my $logout = $query->param('logout.x');
 386     if ( $userid = $ENV{'REMOTE_USER'} ) {
 387
 388         # Using Basic Authentication, no cookies required
 389         $cookie = $query->cookie(
 390             -name    => 'sessionID',
 391             -value   => '',
 392             -expires => ''
 393         );
 394         $loggedin = 1;
 395     }
 396     elsif ( $sessionID = $query->cookie('sessionID') ) {
 397         C4::Context->_new_userenv($sessionID);
 398         if ( my %hash = $query->cookie('userenv') ) {
 399             C4::Context::set_userenv(
 400                 $hash{number},       $hash{id},
 401                 $hash{cardnumber},   $hash{firstname},
 402                 $hash{surname},      $hash{branch},
 403                 $hash{branchname},   $hash{flags},
 404                 $hash{emailaddress}, $hash{branchprinter}
 405             );
 406         }
 407         my ( $ip, $lasttime );
 408
 409         ( $userid, $ip, $lasttime ) =
 410           $dbh->selectrow_array(
 411             "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
 412             undef, $sessionID );
 413         if ($logout) {
 414
 415             # voluntary logout the user
 416             $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 417                 undef, $sessionID );
 418             C4::Context->_unset_userenv($sessionID);
 419             $sessionID = undef;
 420             $userid    = undef;
 421             open L, ">>/tmp/sessionlog";
 422             my $time = localtime( time() );
 423             printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
 424               $ip, $time;
 425             close L;
 426         }
 427         if ($userid) {
 428             if ( $lasttime < time() - $timeout ) {
 429
 430                 # timed logout
 431                 $info{'timed_out'} = 1;
 432                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 433                     undef, $sessionID );
 434                 C4::Context->_unset_userenv($sessionID);
 435                 $userid    = undef;
 436                 $sessionID = undef;
 437                 open L, ">>/tmp/sessionlog";
 438                 my $time = localtime( time() );
 439                 printf L "%20s from %16s logged out at %30s (inactivity).\n",
 440                   $userid, $ip, $time;
 441                 close L;
 442             }
 443             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 444
 445                 # Different ip than originally logged in from
 446                 $info{'oldip'}        = $ip;
 447                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 448                 $info{'different_ip'} = 1;
 449                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 450                     undef, $sessionID );
 451                 C4::Context->_unset_userenv($sessionID);
 452                 $sessionID = undef;
 453                 $userid    = undef;
 454                 open L, ">>/tmp/sessionlog";
 455                 my $time = localtime( time() );
 456                 printf L
 457 "%20s from logged out at %30s (ip changed from %16s to %16s).\n",
 458                   $userid, $time, $ip, $info{'newip'};
 459                 close L;
 460             }
 461             else {
 462                 $cookie = $query->cookie(
 463                     -name    => 'sessionID',
 464                     -value   => $sessionID,
 465                     -expires => ''
 466                 );
 467                 $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?",
 468                     undef, ( time(), $sessionID ) );
 469                 $flags = haspermission( $dbh, $userid, $flagsrequired );
 470                 if ($flags) {
 471                     $loggedin = 1;
 472                 }
 473                 else {
 474                     $info{'nopermission'} = 1;
 475                 }
 476             }
 477         }
 478     }
 479     unless ($userid) {
 480         $sessionID = int( rand() * 100000 ) . '-' . time();
 481         $userid    = $query->param('userid');
 482         C4::Context->_new_userenv($sessionID);
 483         my $password = $query->param('password');
 484         C4::Context->_new_userenv($sessionID);
 485         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 486         if ($return) {
 487             $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?",
 488                 undef, ( $sessionID, $userid ) );
 489             $dbh->do(
 490 "INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
 491                 undef,
 492                 ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() )
 493             );
 494             open L, ">>/tmp/sessionlog";
 495             my $time = localtime( time() );
 496             printf L "%20s from %16s logged in  at %30s.\n", $userid,
 497               $ENV{'REMOTE_ADDR'}, $time;
 498             close L;
 499             $cookie = $query->cookie(
 500                 -name    => 'sessionID',
 501                 -value   => $sessionID,
 502                 -expires => ''
 503             );
 504             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 505                 $loggedin = 1;
 506             }
 507             else {
 508                 $info{'nopermission'} = 1;
 509                 C4::Context->_unset_userenv($sessionID);
 510             }
 511             if ( $return == 1 ) {
 512                 my (
 513                     $borrowernumber, $firstname,  $surname,
 514                     $userflags,      $branchcode, $branchname,
 515                     $branchprinter,  $emailaddress
 516                 );
 517                 my $sth =
 518                   $dbh->prepare(
 519 "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=?"
 520                   );
 521                 $sth->execute($userid);
 522                 (
 523                     $borrowernumber, $firstname,  $surname,
 524                     $userflags,      $branchcode, $branchname,
 525                     $branchprinter,  $emailaddress
 526                   )
 527                   = $sth->fetchrow
 528                   if ( $sth->rows );
 529
 530 #                               warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 531                 unless ( $sth->rows ) {
 532                     my $sth =
 533                       $dbh->prepare(
 534 "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=?"
 535                       );
 536                     $sth->execute($cardnumber);
 537                     (
 538                         $borrowernumber, $firstname,  $surname,
 539                         $userflags,      $branchcode, $branchname,
 540                         $branchprinter,  $emailaddress
 541                       )
 542                       = $sth->fetchrow
 543                       if ( $sth->rows );
 544
 545 #                                       warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 546                     unless ( $sth->rows ) {
 547                         $sth->execute($userid);
 548                         (
 549                             $borrowernumber, $firstname, $surname, $userflags,
 550                             $branchcode, $branchname, $branchprinter, $emailaddress
 551                           )
 552                           = $sth->fetchrow
 553                           if ( $sth->rows );
 554                     }
 555
 556 #                                       warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 557                 }
 558
 559 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 560 #  new op dev :
 561 # launch a sequence to check if we have a ip for the branch, if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 562                 my $ip       = $ENV{'REMOTE_ADDR'};
 563                 my $branches = GetBranches();
 564                 my @branchesloop;
 565                 foreach my $br ( keys %$branches ) {
 566
 567                     #           now we work with the treatment of ip
 568                     my $domain = $branches->{$br}->{'branchip'};
 569                     if ( $domain && $ip =~ /^$domain/ ) {
 570                         $branchcode = $branches->{$br}->{'branchcode'};
 571
 572                         # new op dev : add the branchprinter and branchname in the cookie
 573                         $branchprinter = $branches->{$br}->{'branchprinter'};
 574                         $branchname    = $branches->{$br}->{'branchname'};
 575                     }
 576                 }
 577                 my $hash = C4::Context::set_userenv(
 578                     $borrowernumber, $userid,    $cardnumber,
 579                     $firstname,      $surname,   $branchcode,
 580                     $branchname,     $userflags, $emailaddress,
 581                     $branchprinter,
 582                 );
 583
 584                 $envcookie = $query->cookie(
 585                     -name    => 'userenv',
 586                     -value   => $hash,
 587                     -expires => ''
 588                 );
 589             }
 590             elsif ( $return == 2 ) {
 591
 592                 #We suppose the user is the superlibrarian
 593                 my $hash = C4::Context::set_userenv(
 594                     0,
 595                     0,
 596                     C4::Context->config('user'),
 597                     C4::Context->config('user'),
 598                     C4::Context->config('user'),
 599                     "",
 600                     "NO_LIBRARY_SET",
 601                     1,
 602                     C4::Context->preference('KohaAdminEmailAddress')
 603                 );
 604                 $envcookie = $query->cookie(
 605                     -name    => 'userenv',
 606                     -value   => $hash,
 607                     -expires => ''
 608                 );
 609             }
 610         }
 611         else {
 612             if ($userid) {
 613                 $info{'invalid_username_or_password'} = 1;
 614                 C4::Context->_unset_userenv($sessionID);
 615             }
 616         }
 617     }
 618     my $insecure = C4::Context->boolean_preference('insecure');
 619
 620     # finished authentification, now respond
 621     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 622     {
 623
 624         # successful login
 625         unless ($cookie) {
 626             $cookie = $query->cookie(
 627                 -name    => 'sessionID',
 628                 -value   => '',
 629                 -expires => ''
 630             );
 631         }
 632         if ($envcookie) {
 633             return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags );
 634         }
 635         else {
 636             return ( $userid, $cookie, $sessionID, $flags );
 637         }
 638     }
 639
 640     # else we have a problem...
 641     # get the inputs from the incoming query
 642     my @inputs = ();
 643     foreach my $name ( param $query) {
 644         (next) if ( $name eq 'userid' || $name eq 'password' );
 645         my $value = $query->param($name);
 646         push @inputs, { name => $name, value => $value };
 647     }
 648
 649     my $template = gettemplate( $template_name, $type, $query );
 650     $template->param(
 651         INPUTS               => \@inputs,
 652         suggestion           => C4::Context->preference("suggestion"),
 653         virtualshelves       => C4::Context->preference("virtualshelves"),
 654         opaclargeimage       => C4::Context->preference("opaclargeimage"),
 655         LibraryName          => C4::Context->preference("LibraryName"),
 656         OpacNav              => C4::Context->preference("OpacNav"),
 657         opaccredits          => C4::Context->preference("opaccredits"),
 658         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 659         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 660         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 661         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 662         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 663         opacuserjs           => C4::Context->preference("opacuserjs"),
 664
 665         intranetcolorstylesheet =>
 666           C4::Context->preference("intranetcolorstylesheet"),
 667         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 668         IntranetNav        => C4::Context->preference("IntranetNav"),
 669         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 670         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 671
 672     );
 673     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 674
 675     my $self_url = $query->url( -absolute => 1 );
 676     $template->param(
 677         url         => $self_url,
 678         LibraryName => => C4::Context->preference("LibraryName"),
 679     );
 680     $template->param( \%info );
 681     $cookie = $query->cookie(
 682         -name    => 'sessionID',
 683         -value   => $sessionID,
 684         -expires => ''
 685     );
 686     print $query->header(
 687         -type   => 'utf-8',
 688         -cookie => $cookie
 689       ),
 690       $template->output;
 691     exit;
 692 }
 693
 694 sub checkpw {
 695
 696     my ( $dbh, $userid, $password ) = @_;
 697
 698     # INTERNAL AUTH
 699     my $sth =
 700       $dbh->prepare(
 701 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
 702       );
 703     $sth->execute($userid);
 704     if ( $sth->rows ) {
 705         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
 706             $surname, $branchcode, $flags )
 707           = $sth->fetchrow;
 708         if ( md5_base64($password) eq $md5password ) {
 709
 710             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
 711                 $firstname, $surname, $branchcode, $flags );
 712             return 1, $cardnumber;
 713         }
 714     }
 715     $sth =
 716       $dbh->prepare(
 717 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
 718       );
 719     $sth->execute($userid);
 720     if ( $sth->rows ) {
 721         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
 722             $surname, $branchcode, $flags )
 723           = $sth->fetchrow;
 724         if ( md5_base64($password) eq $md5password ) {
 725
 726             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
 727                 $firstname, $surname, $branchcode, $flags );
 728             return 1, $userid;
 729         }
 730     }
 731     if (   $userid && $userid eq C4::Context->config('user')
 732         && "$password" eq C4::Context->config('pass') )
 733     {
 734
 735 # Koha superuser account
 736 #               C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
 737         return 2;
 738     }
 739     if (   $userid && $userid eq 'demo'
 740         && "$password" eq 'demo'
 741         && C4::Context->config('demo') )
 742     {
 743
 744 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
 745 # some features won't be effective : modify systempref, modify MARC structure,
 746         return 2;
 747     }
 748     return 0;
 749 }
 750
 751 sub getuserflags {
 752     my $cardnumber = shift;
 753     my $dbh        = shift;
 754     my $userflags;
 755     my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
 756     $sth->execute($cardnumber);
 757     my ($flags) = $sth->fetchrow;
 758     $flags = 0 unless $flags;
 759     $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
 760     $sth->execute;
 761
 762     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
 763         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
 764             $userflags->{$flag} = 1;
 765         }
 766         else {
 767             $userflags->{$flag} = 0;
 768         }
 769     }
 770     return $userflags;
 771 }
 772
 773 sub haspermission {
 774     my ( $dbh, $userid, $flagsrequired ) = @_;
 775     my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
 776     $sth->execute($userid);
 777     my ($cardnumber) = $sth->fetchrow;
 778     ($cardnumber) || ( $cardnumber = $userid );
 779     my $flags = getuserflags( $cardnumber, $dbh );
 780     my $configfile;
 781     if ( $userid eq C4::Context->config('user') ) {
 782
 783         # Super User Account from /etc/koha.conf
 784         $flags->{'superlibrarian'} = 1;
 785     }
 786     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
 787
 788         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
 789         $flags->{'superlibrarian'} = 1;
 790     }
 791     return $flags if $flags->{superlibrarian};
 792     foreach ( keys %$flagsrequired ) {
 793         return $flags if $flags->{$_};
 794     }
 795     return 0;
 796 }
 797
 798 sub getborrowernumber {
 799     my ($userid) = @_;
 800     my $dbh = C4::Context->dbh;
 801     for my $field ( 'userid', 'cardnumber' ) {
 802         my $sth =
 803           $dbh->prepare("select borrowernumber from borrowers where $field=?");
 804         $sth->execute($userid);
 805         if ( $sth->rows ) {
 806             my ($bnumber) = $sth->fetchrow;
 807             return $bnumber;
 808         }
 809     }
 810     return 0;
 811 }
 812
 813 END { }    # module clean-up code here (global destructor)
 814 1;
 815 __END__
 816
 817 =back
 818
 819 =head1 SEE ALSO
 820
 821 CGI(3)
 822
 823 C4::Output(3)
 824
 825 Digest::MD5(3)
 826
 827 =cut