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'},$in->{'query'});
 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                 $template->param(USER_INFO => \@bordat,
 128                 );
 129         }
 130         $template->param(
 131                              LibraryName => C4::Context->preference("LibraryName"),
 132                 );
 133         return ($template, $borrowernumber, $cookie);
 134 }
 135
 136
 137 =item checkauth
 138
 139   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 140
 141 Verifies that the user is authorized to run this script.  If
 142 the user is authorized, a (userid, cookie, session-id, flags)
 143 quadruple is returned.  If the user is not authorized but does
 144 not have the required privilege (see $flagsrequired below), it
 145 displays an error page and exits.  Otherwise, it displays the
 146 login page and exits.
 147
 148 Note that C<&checkauth> will return if and only if the user
 149 is authorized, so it should be called early on, before any
 150 unfinished operations (e.g., if you've opened a file, then
 151 C<&checkauth> won't close it for you).
 152
 153 C<$query> is the CGI object for the script calling C<&checkauth>.
 154
 155 The C<$noauth> argument is optional. If it is set, then no
 156 authorization is required for the script.
 157
 158 C<&checkauth> fetches user and session information from C<$query> and
 159 ensures that the user is authorized to run scripts that require
 160 authorization.
 161
 162 The C<$flagsrequired> argument specifies the required privileges
 163 the user must have if the username and password are correct.
 164 It should be specified as a reference-to-hash; keys in the hash
 165 should be the "flags" for the user, as specified in the Members
 166 intranet module. Any key specified must correspond to a "flag"
 167 in the userflags table. E.g., { circulate => 1 } would specify
 168 that the user must have the "circulate" privilege in order to
 169 proceed. To make sure that access control is correct, the
 170 C<$flagsrequired> parameter must be specified correctly.
 171
 172 The C<$type> argument specifies whether the template should be
 173 retrieved from the opac or intranet directory tree.  "opac" is
 174 assumed if it is not specified; however, if C<$type> is specified,
 175 "intranet" is assumed if it is not "opac".
 176
 177 If C<$query> does not have a valid session ID associated with it
 178 (i.e., the user has not logged in) or if the session has expired,
 179 C<&checkauth> presents the user with a login page (from the point of
 180 view of the original script, C<&checkauth> does not return). Once the
 181 user has authenticated, C<&checkauth> restarts the original script
 182 (this time, C<&checkauth> returns).
 183
 184 The login page is provided using a HTML::Template, which is set in the
 185 systempreferences table or at the top of this file. The variable C<$type>
 186 selects which template to use, either the opac or the intranet
 187 authentification template.
 188
 189 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 190 cookie should be sent back to the browser; it verifies that the user
 191 has authenticated.
 192
 193 =cut
 194
 195
 196
 197 sub checkauth {
 198         my $query=shift;
 199         # $authnotrequired will be set for scripts which will run without authentication
 200         my $authnotrequired = shift;
 201         my $flagsrequired = shift;
 202         my $type = shift;
 203         $type = 'opac' unless $type;
 204
 205         my $dbh = C4::Context->dbh;
 206         my $timeout = C4::Context->preference('timeout');
 207         $timeout = 600 unless $timeout;
 208
 209         my $template_name;
 210         if ($type eq 'opac') {
 211                 $template_name = "opac-auth.tmpl";
 212         } else {
 213                 $template_name = "auth.tmpl";
 214         }
 215
 216         # state variables
 217         my $loggedin = 0;
 218         my %info;
 219         my ($userid, $cookie, $sessionID, $flags);
 220         my $logout = $query->param('logout.x');
 221         if ($userid = $ENV{'REMOTE_USER'}) {
 222                 # Using Basic Authentication, no cookies required
 223                 $cookie=$query->cookie(-name => 'sessionID',
 224                                 -value => '',
 225                                 -expires => '');
 226                 $loggedin = 1;
 227         } elsif ($sessionID=$query->cookie('sessionID')) {
 228                 my ($ip , $lasttime);
 229                 ($userid, $ip, $lasttime) = $dbh->selectrow_array(
 230                                 "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
 231                                                                 undef, $sessionID);
 232                 if ($logout) {
 233                 # voluntary logout the user
 234                 $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 235                 $sessionID = undef;
 236                 $userid = undef;
 237                 open L, ">>/tmp/sessionlog";
 238                 my $time=localtime(time());
 239                 printf L "%20s from %16s logged out at %30s (manually).\n", $userid, $ip, $time;
 240                 close L;
 241                 }
 242                 if ($userid) {
 243                 if ($lasttime<time()-$timeout) {
 244                         # timed logout
 245                         $info{'timed_out'} = 1;
 246                         $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 247                         $userid = undef;
 248                         $sessionID = undef;
 249                         open L, ">>/tmp/sessionlog";
 250                         my $time=localtime(time());
 251                         printf L "%20s from %16s logged out at %30s (inactivity).\n", $userid, $ip, $time;
 252                         close L;
 253                 } elsif ($ip ne $ENV{'REMOTE_ADDR'}) {
 254                         # Different ip than originally logged in from
 255                         $info{'oldip'} = $ip;
 256                         $info{'newip'} = $ENV{'REMOTE_ADDR'};
 257                         $info{'different_ip'} = 1;
 258                         $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 259                         $sessionID = undef;
 260                         $userid = undef;
 261                         open L, ">>/tmp/sessionlog";
 262                         my $time=localtime(time());
 263                         printf L "%20s from logged out at %30s (ip changed from %16s to %16s).\n", $userid, $time, $ip, $info{'newip'};
 264                         close L;
 265                 } else {
 266                         $cookie=$query->cookie(-name => 'sessionID',
 267                                         -value => $sessionID,
 268                                         -expires => '');
 269                         $dbh->do("UPDATE sessions SET lasttime=? WHERE sessionID=?",
 270                                 undef, (time(), $sessionID));
 271                         $flags = haspermission($dbh, $userid, $flagsrequired);
 272                         if ($flags) {
 273                         $loggedin = 1;
 274                         } else {
 275                         $info{'nopermission'} = 1;
 276                         }
 277                 }
 278                 }
 279         }
 280         unless ($userid) {
 281                 $sessionID=int(rand()*100000).'-'.time();
 282                 $userid=$query->param('userid');
 283                 my $password=$query->param('password');
 284                 my ($return, $cardnumber) = checkpw($dbh,$userid,$password);
 285                 if ($return) {
 286                 $dbh->do("DELETE FROM sessions WHERE sessionID=? AND userid=?",
 287                         undef, ($sessionID, $userid));
 288                 $dbh->do("INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
 289                         undef, ($sessionID, $userid, $ENV{'REMOTE_ADDR'}, time()));
 290                 open L, ">>/tmp/sessionlog";
 291                 my $time=localtime(time());
 292                 printf L "%20s from %16s logged in  at %30s.\n", $userid, $ENV{'REMOTE_ADDR'}, $time;
 293                 close L;
 294                 $cookie=$query->cookie(-name => 'sessionID',
 295                                         -value => $sessionID,
 296                                         -expires => '');
 297                 if ($flags = haspermission($dbh, $userid, $flagsrequired)) {
 298                         $loggedin = 1;
 299                 } else {
 300                         $info{'nopermission'} = 1;
 301                 }
 302                 } else {
 303                 if ($userid) {
 304                         $info{'invalid_username_or_password'} = 1;
 305                 }
 306                 }
 307         }
 308         my $insecure = C4::Context->boolean_preference('insecure');
 309         # finished authentification, now respond
 310         if ($loggedin || $authnotrequired || (defined($insecure) && $insecure)) {
 311                 # successful login
 312                 unless ($cookie) {
 313                 $cookie=$query->cookie(-name => 'sessionID',
 314                                         -value => '',
 315                                         -expires => '');
 316                 }
 317                 return ($userid, $cookie, $sessionID, $flags);
 318         }
 319         # else we have a problem...
 320         # get the inputs from the incoming query
 321         my @inputs =();
 322         foreach my $name (param $query) {
 323                 (next) if ($name eq 'userid' || $name eq 'password');
 324                 my $value = $query->param($name);
 325                 push @inputs, {name => $name , value => $value};
 326         }
 327
 328         my $template = gettemplate($template_name, $type,$query);
 329         $template->param(INPUTS => \@inputs);
 330         $template->param(loginprompt => 1) unless $info{'nopermission'};
 331
 332         my $self_url = $query->url(-absolute => 1);
 333         $template->param(url => $self_url);
 334         $template->param(\%info);
 335         $cookie=$query->cookie(-name => 'sessionID',
 336                                         -value => $sessionID,
 337                                         -expires => '');
 338         print $query->header(
 339                 -type => guesstype($template->output),
 340                 -cookie => $cookie
 341                 ), $template->output;
 342         exit;
 343 }
 344
 345
 346
 347
 348 sub checkpw {
 349
 350 # This should be modified to allow a selection of authentication schemes
 351 # (e.g. LDAP), as well as local authentication through the borrowers
 352 # tables passwd field
 353 #
 354         my ($dbh, $userid, $password) = @_;
 355 # LDAP
 356 #       my $sth=$dbh->prepare("select value from systempreferences where variable=?");
 357 #       $sth->execute("ldapserver");
 358         my $ldapserver = C4::Context->preferences('ldapserver');
 359         if ($ldapserver) {
 360                 my $ldapinfos = C4::Context->preferences('ldapinfos');
 361                 my %bindargs;
 362                 my $name  = "uid=$userid, $ldapinfos";
 363                 my $db = Net::LDAP->new( $ldapserver );
 364                 $bindargs{dn}=$name;
 365                 $bindargs{password}=$password;
 366                 my $res =$db->bind(%bindargs);
 367                 if($res->code) {
 368                 # auth refused
 369                         return 0;
 370                 } else {
 371                         #get the cardnumber
 372                         my $sth=$dbh->prepare("select cardnumber from borrowers where userid=?");
 373                         $sth->execute($userid);
 374                         if ($sth->rows) {
 375                                 my $cardnumber = $sth->fetchrow;
 376                                 #we have the cardnumber
 377                                 return 1,$cardnumber;
 378                         } else {
 379                                 # retrieve the LDAP informations & create the user
 380                                 my $borrower = $db->search(base => %bindargs,
 381                                                         filter => "(sn=$userid)",
 382                                                         );
 383                                  my $href = $borrower->as_struct;
 384                                 # get an array of the DN names
 385                                 my @arrayOfDNs  = keys %$href;        # use DN hashes
 386                                 # process each DN using it as a key
 387                                 my %borrower;
 388                                 foreach ( @arrayOfDNs ) {
 389                                         print $_, "\n";
 390                                         my $valref = $$href{$_};
 391                                         # get an array of the attribute names
 392                                         # passed for this one DN.
 393                                         my @arrayOfAttrs = sort keys %$valref; #use Attr hashes
 394                                         my $attrName;
 395                                         foreach $attrName (@arrayOfAttrs) {
 396                                                 # skip any binary data: yuck!
 397                                                 next if ( $attrName =~ /;binary$/ );
 398                                                 # get the attribute value (pointer) using the
 399                                                 # attribute name as the hash
 400                                                 my $attrVal =  @$valref{$attrName};
 401                                                 print "\t $attrName: @$attrVal \n";
 402                                                 $borrower{$attrName}= @$attrVal;
 403                                         }
 404                                 }
 405                                 # create the user in Koha DB
 406                                 newmember(%borrower);
 407
 408                         }
 409                         if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) {
 410                                 # Koha superuser account
 411                                 return 2;
 412                         }
 413                 }
 414         }
 415 # INTERNAL AUTH
 416         my $sth=$dbh->prepare("select password,cardnumber from borrowers where userid=?");
 417         $sth->execute($userid);
 418         if ($sth->rows) {
 419                 my ($md5password,$cardnumber) = $sth->fetchrow;
 420                 if (md5_base64($password) eq $md5password) {
 421                         return 1,$cardnumber;
 422                 }
 423         }
 424         my $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
 425         $sth->execute($userid);
 426         if ($sth->rows) {
 427                 my ($md5password) = $sth->fetchrow;
 428                 if (md5_base64($password) eq $md5password) {
 429                         return 1,$userid;
 430                 }
 431         }
 432         if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) {
 433                 # Koha superuser account
 434                 return 2;
 435         }
 436         if ($userid eq 'demo' && $password eq 'demo' && C4::Context->config('demo')) {
 437                 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
 438                 # some features won't be effective : modify systempref, modify MARC structure,
 439                 return 2;
 440         }
 441         return 0;
 442 }
 443
 444 sub getuserflags {
 445     my $cardnumber=shift;
 446     my $dbh=shift;
 447     my $userflags;
 448     my $sth=$dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
 449     $sth->execute($cardnumber);
 450     my ($flags) = $sth->fetchrow;
 451     $sth=$dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
 452     $sth->execute;
 453     while (my ($bit, $flag, $defaulton) = $sth->fetchrow) {
 454         if (($flags & (2**$bit)) || $defaulton) {
 455             $userflags->{$flag}=1;
 456         }
 457     }
 458     return $userflags;
 459 }
 460
 461 sub haspermission {
 462     my ($dbh, $userid, $flagsrequired) = @_;
 463     my $sth=$dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
 464     $sth->execute($userid);
 465     my ($cardnumber) = $sth->fetchrow;
 466     ($cardnumber) || ($cardnumber=$userid);
 467     my $flags=getuserflags($cardnumber,$dbh);
 468     my $configfile;
 469     if ($userid eq C4::Context->config('user')) {
 470         # Super User Account from /etc/koha.conf
 471         $flags->{'superlibrarian'}=1;
 472      }
 473      if ($userid eq 'demo' && C4::Context->config('demo')) {
 474         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
 475         $flags->{'superlibrarian'}=1;
 476     }
 477     return $flags if $flags->{superlibrarian};
 478     foreach (keys %$flagsrequired) {
 479         return $flags if $flags->{$_};
 480     }
 481     return 0;
 482 }
 483
 484 sub getborrowernumber {
 485     my ($userid) = @_;
 486     my $dbh = C4::Context->dbh;
 487     for my $field ('userid', 'cardnumber') {
 488       my $sth=$dbh->prepare
 489           ("select borrowernumber from borrowers where $field=?");
 490       $sth->execute($userid);
 491       if ($sth->rows) {
 492         my ($bnumber) = $sth->fetchrow;
 493         return $bnumber;
 494       }
 495     }
 496     return 0;
 497 }
 498
 499 END { }       # module clean-up code here (global destructor)
 500 1;
 501 __END__
 502
 503 =back
 504
 505 =head1 SEE ALSO
 506
 507 CGI(3)
 508
 509 C4::Output(3)
 510
 511 Digest::MD5(3)
 512
 513 =cut