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