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::Interface::CGI::Output;
  30 use C4::Circulation::Circ2;  # getpatroninformation
  31
  32 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  33
  34 # set the version for version checking
  35 $VERSION = 0.01;
  36
  37 =head1 NAME
  38
  39 C4::Auth - Authenticates Koha users
  40
  41 =head1 SYNOPSIS
  42
  43   use CGI;
  44   use C4::Auth;
  45
  46   my $query = new CGI;
  47
  48   my ($template, $borrowernumber, $cookie)
  49     = get_template_and_user({template_name   => "opac-main.tmpl",
  50                              query           => $query,
  51                              type            => "opac",
  52                              authnotrequired => 1,
  53                              flagsrequired   => {borrow => 1},
  54                           });
  55
  56   print $query->header(
  57     -type => guesstype($template->output),
  58     -cookie => $cookie
  59   ), $template->output;
  60
  61
  62 =head1 DESCRIPTION
  63
  64     The main function of this module is to provide
  65     authentification. However the get_template_and_user function has
  66     been provided so that a users login information is passed along
  67     automatically. This gets loaded into the template.
  68
  69 =head1 FUNCTIONS
  70
  71 =over 2
  72
  73 =cut
  74
  75
  76
  77 @ISA = qw(Exporter);
  78 @EXPORT = qw(
  79              &checkauth
  80              &get_template_and_user
  81 );
  82
  83 =item get_template_and_user
  84
  85   my ($template, $borrowernumber, $cookie)
  86     = get_template_and_user({template_name   => "opac-main.tmpl",
  87                              query           => $query,
  88                              type            => "opac",
  89                              authnotrequired => 1,
  90                              flagsrequired   => {borrow => 1},
  91                           });
  92
  93     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
  94     to C<&checkauth> (in this module) to perform authentification.
  95     See C<&checkauth> for an explanation of these parameters.
  96
  97     The C<template_name> is then used to find the correct template for
  98     the page. The authenticated users details are loaded onto the
  99     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 100     C<sessionID> is passed to the template. This can be used in templates
 101     if cookies are disabled. It needs to be put as and input to every
 102     authenticated page.
 103
 104     More information on the C<gettemplate> sub can be found in the
 105     Output.pm module.
 106
 107 =cut
 108
 109
 110 sub get_template_and_user {
 111         my $in = shift;
 112         my $template = gettemplate($in->{'template_name'}, $in->{'type'});
 113         my ($user, $cookie, $sessionID, $flags)
 114                 = checkauth($in->{'query'}, $in->{'authnotrequired'}, $in->{'flagsrequired'}, $in->{'type'});
 115
 116         my $borrowernumber;
 117         if ($user) {
 118                 $template->param(loggedinusername => $user);
 119                 $template->param(sessionID => $sessionID);
 120
 121                 $borrowernumber = getborrowernumber($user);
 122                 my ($borr, $flags) = getpatroninformation(undef, $borrowernumber);
 123                 my @bordat;
 124                 $bordat[0] = $borr;
 125
 126                 $template->param(USER_INFO => \@bordat);
 127         }
 128         return ($template, $borrowernumber, $cookie);
 129 }
 130
 131
 132 =item checkauth
 133
 134   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 135
 136 Verifies that the user is authorized to run this script.  If
 137 the user is authorized, a (userid, cookie, session-id, flags)
 138 quadruple is returned.  If the user is not authorized but does
 139 not have the required privilege (see $flagsrequired below), it
 140 displays an error page and exits.  Otherwise, it displays the
 141 login page and exits.
 142
 143 Note that C<&checkauth> will return if and only if the user
 144 is authorized, so it should be called early on, before any
 145 unfinished operations (e.g., if you've opened a file, then
 146 C<&checkauth> won't close it for you).
 147
 148 C<$query> is the CGI object for the script calling C<&checkauth>.
 149
 150 The C<$noauth> argument is optional. If it is set, then no
 151 authorization is required for the script.
 152
 153 C<&checkauth> fetches user and session information from C<$query> and
 154 ensures that the user is authorized to run scripts that require
 155 authorization.
 156
 157 The C<$flagsrequired> argument specifies the required privileges
 158 the user must have if the username and password are correct.
 159 It should be specified as a reference-to-hash; keys in the hash
 160 should be the "flags" for the user, as specified in the Members
 161 intranet module. Any key specified must correspond to a "flag"
 162 in the userflags table. E.g., { circulate => 1 } would specify
 163 that the user must have the "circulate" privilege in order to
 164 proceed. To make sure that access control is correct, the
 165 C<$flagsrequired> parameter must be specified correctly.
 166
 167 The C<$type> argument specifies whether the template should be
 168 retrieved from the opac or intranet directory tree.  "opac" is
 169 assumed if it is not specified; however, if C<$type> is specified,
 170 "intranet" is assumed if it is not "opac".
 171
 172 If C<$query> does not have a valid session ID associated with it
 173 (i.e., the user has not logged in) or if the session has expired,
 174 C<&checkauth> presents the user with a login page (from the point of
 175 view of the original script, C<&checkauth> does not return). Once the
 176 user has authenticated, C<&checkauth> restarts the original script
 177 (this time, C<&checkauth> returns).
 178
 179 The login page is provided using a HTML::Template, which is set in the
 180 systempreferences table or at the top of this file. The variable C<$type>
 181 selects which template to use, either the opac or the intranet
 182 authentification template.
 183
 184 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 185 cookie should be sent back to the browser; it verifies that the user
 186 has authenticated.
 187
 188 =cut
 189
 190
 191
 192 sub checkauth {
 193         my $query=shift;
 194         # $authnotrequired will be set for scripts which will run without authentication
 195         my $authnotrequired = shift;
 196         my $flagsrequired = shift;
 197         my $type = shift;
 198         $type = 'opac' unless $type;
 199
 200         my $dbh = C4::Context->dbh;
 201         my $timeout = C4::Context->preference('timeout');
 202         $timeout = 600 unless $timeout;
 203
 204         my $template_name;
 205         if ($type eq 'opac') {
 206                 $template_name = "opac-auth.tmpl";
 207         } else {
 208                 $template_name = "auth.tmpl";
 209         }
 210
 211         # state variables
 212         my $loggedin = 0;
 213         my %info;
 214         my ($userid, $cookie, $sessionID, $flags);
 215         my $logout = $query->param('logout.x');
 216         if ($userid = $ENV{'REMOTE_USER'}) {
 217                 # Using Basic Authentication, no cookies required
 218                 $cookie=$query->cookie(-name => 'sessionID',
 219                                 -value => '',
 220                                 -expires => '');
 221                 $loggedin = 1;
 222         } elsif ($sessionID=$query->cookie('sessionID')) {
 223                 my ($ip , $lasttime);
 224                 ($userid, $ip, $lasttime) = $dbh->selectrow_array(
 225                                 "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
 226                                                                 undef, $sessionID);
 227                 if ($logout) {
 228                 # voluntary logout the user
 229                 $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 230                 $sessionID = undef;
 231                 $userid = undef;
 232                 open L, ">>/tmp/sessionlog";
 233                 my $time=localtime(time());
 234                 printf L "%20s from %16s logged out at %30s (manually).\n", $userid, $ip, $time;
 235                 close L;
 236                 }
 237                 if ($userid) {
 238                 if ($lasttime<time()-$timeout) {
 239                         # timed logout
 240                         $info{'timed_out'} = 1;
 241                         $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 242                         $userid = undef;
 243                         $sessionID = undef;
 244                         open L, ">>/tmp/sessionlog";
 245                         my $time=localtime(time());
 246                         printf L "%20s from %16s logged out at %30s (inactivity).\n", $userid, $ip, $time;
 247                         close L;
 248                 } elsif ($ip ne $ENV{'REMOTE_ADDR'}) {
 249                         # Different ip than originally logged in from
 250                         $info{'oldip'} = $ip;
 251                         $info{'newip'} = $ENV{'REMOTE_ADDR'};
 252                         $info{'different_ip'} = 1;
 253                         $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 254                         $sessionID = undef;
 255                         $userid = undef;
 256                         open L, ">>/tmp/sessionlog";
 257                         my $time=localtime(time());
 258                         printf L "%20s from logged out at %30s (ip changed from %16s to %16s).\n", $userid, $time, $ip, $info{'newip'};
 259                         close L;
 260                 } else {
 261                         $cookie=$query->cookie(-name => 'sessionID',
 262                                         -value => $sessionID,
 263                                         -expires => '');
 264                         $dbh->do("UPDATE sessions SET lasttime=? WHERE sessionID=?",
 265                                 undef, (time(), $sessionID));
 266                         $flags = haspermission($dbh, $userid, $flagsrequired);
 267                         if ($flags) {
 268                         $loggedin = 1;
 269                         } else {
 270                         $info{'nopermission'} = 1;
 271                         }
 272                 }
 273                 }
 274         }
 275         unless ($userid) {
 276                 $sessionID=int(rand()*100000).'-'.time();
 277                 $userid=$query->param('userid');
 278                 my $password=$query->param('password');
 279                 my ($return, $cardnumber) = checkpw($dbh,$userid,$password);
 280                 if ($return) {
 281                 $dbh->do("DELETE FROM sessions WHERE sessionID=? AND userid=?",
 282                         undef, ($sessionID, $userid));
 283                 $dbh->do("INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
 284                         undef, ($sessionID, $userid, $ENV{'REMOTE_ADDR'}, time()));
 285                 open L, ">>/tmp/sessionlog";
 286                 my $time=localtime(time());
 287                 printf L "%20s from %16s logged in  at %30s.\n", $userid, $ENV{'REMOTE_ADDR'}, $time;
 288                 close L;
 289                 $cookie=$query->cookie(-name => 'sessionID',
 290                                         -value => $sessionID,
 291                                         -expires => '');
 292                 if ($flags = haspermission($dbh, $userid, $flagsrequired)) {
 293                         $loggedin = 1;
 294                 } else {
 295                         $info{'nopermission'} = 1;
 296                 }
 297                 } else {
 298                 if ($userid) {
 299                         $info{'invalid_username_or_password'} = 1;
 300                 }
 301                 }
 302         }
 303         my $insecure = C4::Context->boolean_preference('insecure');
 304         # finished authentification, now respond
 305         if ($loggedin || $authnotrequired || (defined($insecure) && $insecure)) {
 306                 # successful login
 307                 unless ($cookie) {
 308                 $cookie=$query->cookie(-name => 'sessionID',
 309                                         -value => '',
 310                                         -expires => '');
 311                 }
 312                 return ($userid, $cookie, $sessionID, $flags);
 313         }
 314         # else we have a problem...
 315         # get the inputs from the incoming query
 316         my @inputs =();
 317         foreach my $name (param $query) {
 318                 (next) if ($name eq 'userid' || $name eq 'password');
 319                 my $value = $query->param($name);
 320                 push @inputs, {name => $name , value => $value};
 321         }
 322
 323         my $template = gettemplate($template_name, $type);
 324         $template->param(INPUTS => \@inputs);
 325         $template->param(loginprompt => 1) unless $info{'nopermission'};
 326
 327         my $self_url = $query->url(-absolute => 1);
 328         $template->param(url => $self_url);
 329         $template->param(\%info);
 330         $cookie=$query->cookie(-name => 'sessionID',
 331                                         -value => $sessionID,
 332                                         -expires => '');
 333         print $query->header(
 334                 -type => guesstype($template->output),
 335                 -cookie => $cookie
 336                 ), $template->output;
 337         exit;
 338 }
 339
 340
 341
 342
 343 sub checkpw {
 344
 345 # This should be modified to allow a selection of authentication schemes
 346 # (e.g. LDAP), as well as local authentication through the borrowers
 347 # tables passwd field
 348 #
 349         my ($dbh, $userid, $password) = @_;
 350         my $sth=$dbh->prepare("select password,cardnumber from borrowers where userid=?");
 351         $sth->execute($userid);
 352         if ($sth->rows) {
 353                 my ($md5password,$cardnumber) = $sth->fetchrow;
 354                 if (md5_base64($password) eq $md5password) {
 355                         return 1,$cardnumber;
 356                 }
 357         }
 358         my $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
 359         $sth->execute($userid);
 360         if ($sth->rows) {
 361                 my ($md5password) = $sth->fetchrow;
 362                 if (md5_base64($password) eq $md5password) {
 363                         return 1,$userid;
 364                 }
 365         }
 366         if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) {
 367                 # Koha superuser account
 368                 return 2;
 369         }
 370         if ($userid eq 'demo' && $password eq 'demo' && C4::Context->config('demo')) {
 371                 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
 372                 # some features won't be effective : modify systempref, modify MARC structure,
 373                 return 2;
 374         }
 375         return 0;
 376 }
 377
 378
 379
 380 sub getuserflags {
 381     my $cardnumber=shift;
 382     my $dbh=shift;
 383     my $userflags;
 384     my $sth=$dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
 385     $sth->execute($cardnumber);
 386     my ($flags) = $sth->fetchrow;
 387     $sth=$dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
 388     $sth->execute;
 389     while (my ($bit, $flag, $defaulton) = $sth->fetchrow) {
 390         if (($flags & (2**$bit)) || $defaulton) {
 391             $userflags->{$flag}=1;
 392         }
 393     }
 394     return $userflags;
 395 }
 396
 397 sub haspermission {
 398     my ($dbh, $userid, $flagsrequired) = @_;
 399     my $sth=$dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
 400     $sth->execute($userid);
 401     my ($cardnumber) = $sth->fetchrow;
 402     ($cardnumber) || ($cardnumber=$userid);
 403     my $flags=getuserflags($cardnumber,$dbh);
 404     my $configfile;
 405     if ($userid eq C4::Context->config('user')) {
 406         # Super User Account from /etc/koha.conf
 407         $flags->{'superlibrarian'}=1;
 408     }
 409     if ($userid eq 'demo' && C4::Context->config('demo')) {
 410         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
 411         $flags->{'superlibrarian'}=1;
 412     }
 413     return $flags if $flags->{superlibrarian};
 414     foreach (keys %$flagsrequired) {
 415         return $flags if $flags->{$_};
 416     }
 417     return 0;
 418 }
 419
 420 sub getborrowernumber {
 421     my ($userid) = @_;
 422     my $dbh = C4::Context->dbh;
 423     for my $field ('userid', 'cardnumber') {
 424       my $sth=$dbh->prepare
 425           ("select borrowernumber from borrowers where $field=?");
 426       $sth->execute($userid);
 427       if ($sth->rows) {
 428         my ($bnumber) = $sth->fetchrow;
 429         return $bnumber;
 430       }
 431     }
 432     return 0;
 433 }
 434
 435
 436
 437 END { }       # module clean-up code here (global destructor)
 438 1;
 439 __END__
 440
 441 =back
 442
 443 =head1 SEE ALSO
 444
 445 CGI(3)
 446
 447 C4::Output(3)
 448
 449 Digest::MD5(3)
 450
 451 =cut