C4/Auth.pm

   1 package C4::Auth;
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22 use Digest::MD5 qw(md5_base64);
  23
  24
  25 require Exporter;
  26 use C4::Context;
  27
  28 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  29
  30 # set the version for version checking
  31 $VERSION = 0.01;
  32
  33 =head1 NAME
  34
  35 C4::Auth - Authenticates Koha users
  36
  37 =head1 SYNOPSIS
  38
  39   use CGI;
  40   use C4::Auth;
  41
  42   $query = new CGI;
  43   ($userid, $cookie, $sessionID) = &checkauth($query);
  44
  45 =head1 DESCRIPTION
  46
  47 This module provides authentication for Koha users.
  48
  49 =head1 FUNCTIONS
  50
  51 =over 2
  52
  53 =cut
  54
  55 @ISA = qw(Exporter);
  56 @EXPORT = qw(
  57              &checkauth
  58 );
  59
  60 =item checkauth
  61
  62   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth);
  63
  64 Verifies that the user is authorized to run this script. Note that
  65 C<&checkauth> will return if and only if the user is authorized, so it
  66 should be called early on, before any unfinished operations (i.e., if
  67 you've opened a file, then C<&checkauth> won't close it for you).
  68
  69 C<$query> is the CGI object for the script calling C<&checkauth>.
  70
  71 The C<$noauth> argument is optional. If it is set, then no
  72 authorization is required for the script.
  73
  74 C<&checkauth> fetches user and session information from C<$query> and
  75 ensures that the user is authorized to run scripts that require
  76 authorization.
  77
  78 If C<$query> does not have a valid session ID associated with it
  79 (i.e., the user has not logged in) or if the session has expired,
  80 C<&checkauth> presents the user with a login page (from the point of
  81 view of the original script, C<&checkauth> does not return). Once the
  82 user has authenticated, C<&checkauth> restarts the original script
  83 (this time, C<&checkauth> returns).
  84
  85 C<&checkauth> returns a user ID, a cookie, and a session ID. The
  86 cookie should be sent back to the browser; it verifies that the user
  87 has authenticated.
  88
  89 =cut
  90 #'
  91 # FIXME - (Or rather, proofreadme)
  92 # As I understand it, the 'sessionqueries' table in the Koha database
  93 # is supposed to save state while the user authenticates. If
  94 # (re-)authentication is required, &checkauth saves the browser's
  95 # original call to a new entry in sessionqueries, then presents a form
  96 # for the user to authenticate. Once the user has authenticated
  97 # visself, &checkauth retrieves the stored information from
  98 # sessionqueries and allows the original request to proceed.
  99 #
 100 # One problem, however, is that sessionqueries only stores the URL,
 101 # not the various values passed along from an HTML form. Thus, if the
 102 # request came from a form and contains information on stuff to change
 103 # (e.g., modify the contents of a virtual bookshelf), but the session
 104 # has timed out, then when &checkauth finally allows the request to
 105 # proceed, it will not contain the user's modifications. This is bad.
 106 #
 107 # Another problem is that entries in sessionqueries are supposed to be
 108 # temporary, but there's no mechanism for removing them in case of
 109 # error (e.g., the user can't remember vis password and walks away, or
 110 # if the user's machine crashes in the middle of authentication).
 111 #
 112 # Perhaps a better implementation would be to use $query->param to get
 113 # the parameter with which the original script was invoked, and pass
 114 # that along through all of the authentication pages. That way, all of
 115 # the pertinent information would be preserved, and the sessionqueries
 116 # table could be removed.
 117
 118 sub checkauth {
 119     my $query=shift;
 120     # $authnotrequired will be set for scripts which will run without authentication
 121     my $authnotrequired=shift;
 122     if (my $userid=$ENV{'REMOTE_USERNAME'}) {
 123         # Using Basic Authentication, no cookies required
 124         my $cookie=$query->cookie(-name => 'sessionID',
 125                                   -value => '',
 126                                   -expires => '+1y');
 127         return ($userid, $cookie, '');
 128     }
 129
 130     # Get session ID from cookie.
 131     my $sessionID=$query->cookie('sessionID');
 132         # FIXME - Error-checking: if the user isn't allowing cookies,
 133         # $sessionID will be undefined. Don't confuse this with an
 134         # expired cookie.
 135
 136     my $message='';
 137
 138     # Make sure the session ID is (still) good.
 139     my $dbh = C4::Context->dbh;
 140     my $sth=$dbh->prepare("select userid,ip,lasttime from sessions where sessionid=?");
 141     $sth->execute($sessionID);
 142     if ($sth->rows) {
 143         my ($userid, $ip, $lasttime) = $sth->fetchrow;
 144         # FIXME - Back door for tonnensen
 145         if ($lasttime<time()-45 && $userid ne 'tonnesen') {
 146             # This session has been inactive for >45 seconds, and
 147             # doesn't belong to user tonnensen. It has expired.
 148             $message="You have been logged out due to inactivity.";
 149
 150             # Remove this session ID from the list of active sessions.
 151             # FIXME - Ought to have a cron job clean this up as well.
 152             my $sti=$dbh->prepare("delete from sessions where sessionID=?");
 153             $sti->execute($sessionID);
 154
 155             # Add an entry to sessionqueries, so that we can restart
 156             # the script once the user has authenticated.
 157             my $scriptname=$ENV{'SCRIPT_NAME'}; # FIXME - Unused
 158             my $selfurl=$query->self_url();
 159             $sti=$dbh->prepare("insert into sessionqueries (sessionID, userid, value) values (?, ?, ?)");
 160             $sti->execute($sessionID, $userid, $selfurl);
 161
 162             # Log the fact that someone tried to use an expired session ID.
 163             # FIXME - Ought to have a better logging mechanism,
 164             # ideally some wrapper that logs either to a
 165             # user-specified file, or to syslog, as determined by
 166             # either an entry in /etc/koha.conf, or a system
 167             # preference.
 168             open L, ">>/tmp/sessionlog";
 169             my $time=localtime(time());
 170             printf L "%20s from %16s logged out at %30s (inactivity).\n", $userid, $ip, $time;
 171             close L;
 172         } elsif ($ip ne $ENV{'REMOTE_ADDR'}) {
 173             # This session is coming from an IP address other than the
 174             # one where it was set. The user might be doing something
 175             # naughty.
 176             my $newip=$ENV{'REMOTE_ADDR'};
 177
 178             $message="ERROR ERROR ERROR ERROR<br>Attempt to re-use a cookie from a different ip address.<br>(authenticated from $ip, this request from $newip)";
 179         } else {
 180             # This appears to be a valid session. Update the time
 181             # stamp on it and return.
 182             my $cookie=$query->cookie(-name => 'sessionID',
 183                                       -value => $sessionID,
 184                                       -expires => '+1y');
 185             my $sti=$dbh->prepare("update sessions set lasttime=? where sessionID=?");
 186             $sti->execute(time(), $sessionID);
 187             return ($userid, $cookie, $sessionID);
 188         }
 189     }
 190
 191     # If we get this far, it's because we haven't received a cookie
 192     # with a valid session ID. Need to start a new session and set a
 193     # new cookie.
 194
 195     if ($authnotrequired) {
 196         # This script doesn't require the user to be logged in. Return
 197         # just the cookie, without user ID or session ID information.
 198         my $cookie=$query->cookie(-name => 'sessionID',
 199                                   -value => '',
 200                                   -expires => '+1y');
 201         return('', $cookie, '');
 202     } else {
 203         # This script requires authorization. Assume that we were
 204         # given user and password information; generate a new session.
 205
 206         # Generate a new session ID.
 207         ($sessionID) || ($sessionID=int(rand()*100000).'-'.time());
 208         my $userid=$query->param('userid');
 209         my $password=$query->param('password');
 210         if (checkpw($dbh, $userid, $password)) {
 211             # The given password is valid
 212
 213             # Delete any old copies of this session.
 214             my $sti=$dbh->prepare("delete from sessions where sessionID=? and userid=?");
 215             $sti->execute($sessionID, $userid);
 216
 217             # Add this new session to the 'sessions' table.
 218             $sti=$dbh->prepare("insert into sessions (sessionID, userid, ip,lasttime) values (?, ?, ?, ?)");
 219             $sti->execute($sessionID, $userid, $ENV{'REMOTE_ADDR'}, time());
 220
 221             # See if there's an entry for this session ID and user in
 222             # the 'sessionqueries' table. If so, then use that entry
 223             # to generate an HTTP redirect that'll take the user to
 224             # where ve wanted to go in the first place.
 225             $sti=$dbh->prepare("select value from sessionqueries where sessionID=? and userid=?");
 226                         # FIXME - There is no sessionqueries.value
 227             $sti->execute($sessionID, $userid);
 228             if ($sti->rows) {
 229                 my $stj=$dbh->prepare("delete from sessionqueries where sessionID=?");
 230                 $stj->execute($sessionID);
 231                 my ($selfurl) = $sti->fetchrow;
 232                 print $query->redirect($selfurl);
 233                 exit;
 234             }
 235             open L, ">>/tmp/sessionlog";
 236             my $time=localtime(time());
 237             printf L "%20s from %16s logged in  at %30s.\n", $userid, $ENV{'REMOTE_ADDR'}, $time;
 238             close L;
 239             my $cookie=$query->cookie(-name => 'sessionID',
 240                                       -value => $sessionID,
 241                                       -expires => '+1y');
 242             return ($userid, $cookie, $sessionID);
 243         } else {
 244             # Either we weren't given a user id and password, or else
 245             # the password was invalid.
 246
 247             if ($userid) {
 248                 $message="Invalid userid or password entered.";
 249             }
 250             my $parameters;
 251             foreach (param $query) {
 252                 $parameters->{$_}=$query->{$_};
 253             }
 254             my $cookie=$query->cookie(-name => 'sessionID',
 255                                       -value => $sessionID,
 256                                       -expires => '+1y');
 257             print $query->header(-cookie=>$cookie);
 258             print qq|
 259 <html>
 260 <body background=/images/kohaback.jpg>
 261 <center>
 262 <h2>$message</h2>
 263
 264 <form method=post>
 265 <table border=0 cellpadding=10 cellspacing=0 width=60%>
 266     <tr><td align=center valign=top>
 267
 268     <table border=0 bgcolor=#dddddd cellpadding=10 cellspacing=0>
 269     <tr><th colspan=2 background=/images/background-mem.gif><font size=+2>Koha Login</font></th></tr>
 270     <tr><td>Name:</td><td><input name=userid></td></tr>
 271     <tr><td>Password:</td><td><input type=password name=password></td></tr>
 272     <tr><td colspan=2 align=center><input type=submit value=login></td></tr>
 273     </table>
 274
 275     </td><td align=center valign=top>
 276
 277     <table border=0 bgcolor=#dddddd cellpadding=10 cellspacing=0>
 278     <tr><th background=/images/background-mem.gif><font size=+2>Demo Information</font></th></tr>
 279     <td>
 280     Log in as librarian/koha or patron/koha.  The timeout is set to 40 seconds of
 281     inactivity for the purposes of this demo.  You can navigate to the Circulation
 282     or Acquisitions modules and you should see an indicator in the upper left of
 283     the screen saying who you are logged in as.  If you want to try it out with
 284     a longer timout period, log in as tonnesen/koha and there will be no
 285     timeout period.
 286     <p>
 287     You can also log in using a patron cardnumber.   Try V10000008 and
 288     V1000002X with password koha.
 289     </td>
 290     </tr>
 291     </table>
 292     </td></tr>
 293 </table>
 294 </form>
 295 </body>
 296 </html>
 297 |;
 298             exit;
 299         }
 300     }
 301 }
 302
 303 # checkpw
 304 # Takes a database handle, user ID, and password, and verifies that
 305 # the password is good. The user ID may be either a user ID or a card
 306 # number.
 307 # Returns 1 if the password is good, or 0 otherwise.
 308 sub checkpw {
 309
 310 # This should be modified to allow a select of authentication schemes (ie LDAP)
 311 # as well as local authentication through the borrowers tables passwd field
 312 #
 313     my ($dbh, $userid, $password) = @_;
 314     my $sth;
 315
 316     # Try the user ID.
 317     $sth = $dbh->prepare("select password from borrowers where userid=?");
 318     $sth->execute($userid);
 319     if ($sth->rows) {
 320         my ($md5password) = $sth->fetchrow;
 321         if (md5_base64($password) eq $md5password) {
 322             return 1;           # The password matches
 323         }
 324     }
 325
 326     # Try the card number.
 327     $sth = $dbh->prepare("select password from borrowers where cardnumber=?");
 328     $sth->execute($userid);
 329     if ($sth->rows) {
 330         my ($md5password) = $sth->fetchrow;
 331         if (md5_base64($password) eq $md5password) {
 332             return 1;           # The password matches
 333         }
 334     }
 335     return 0;           # Either there's no such user, or the password
 336                         # doesn't match.
 337 }
 338
 339
 340 END { }       # module clean-up code here (global destructor)
 341
 342 1;
 343 __END__
 344 =back
 345
 346 =head1 SEE ALSO
 347
 348 L<CGI(3)|CGI>
 349
 350 L<Digest::MD5(3)|Digest::MD5>
 351
 352 =cut