C4/Auth_with_cas.pm

   1 package C4::Auth_with_cas;
   2
   3 # Copyright 2009 BibLibre SARL
   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
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 use warnings;
  22
  23 use C4::Debug;
  24 use C4::Context;
  25 use C4::Utils qw( :all );
  26 use Authen::CAS::Client;
  27 use CGI;
  28
  29
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
  31
  32 BEGIN {
  33         require Exporter;
  34         $VERSION = 3.03;        # set the version for version checking
  35         $debug = $ENV{DEBUG};
  36         @ISA    = qw(Exporter);
  37         @EXPORT = qw(checkpw_cas login_cas logout_cas login_cas_url);
  38 }
  39
  40
  41 my $context = C4::Context->new()        or die 'C4::Context->new failed';
  42 my $casserver = C4::Context->preference('casServerUrl');
  43
  44 # Logout from CAS
  45 sub logout_cas {
  46     my ($query) = @_;
  47     my $cas = Authen::CAS::Client->new($casserver);
  48     print $query->redirect($cas->logout_url(url => $ENV{'SCRIPT_URI'}));
  49 }
  50
  51 # Login to CAS
  52 sub login_cas {
  53     my ($query) = @_;
  54     my $cas = Authen::CAS::Client->new($casserver);
  55     print $query->redirect($cas->login_url($ENV{'SCRIPT_URI'}));
  56 }
  57
  58 # Returns CAS login URL with callback to the requesting URL
  59 sub login_cas_url {
  60     my $cas = Authen::CAS::Client->new($casserver);
  61     return $cas->login_url($ENV{'SCRIPT_URI'});
  62 }
  63
  64 # Checks for password correctness
  65 # In our case : is there a ticket, is it valid and does it match one of our users ?
  66 sub checkpw_cas {
  67     $debug and warn "checkpw_cas";
  68     my ($dbh, $ticket, $query) = @_;
  69     my $retnumber;
  70     my $cas = Authen::CAS::Client->new($casserver);
  71
  72     # If we got a ticket
  73     if ($ticket) {
  74         $debug and warn "Got ticket : $ticket";
  75
  76         # We try to validate it
  77         my $val = $cas->service_validate($ENV{'SCRIPT_URI'}, $ticket);
  78
  79         # If it's valid
  80         if( $val->is_success() ) {
  81
  82             my $userid = $val->user();
  83             $debug and warn "User CAS authenticated as: $userid";
  84
  85             # Does it match one of our users ?
  86             my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
  87             $sth->execute($userid);
  88             if ( $sth->rows ) {
  89                 $retnumber = $sth->fetchrow;
  90                 return (1, $retnumber, $userid);
  91             }
  92             $sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
  93             $sth->execute($userid);
  94             if ( $sth->rows ) {
  95                 $retnumber = $sth->fetchrow;
  96                 return (1, $retnumber, $userid);
  97             }
  98
  99             # If we reach this point, then the user is a valid CAS user, but not a Koha user
 100             $debug and warn "User $userid is not a valid Koha user";
 101
 102         } else {
 103             $debug and warn "Invalid session ticket : $ticket";
 104             return 0;
 105         }
 106     }
 107     return 0;
 108 }
 109
 110 1;
 111 __END__
 112
 113 =head1 NAME
 114
 115 C4::Auth - Authenticates Koha users
 116
 117 =head1 SYNOPSIS
 118
 119   use C4::Auth_with_cas;
 120
 121 =cut
 122
 123 =head1 SEE ALSO
 124
 125 CGI(3)
 126
 127 Authen::CAS::Client
 128
 129 =cut