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