Bug 7772 - reports/bor_issues_top.pl: we need to exit(0) for plack
[koha.git] / C4 / Auth_with_cas.pm
blobe00e3a4d6194b40285854f1d8af2df795f3ec0c5
1 package C4::Auth_with_cas;
3 # Copyright 2009 BibLibre SARL
5 # This file is part of Koha.
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.
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.
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.
20 use strict;
21 use warnings;
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;
31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
33 BEGIN {
34 require Exporter;
35 $VERSION = 3.03; # 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);
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";
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') };
56 # Is there a configuration file for multiple cas servers?
57 sub multipleAuth {
58 return (-e qq($FindBin::Bin/$yamlauthfile));
61 # Returns configured CAS servers' list if multiple authentication is enabled
62 sub getMultipleAuth {
63 return $casservers;
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));
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));
90 # Returns CAS login URL with callback to the requesting URL
91 sub login_cas_url {
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);
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});
117 # If we got a ticket
118 if ($ticket) {
119 $debug and warn "Got ticket : $ticket";
121 # We try to validate it
122 my $val = $cas->service_validate($uri, $ticket );
124 # If it's valid
125 if ( $val->is_success() ) {
127 my $userid = $val->user();
128 $debug and warn "User CAS authenticated as: $userid";
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 );
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 );
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";
147 } else {
148 $debug and warn "Invalid session ticket : $ticket";
149 return 0;
152 return 0;
155 # Proxy CAS auth
156 sub check_api_auth_cas {
157 $debug and warn "check_api_auth_cas";
158 my ($dbh, $PT, $query) = @_;
159 my $retnumber;
160 my $url = C4::Context->preference('OPACBaseURL') . $query->script_name();
162 my $casparam = $query->param('cas');
163 $casparam = $defaultcasserver if (not defined $casparam);
164 my $cas = Authen::CAS::Client->new($casservers->{$casparam});
166 # If we have a Proxy Ticket
167 if ($PT) {
168 my $r = $cas->proxy_validate( $url, $PT );
170 # If the PT is valid
171 if ( $r->is_success ) {
173 # We've got a username !
174 $debug and warn "User authenticated as: ", $r->user, "\n";
175 $debug and warn "Proxied through:\n";
176 $debug and warn " $_\n" for $r->proxies;
178 my $userid = $r->user;
180 # Does it match one of our users ?
181 my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
182 $sth->execute($userid);
183 if ( $sth->rows ) {
184 $retnumber = $sth->fetchrow;
185 return ( 1, $retnumber, $userid );
187 $sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
188 return $r->user;
189 $sth->execute($userid);
190 if ( $sth->rows ) {
191 $retnumber = $sth->fetchrow;
192 return ( 1, $retnumber, $userid );
195 # If we reach this point, then the user is a valid CAS user, but not a Koha user
196 $debug and warn "User $userid is not a valid Koha user";
198 } else {
199 $debug and warn "Proxy Ticket authentication failed";
200 return 0;
203 return 0;
208 __END__
210 =head1 NAME
212 C4::Auth - Authenticates Koha users
214 =head1 SYNOPSIS
216 use C4::Auth_with_cas;
218 =cut
220 =head1 SEE ALSO
222 CGI(3)
224 Authen::CAS::Client
226 =cut