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