DBRev 24.06.00.000: Start of a new release cycle
[koha.git] / 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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20 use strict;
21 use warnings;
22
23 use C4::Context;
24 use Koha::AuthUtils qw( get_script_name );
25 use Authen::CAS::Client;
26 use CGI qw ( -utf8 );
27 use YAML::XS;
28 use URI::Escape;
29
30 use Koha::Logger;
31
32 our (@ISA, @EXPORT_OK);
33
34 BEGIN {
35     require Exporter;
36     @ISA   = qw(Exporter);
37     @EXPORT_OK = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required multipleAuth getMultipleAuth);
38 }
39 my $defaultcasserver;
40 my $casservers;
41 my $yamlauthfile = C4::Context->config('intranetdir') . "/C4/Auth_cas_servers.yaml";
42
43
44 # If there's a configuration for multiple cas servers, then we get it
45 if (multipleAuth()) {
46     ($defaultcasserver, $casservers) = YAML::XS::LoadFile($yamlauthfile);
47     $defaultcasserver = $defaultcasserver->{'default'};
48 } else {
49 # Else, we fall back to casServerUrl syspref
50     $defaultcasserver = 'default';
51     $casservers = { 'default' => C4::Context->preference('casServerUrl') };
52 }
53
54 =head1 Subroutines
55
56 =cut
57
58 # Is there a configuration file for multiple cas servers?
59 sub multipleAuth {
60     return (-e qq($yamlauthfile));
61 }
62
63 # Returns configured CAS servers' list if multiple authentication is enabled
64 sub getMultipleAuth {
65    return $casservers; 
66 }
67
68 # Logout from CAS
69 sub logout_cas {
70     my ( $query, $type ) = @_;
71     my ( $cas,   $uri )  = _get_cas_and_service( $query, undef, $type );
72
73     # We don't want to keep triggering a logout, if we got here,
74     # the borrower is already logged out of Koha
75     $uri =~ s/\?logout\.x=1//;
76
77     my $logout_url = $cas->logout_url( url => $uri );
78     $logout_url =~ s/url=/service=/
79       if C4::Context->preference('casServerVersion') eq '3';
80
81     print $query->redirect($logout_url);
82 }
83
84
85 # Login to CAS
86 sub login_cas {
87     my ($query, $type) = @_;
88     my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
89     print $query->redirect( $cas->login_url($uri));
90 }
91
92 # Returns CAS login URL with callback to the requesting URL
93 sub login_cas_url {
94     my ( $query, $key, $type ) = @_;
95     my ( $cas, $uri ) = _get_cas_and_service( $query, $key, $type );
96     return $cas->login_url($uri);
97 }
98
99 # Checks for password correctness
100 # In our case : is there a ticket, is it valid and does it match one of our users ?
101 sub checkpw_cas {
102     my ($ticket, $query, $type) = @_;
103     my $retnumber;
104     my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
105
106     # If we got a ticket
107     if ($ticket) {
108
109         # We try to validate it
110         my $val = $cas->service_validate($uri, $ticket );
111
112         # If it's valid
113         if ( $val->is_success() ) {
114
115             my $userid = $val->user();
116
117             # we should store the CAS ticekt too, we need this for single logout https://apereo.github.io/cas/4.2.x/protocol/CAS-Protocol-Specification.html#233-single-logout
118
119             # Does it match one of our users ?
120             my $dbh    = C4::Context->dbh;
121             my $patron = Koha::Patrons->find( { userid => $userid } );
122             if ($patron) {
123                 return ( 1, $patron->cardnumber, $patron->userid, $ticket, $patron );
124             }
125             $patron = Koha::Patrons->find( { cardnumber => $userid } );
126             if ($patron) {
127                 return ( 1, $patron->cardnumber, $patron->userid, $ticket, $patron );
128             }
129
130             # If we reach this point, then the user is a valid CAS user, but not a Koha user
131             Koha::Logger->get->info("User $userid is not a valid Koha user");
132
133         } else {
134             my $logger = Koha::Logger->get;
135             $logger->debug("Problem when validating ticket : $ticket");
136             $logger->debug("Authen::CAS::Client::Response::Error: " . $val->error()) if $val->is_error();
137             $logger->debug("Authen::CAS::Client::Response::Failure: " . $val->message()) if $val->is_failure();
138             $logger->debug(Data::Dumper::Dumper($@)) if $val->is_error() or $val->is_failure();
139             return 0;
140         }
141     }
142     return 0;
143 }
144
145 # Proxy CAS auth
146 sub check_api_auth_cas {
147     my ($PT, $query, $type) = @_;
148     my $retnumber;
149     my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
150
151     # If we have a Proxy Ticket
152     if ($PT) {
153         my $r = $cas->proxy_validate( $uri, $PT );
154
155         # If the PT is valid
156         if ( $r->is_success ) {
157
158             # We've got a username !
159             my $userid = $r->user;
160
161             # we should store the CAS ticket too, we need this for single logout https://apereo.github.io/cas/4.2.x/protocol/CAS-Protocol-Specification.html#233-single-logout
162
163             # Does it match one of our users ?
164             my $dbh = C4::Context->dbh;
165             my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
166             $sth->execute($userid);
167             if ( $sth->rows ) {
168                 $retnumber = $sth->fetchrow;
169                 return ( 1, $retnumber, $userid, $PT );
170             }
171             $sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
172             return $r->user;
173             $sth->execute($userid);
174             if ( $sth->rows ) {
175                 $retnumber = $sth->fetchrow;
176                 return ( 1, $retnumber, $userid, $PT );
177             }
178
179             # If we reach this point, then the user is a valid CAS user, but not a Koha user
180             Koha::Logger->get->info("User $userid is not a valid Koha user");
181
182         } else {
183             Koha::Logger->get->debug("Proxy Ticket authentication failed");
184             return 0;
185         }
186     }
187     return 0;
188 }
189
190 # Get CAS handler and service URI
191 sub _get_cas_and_service {
192     my $query = shift;
193     my $key   = shift;    # optional
194     my $type  = shift;
195
196     my $uri = _url_with_get_params($query, $type);
197
198     my $casparam = $defaultcasserver;
199     $casparam = $query->param('cas') if defined $query->param('cas');
200     $casparam = $key if defined $key;
201     my $cas = Authen::CAS::Client->new( $casservers->{$casparam} );
202
203     return ( $cas, $uri );
204 }
205
206 # Get the current URL with parameters contained directly into URL (GET params)
207 # This method replaces $query->url() which will give both GET and POST params
208 sub _url_with_get_params {
209     my $query = shift;
210     my $type = shift;
211
212     my $uri_base_part =
213       ( $type eq 'opac' )
214       ? C4::Context->preference('OPACBaseURL')
215       : C4::Context->preference('staffClientBaseURL');
216     $uri_base_part .= get_script_name();
217
218     my $uri_params_part = '';
219     foreach my $param ( $query->url_param() ) {
220         # url_param() always returns parameters that were deleted by delete()
221         # This additional check ensure that parameter was not deleted.
222         my $uriPiece = $query->param($param);
223         if ($uriPiece) {
224             $uri_params_part .= '&' if $uri_params_part;
225             $uri_params_part .= $param . '=';
226             $uri_params_part .= URI::Escape::uri_escape( $uriPiece );
227         }
228     }
229     $uri_base_part .= '?' if $uri_params_part;
230
231     return $uri_base_part . $uri_params_part;
232 }
233
234 =head2 logout_if_required
235
236     If using CAS, this subroutine will trigger single-signout of the CAS server.
237
238 =cut
239
240 sub logout_if_required {
241     my ( $query ) = @_;
242     # Check we havent been hit by a logout call
243     my $xml = $query->param('logoutRequest');
244     return 0 unless $xml;
245
246     my $dom = XML::LibXML->load_xml(string => $xml);
247     my $ticket;
248     foreach my $node ($dom->findnodes('/samlp:LogoutRequest')){
249         # We got a cas single logout request from a cas server;
250         $ticket = $node->findvalue('./samlp:SessionIndex');
251     }
252
253     return 0 unless $ticket;
254
255     # We've been called as part of the single logout destroy the session associated with the cas ticket
256     my $params = C4::Auth::_get_session_params();
257     my $success = CGI::Session->find( $params->{dsn}, sub {delete_cas_session(@_, $ticket)}, $params->{dsn_args} );
258
259     print $query->header;
260     exit;
261 }
262
263 sub delete_cas_session {
264     my $session = shift;
265     my $ticket = shift;
266     if ($session->param('cas_ticket') && $session->param('cas_ticket') eq $ticket ) {
267         $session->delete;
268         $session->flush;
269     }
270 }
271
272 1;
273 __END__
274
275 =head1 NAME
276
277 C4::Auth - Authenticates Koha users
278
279 =head1 SYNOPSIS
280
281   use C4::Auth_with_cas;
282
283 =cut
284
285 =head1 SEE ALSO
286
287 CGI(3)
288
289 Authen::CAS::Client
290
291 =cut