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