File Coverage

blib/lib/Net/SAML2/Binding/SOAP.pm
Criterion Covered Total %
statement 66 87 75.8
branch 9 20 45.0
condition n/a
subroutine 16 19 84.2
pod 5 5 100.0
total 96 131 73.2


line stmt bran cond sub pod time code
1             package Net::SAML2::Binding::SOAP;
2 25     25   188 use Moose;
  25         64  
  25         206  
3              
4             our $VERSION = '0.72'; # TRIAL VERSION
5              
6 25     25   159907 use MooseX::Types::URI qw/ Uri /;
  25         58  
  25         280  
7 25     25   54885 use Net::SAML2::XML::Util qw/ no_comments /;
  25         72  
  25         1636  
8 25     25   186 use Carp qw(croak);
  25         61  
  25         1083  
9 25     25   146 use Try::Tiny;
  25         50  
  25         1329  
10              
11             with 'Net::SAML2::Role::VerifyXML';
12              
13             # ABSTRACT: SOAP binding for SAML
14              
15              
16 25     25   163 use Net::SAML2::XML::Sig;
  25         57  
  25         210  
17 25     25   1042 use XML::LibXML;
  25         59  
  25         119  
18 25     25   18266 use LWP::UserAgent;
  25         869104  
  25         939  
19 25     25   10488 use HTTP::Request::Common;
  25         47357  
  25         25565  
20              
21              
22             has 'ua' => (
23             isa => 'Object',
24             is => 'ro',
25             lazy => 1,
26             builder => 'build_user_agent',
27             );
28              
29              
30             sub build_user_agent {
31 0     0 1 0 return LWP::UserAgent->new();
32             }
33              
34             has 'url' => (isa => Uri, is => 'ro', required => 1, coerce => 1);
35             has 'key' => (isa => 'Str', is => 'ro', required => 1);
36             has 'cert' => (isa => 'Str', is => 'ro', required => 1);
37             has 'idp_cert' => (isa => 'ArrayRef[Str]', is => 'ro', required => 1, predicate => 'has_idp_cert');
38             has 'cacert' => (
39             is => 'ro',
40             isa => 'Str',
41             required => 0,
42             predicate => 'has_cacert'
43             );
44             has 'anchors' => (
45             is => 'ro',
46             isa => 'HashRef',
47             required => 0,
48             predicate => 'has_anchors'
49             );
50              
51             has verify => (
52             is => 'ro',
53             isa => 'HashRef',
54             predicate => 'has_verify',
55             );
56              
57             # BUILDARGS
58              
59             # Earlier versions expected the idp_cert to be a string. However, metadata
60             # can include multiple signing certificates so the $idp->cert is now
61             # expected to be an arrayref to the certificates. To avoid breaking existing
62             # applications this changes the the cert to an arrayref if it is not
63             # already an array ref.
64              
65             around BUILDARGS => sub {
66             my $orig = shift;
67             my $self = shift;
68              
69             my %params = @_;
70             if ($params{idp_cert} && ref($params{idp_cert}) ne 'ARRAY') {
71             $params{idp_cert} = [$params{idp_cert}];
72             }
73              
74             return $self->$orig(%params);
75             };
76              
77              
78             sub request {
79 0     0 1 0 my ($self, $message) = @_;
80 0         0 my $request = $self->create_soap_envelope($message);
81              
82 0         0 my $soap_action = 'http://www.oasis-open.org/committees/security';
83              
84 0         0 my $req = POST $self->url, Content => $request;
85             # SOAP actions should be wrapped in double quotes:
86             # https://www.w3.org/TR/2000/NOTE-SOAP-20000508/#_Toc478383528
87 0         0 $req->header('SOAPAction' => sprintf('"%s"', $soap_action));
88 0         0 $req->header('Content-Type' => 'text/xml');
89 0         0 $req->header('Content-Length' => length $request);
90              
91 0         0 my $res = $self->ua->request($req);
92              
93 0 0       0 if (!$res->is_success) {
94 0         0 croak(
95             sprintf(
96             "Unable to perform request: %s (%s)",
97             $res->message, $res->code
98             )
99             );
100             }
101              
102 0         0 return $self->handle_response($res->decoded_content);
103              
104             }
105              
106              
107             sub handle_response {
108 5     5 1 1359 my ($self, $response) = @_;
109              
110 5         11 my $saml = _get_saml_from_soap($response);
111 5         166 my @errors;
112 5         7 foreach my $cert (@{$self->idp_cert}) {
  5         153  
113             my $success = try {
114             $self->verify_xml(
115             $saml,
116             no_xml_declaration => 1,
117             cert_text => $cert,
118             cacert => $self->cacert,
119             anchors => $self->anchors,
120             $self->has_verify ? (
121             ns => { 'artifact' => $self->verify->{ns} },
122             id_attr => '/artifact:' . $self->verify->{attr_id},
123 6 50   6   356 ) : (),
124             );
125 4         13 return 1;
126             }
127 6     2   43 catch { push (@errors, $_); return 0; };
  2         2370  
  2         8  
128              
129 6 100       87 return $saml if $success;
130             }
131              
132 1 50       5 if (@errors) {
133 1         9 croak "Unable to verify XML with the given certificates: "
134             . join(", ", @errors);
135             }
136             }
137              
138              
139             sub handle_request {
140 1     1 1 615 my ($self, $request) = @_;
141              
142 1         4 my $saml = _get_saml_from_soap($request);
143 1         55 my @errors;
144 1 50       5 if (defined $saml) {
145 1         2 foreach my $cert (@{$self->idp_cert}) {
  1         36  
146             my $success = try {
147 1     1   73 $self->verify_xml(
148             $saml,
149             cert_text => $cert,
150             cacert => $self->cacert
151             );
152 1         4 return 1;
153             }
154 1     0   15 catch { push (@errors, $_); return 0; };
  0         0  
  0         0  
155 1 50       19 return $saml if $success;
156             }
157              
158 0 0       0 if (@errors) {
159 0         0 croak "Unable to verify XML with the given certificates: "
160             . join(", ", @errors);
161             }
162             }
163              
164 0         0 return;
165             }
166              
167             sub _get_saml_from_soap {
168 2     2   4 my $soap = shift;
169 2         6 my $dom = no_comments($soap);
170 2         22 my $parser = XML::LibXML::XPathContext->new($dom);
171 2         11 $parser->registerNs('soap-env', 'http://schemas.xmlsoap.org/soap/envelope/');
172 2         8 $parser->registerNs('samlp', 'urn:oasis:names:tc:SAML:2.0:protocol');
173 2         7 my $set = $parser->findnodes('/soap-env:Envelope/soap-env:Body/*');
174 2 50       73 if ($set->size) {
175 2         15 return $set->get_node(1)->toString();
176             }
177 0         0 return;
178             }
179              
180              
181             sub create_soap_envelope {
182 1     1 1 362 my ($self, $message) = @_;
183              
184             # sign the message
185 1         31 my $sig = Net::SAML2::XML::Sig->new({
186             x509 => 1,
187             key => $self->key,
188             cert => $self->cert,
189             exclusive => 1,
190             no_xml_declaration => 1,
191             });
192 1         465 my $signed_message = $sig->sign($message);
193              
194             # OpenSSO ArtifactResolve hack
195             #
196             # OpenSSO's ArtifactResolve parser is completely hateful. It demands that
197             # the order of child elements in an ArtifactResolve message be:
198             #
199             # 1: saml:Issuer
200             # 2: dsig:Signature
201             # 3: samlp:Artifact
202             #
203             # Really.
204             #
205 1 50       2172 if ($signed_message =~ /ArtifactResolve/) {
206 0         0 $signed_message =~ s!(<dsig:Signature.*?</dsig:Signature>)!!s;
207 0         0 my $signature = $1;
208 0         0 $signed_message =~ s/(<\/saml:Issuer>)/$1$signature/;
209             }
210              
211             # test verify
212 1         8 my $ret = $sig->verify($signed_message);
213 1 50       2313 die "failed to sign" unless $ret;
214              
215 1         9 my $soap = <<"SOAP";
216             <SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"><SOAP-ENV:Body>$signed_message</SOAP-ENV:Body></SOAP-ENV:Envelope>
217             SOAP
218 1         31 return $soap;
219             }
220              
221             __PACKAGE__->meta->make_immutable;
222              
223             __END__
224              
225             =pod
226              
227             =encoding UTF-8
228              
229             =head1 NAME
230              
231             Net::SAML2::Binding::SOAP - SOAP binding for SAML
232              
233             =head1 VERSION
234              
235             version 0.72
236              
237             =head1 SYNOPSIS
238              
239             my $soap = Net::SAML2::Binding::SOAP->new(
240             url => $idp_url,
241             key => $key,
242             cert => $cert,
243             idp_cert => $idp_cert,
244             );
245              
246             my $response = $soap->request($req);
247              
248             Note that LWP::UserAgent maybe used which means that environment variables
249             may affect the use of https see:
250              
251             =over
252              
253             =item * L<PERL_LWP_SSL_CA_FILE and HTTPS_CA_FILE|https://metacpan.org/pod/LWP::UserAgent#SSL_ca_file-=%3E-$path>
254              
255             =item * L<PERL_LWP_SSL_CA_PATH and HTTPS_CA_DIR|https://metacpan.org/pod/LWP::UserAgent#SSL_ca_path-=%3E-$path>
256              
257             =back
258              
259             =head1 METHODS
260              
261             =head2 new( ... )
262              
263             Constructor. Returns an instance of the SOAP binding configured for
264             the given IdP service url.
265              
266             Arguments:
267              
268             =over
269              
270             =item B<ua>
271              
272             (optional) a LWP::UserAgent-compatible UA
273             You can build the user agent to your liking when extending this class by
274             overriding C<build_user_agent>
275              
276             =item B<url>
277              
278             the service URL
279              
280             =item B<key>
281              
282             the key to sign with
283              
284             =item B<cert>
285              
286             the corresponding certificate
287              
288             =item B<idp_cert>
289              
290             the idp's signing certificate
291              
292             =item B<cacert>
293              
294             the CA for the SAML CoT
295              
296             =back
297              
298             =head2 build_user_agent
299              
300             Builder for the user agent
301              
302             =head2 request( $message )
303              
304             Submit the message to the IdP's service.
305              
306             Returns the Response, or dies if there was an error.
307              
308             =head2 handle_response( $response )
309              
310             Handle a response from a remote system on the SOAP binding.
311              
312             Accepts a string containing the complete SOAP response.
313              
314             =head2 handle_request( $request )
315              
316             Handle a request from a remote system on the SOAP binding.
317              
318             Accepts a string containing the complete SOAP request.
319              
320             =head2 create_soap_envelope( $message )
321              
322             Signs and SOAP-wraps the given message.
323              
324             =head1 AUTHORS
325              
326             =over 4
327              
328             =item *
329              
330             Chris Andrews <chrisa@cpan.org>
331              
332             =item *
333              
334             Timothy Legge <timlegge@gmail.com>
335              
336             =back
337              
338             =head1 COPYRIGHT AND LICENSE
339              
340             This software is copyright (c) 2023 by Venda Ltd, see the CONTRIBUTORS file for others.
341              
342             This is free software; you can redistribute it and/or modify it under
343             the same terms as the Perl 5 programming language system itself.
344              
345             =cut