line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Dancer::Plugin::Auth::CAS; |
2
|
|
|
|
|
|
|
$Dancer::Plugin::Auth::CAS::VERSION = '1.127'; |
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Dancer::Plugin::Auth::CAS - CAS sso authentication for Dancer |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=cut |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
809
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
10
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
1042
|
use Dancer ':syntax'; |
|
1
|
|
|
|
|
428506
|
|
|
1
|
|
|
|
|
8
|
|
13
|
1
|
|
|
1
|
|
1380
|
use Dancer::Plugin; |
|
1
|
|
|
|
|
1395
|
|
|
1
|
|
|
|
|
78
|
|
14
|
1
|
|
|
1
|
|
8
|
use Dancer::Response; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
15
|
1
|
|
|
1
|
|
6
|
use Dancer::Exception ':all'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
125
|
|
16
|
1
|
|
|
1
|
|
7
|
use HTTP::Headers; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
22
|
|
17
|
1
|
|
|
1
|
|
312
|
use Authen::CAS::Client; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
use Scalar::Util 'blessed'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
register_exception('InvalidConfig', message_pattern => "Invalid or missing configuration: %s"); |
23
|
|
|
|
|
|
|
register_exception('CasError', message_pattern => "Unable to auth with CAS backend: %s"); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my $settings = plugin_setting; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub _auth_cas { |
28
|
|
|
|
|
|
|
my (%options) = @_; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
my $base_url = $settings->{cas_url} // raise( InvalidConfig => "cas_url is unset" ); |
31
|
|
|
|
|
|
|
my $cas_version = $settings->{cas_version} || raise( InvalidConfig => "cas_version is unset"); |
32
|
|
|
|
|
|
|
my $cas_user_map = $options{cas_user_map} || $settings->{cas_user_map} || 'cas_user'; |
33
|
|
|
|
|
|
|
my $cas_denied_url = $options{cas_denied_path} || $settings->{cas_denied_path} || '/denied'; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# check supported versions |
36
|
|
|
|
|
|
|
unless( grep(/$cas_version/, qw( 2.0 1.0 )) ) { |
37
|
|
|
|
|
|
|
raise( InvalidConfig => "cas_version '$cas_version' not supported"); |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my $mapping = $settings->{cas_attr_map} || {}; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
my $ticket = $options{ticket}; |
43
|
|
|
|
|
|
|
my $params = request->params; |
44
|
|
|
|
|
|
|
unless( $ticket ) { |
45
|
|
|
|
|
|
|
my $tickets = $params->{ticket}; |
46
|
|
|
|
|
|
|
# For the case when application also uses 'ticket' parameters |
47
|
|
|
|
|
|
|
# we only remove the real cas service ticket |
48
|
|
|
|
|
|
|
if( ref($tickets) eq "ARRAY" ) { |
49
|
|
|
|
|
|
|
while( my ($index, $value) = each @$tickets ) { |
50
|
|
|
|
|
|
|
# The 'ST-' is specified in CAS-protocol |
51
|
|
|
|
|
|
|
if( $value =~ m/^ST\-/ ) { |
52
|
|
|
|
|
|
|
$ticket = delete $tickets->[$index]; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
} else { |
56
|
|
|
|
|
|
|
$ticket = delete $params->{ticket}; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
my $service = uri_for( request->path_info, $params ); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
my $cas = Authen::CAS::Client->new( $base_url ); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
my $user = session($cas_user_map); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
unless( $user ) { |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $response = Dancer::Response->new( status => 302 ); |
68
|
|
|
|
|
|
|
my $redirect_url; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
if( $ticket) { |
71
|
|
|
|
|
|
|
debug "Trying to validate via CAS '$cas_version' with ticket=$ticket"; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $r; |
74
|
|
|
|
|
|
|
if( $cas_version eq "1.0" ) { |
75
|
|
|
|
|
|
|
$r = $cas->validate( $service, $ticket ); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
elsif( $cas_version eq "2.0" ) { |
78
|
|
|
|
|
|
|
$r = $cas->service_validate( $service, $ticket ); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
else { |
81
|
|
|
|
|
|
|
raise( InvalidConfig => "cas_version '$cas_version' not supported"); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
if( $r->is_success ) { |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# Redirect to given path |
87
|
|
|
|
|
|
|
info "Authenticated as: ".$r->user; |
88
|
|
|
|
|
|
|
if( $cas_version eq "1.0" ) { |
89
|
|
|
|
|
|
|
session $cas_user_map => $r->user; |
90
|
|
|
|
|
|
|
} else { |
91
|
|
|
|
|
|
|
session $cas_user_map => _map_attributes( $r->doc, $mapping ); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
$redirect_url = $service; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
} elsif( $r->is_failure ) { |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# Redirect to denied |
98
|
|
|
|
|
|
|
debug "Failed to authenticate: ".$r->code." / ".$r->message; |
99
|
|
|
|
|
|
|
$redirect_url = uri_for( $cas_denied_url ); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
} else { |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# Raise hard error, backend has errors |
104
|
|
|
|
|
|
|
error "Unable to authenticate: ".$r->error; |
105
|
|
|
|
|
|
|
raise( CasError => $r->error ); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
} else { |
109
|
|
|
|
|
|
|
# Has no ticket, needs one |
110
|
|
|
|
|
|
|
debug "Redirecting to CAS: ".$cas->login_url( $service ); |
111
|
|
|
|
|
|
|
$redirect_url = $cas->login_url( $service ); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# General redir response |
115
|
|
|
|
|
|
|
$response->header( Location => $redirect_url ); |
116
|
|
|
|
|
|
|
halt( $response ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _map_attributes { |
122
|
|
|
|
|
|
|
my ( $doc, $mapping ) = @_; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
my $attrs = {}; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
my $result = $doc->find( '/cas:serviceResponse/cas:authenticationSuccess' ); |
127
|
|
|
|
|
|
|
if( $result ) { |
128
|
|
|
|
|
|
|
my $node = $result->get_node(1); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# extra all attributes |
131
|
|
|
|
|
|
|
my @attributes = $node->findnodes( "./cas:attributes/*" ); |
132
|
|
|
|
|
|
|
foreach my $a (@attributes) { |
133
|
|
|
|
|
|
|
my $name = (split(/:/, $a->nodeName, 2))[1]; |
134
|
|
|
|
|
|
|
my $val = $a->textContent; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
my $mapped_name = $mapping->{ $name } // $name; |
137
|
|
|
|
|
|
|
$attrs->{ $mapped_name } = $val; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
debug "Mapped attributes: ".to_dumper( $attrs ); |
142
|
|
|
|
|
|
|
return $attrs; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
register auth_cas => \&_auth_cas; |
147
|
|
|
|
|
|
|
register_plugin; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
1; # End of Dancer::Plugin::Auth::CAS |
150
|
|
|
|
|
|
|
__END__ |