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 use FindBin;
  29
  30
  31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
  32
  33 BEGIN {
  34         require Exporter;
  35     $VERSION = 3.07.00.049;     # set the version for version checking
  36         $debug = $ENV{DEBUG};
  37         @ISA    = qw(Exporter);
  38         @EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
  39 }
  40 my $context = C4::Context->new() or die 'C4::Context->new failed';
  41 my $defaultcasserver;
  42 my $casservers;
  43 my $yamlauthfile = "../C4/Auth_cas_servers.yaml";
  44
  45
  46 # If there's a configuration for multiple cas servers, then we get it
  47 if (multipleAuth()) {
  48     ($defaultcasserver, $casservers) = YAML::LoadFile(qq($FindBin::Bin/$yamlauthfile));
  49     $defaultcasserver = $defaultcasserver->{'default'};
  50 } else {
  51 # Else, we fall back to casServerUrl syspref
  52     $defaultcasserver = 'default';
  53     $casservers = { 'default' => C4::Context->preference('casServerUrl') };
  54 }
  55
  56 # Is there a configuration file for multiple cas servers?
  57 sub multipleAuth {
  58     return (-e qq($FindBin::Bin/$yamlauthfile));
  59 }
  60
  61 # Returns configured CAS servers' list if multiple authentication is enabled
  62 sub getMultipleAuth {
  63    return $casservers;
  64 }
  65
  66 # Logout from CAS
  67 sub logout_cas {
  68     my ($query) = @_;
  69     my $uri = C4::Context->preference('OPACBaseURL') . $query->script_name();
  70     my $casparam = $query->param('cas');
  71     # FIXME: This should be more generic and handle whatever parameters there might be
  72     $uri .= "?cas=" . $casparam if (defined $casparam);
  73     $casparam = $defaultcasserver if (not defined $casparam);
  74     my $cas = Authen::CAS::Client->new($casservers->{$casparam});
  75     print $query->redirect( $cas->logout_url($uri));
  76 }
  77
  78 # Login to CAS
  79 sub login_cas {
  80     my ($query) = @_;
  81     my $uri = C4::Context->preference('OPACBaseURL') . $query->script_name();
  82     my $casparam = $query->param('cas');
  83     # FIXME: This should be more generic and handle whatever parameters there might be
  84     $uri .= "?cas=" . $casparam if (defined $casparam);
  85     $casparam = $defaultcasserver if (not defined $casparam);
  86     my $cas = Authen::CAS::Client->new($casservers->{$casparam});
  87     print $query->redirect( $cas->login_url($uri));
  88 }
  89
  90 # Returns CAS login URL with callback to the requesting URL
  91 sub login_cas_url {
  92
  93     my ($query, $key) = @_;
  94     my $uri = C4::Context->preference('OPACBaseURL') . $query->script_name();
  95     my $casparam = $query->param('cas');
  96     # FIXME: This should be more generic and handle whatever parameters there might be
  97     $uri .= "?cas=" . $casparam if (defined $casparam);
  98     $casparam = $defaultcasserver if (not defined $casparam);
  99     $casparam = $key if (defined $key);
 100     my $cas = Authen::CAS::Client->new($casservers->{$casparam});
 101     return $cas->login_url($uri);
 102 }
 103
 104 # Checks for password correctness
 105 # In our case : is there a ticket, is it valid and does it match one of our users ?
 106 sub checkpw_cas {
 107     $debug and warn "checkpw_cas";
 108     my ($dbh, $ticket, $query) = @_;
 109     my $retnumber;
 110     my $uri = C4::Context->preference('OPACBaseURL') . $query->script_name();
 111     my $casparam = $query->param('cas');
 112     # FIXME: This should be more generic and handle whatever parameters there might be
 113     $uri .= "?cas=" . $casparam if (defined $casparam);
 114     $casparam = $defaultcasserver if (not defined $casparam);
 115     my $cas = Authen::CAS::Client->new($casservers->{$casparam});
 116
 117     # If we got a ticket
 118     if ($ticket) {
 119         $debug and warn "Got ticket : $ticket";
 120
 121         # We try to validate it
 122         my $val = $cas->service_validate($uri, $ticket );
 123
 124         # If it's valid
 125         if ( $val->is_success() ) {
 126
 127             my $userid = $val->user();
 128             $debug and warn "User CAS authenticated as: $userid";
 129
 130             # Does it match one of our users ?
 131             my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
 132             $sth->execute($userid);
 133             if ( $sth->rows ) {
 134                 $retnumber = $sth->fetchrow;
 135                 return ( 1, $retnumber, $userid );
 136             }
 137             $sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
 138             $sth->execute($userid);
 139             if ( $sth->rows ) {
 140                 $retnumber = $sth->fetchrow;
 141                 return ( 1, $retnumber, $userid );
 142             }
 143
 144             # If we reach this point, then the user is a valid CAS user, but not a Koha user
 145             $debug and warn "User $userid is not a valid Koha user";
 146
 147         } else {
 148             $debug and warn "Problem when validating ticket : $ticket";
 149             $debug and warn "Authen::CAS::Client::Response::Error: " . $val->error() if $val->is_error();
 150             $debug and warn "Authen::CAS::Client::Response::Failure: " . $val->message() if $val->is_failure();
 151             $debug and warn Data::Dumper::Dumper($@) if $val->is_error() or $val->is_failure();
 152             return 0;
 153         }
 154     }
 155     return 0;
 156 }
 157
 158 # Proxy CAS auth
 159 sub check_api_auth_cas {
 160     $debug and warn "check_api_auth_cas";
 161     my ($dbh, $PT, $query) = @_;
 162     my $retnumber;
 163     my $url = C4::Context->preference('OPACBaseURL') . $query->script_name();
 164
 165     my $casparam = $query->param('cas');
 166     $casparam = $defaultcasserver if (not defined $casparam);
 167     my $cas = Authen::CAS::Client->new($casservers->{$casparam});
 168
 169     # If we have a Proxy Ticket
 170     if ($PT) {
 171         my $r = $cas->proxy_validate( $url, $PT );
 172
 173         # If the PT is valid
 174         if ( $r->is_success ) {
 175
 176             # We've got a username !
 177             $debug and warn "User authenticated as: ", $r->user, "\n";
 178             $debug and warn "Proxied through:\n";
 179             $debug and warn "  $_\n" for $r->proxies;
 180
 181             my $userid = $r->user;
 182
 183             # Does it match one of our users ?
 184             my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
 185             $sth->execute($userid);
 186             if ( $sth->rows ) {
 187                 $retnumber = $sth->fetchrow;
 188                 return ( 1, $retnumber, $userid );
 189             }
 190             $sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
 191             return $r->user;
 192             $sth->execute($userid);
 193             if ( $sth->rows ) {
 194                 $retnumber = $sth->fetchrow;
 195                 return ( 1, $retnumber, $userid );
 196             }
 197
 198             # If we reach this point, then the user is a valid CAS user, but not a Koha user
 199             $debug and warn "User $userid is not a valid Koha user";
 200
 201         } else {
 202             $debug and warn "Proxy Ticket authentication failed";
 203             return 0;
 204         }
 205     }
 206     return 0;
 207 }
 208
 209
 210 1;
 211 __END__
 212
 213 =head1 NAME
 214
 215 C4::Auth - Authenticates Koha users
 216
 217 =head1 SYNOPSIS
 218
 219   use C4::Auth_with_cas;
 220
 221 =cut
 222
 223 =head1 SEE ALSO
 224
 225 CGI(3)
 226
 227 Authen::CAS::Client
 228
 229 =cut