File Coverage

blib/lib/Net/SAML2/Binding/SOAP.pm
Criterion Covered Total %
statement 46 76 60.5
branch 5 14 35.7
condition n/a
subroutine 9 11 81.8
pod 4 4 100.0
total 64 105 60.9


line stmt bran cond sub pod time code
1             package Net::SAML2::Binding::SOAP;
2 13     13   107 use Moose;
  13         34  
  13         131  
3 13     13   103925 use MooseX::Types::URI qw/ Uri /;
  13         33  
  13         190  
4 13     13   27865 use Net::SAML2::XML::Util qw/ no_comments /;
  13         35  
  13         1212  
5              
6             our $VERSION = '0.42';
7              
8             # ABSTRACT: Net::SAML2::Binding::Artifact - SOAP binding for SAML
9              
10              
11 13     13   100 use Net::SAML2::XML::Sig;
  13         26  
  13         127  
12 13     13   712 use XML::LibXML;
  13         30  
  13         150  
13 13     13   13190 use LWP::UserAgent;
  13         464108  
  13         589  
14 13     13   7668 use HTTP::Request::Common;
  13         29376  
  13         12367  
15              
16              
17             has 'ua' => (
18             isa => 'Object',
19             is => 'ro',
20             required => 1,
21             default => sub { LWP::UserAgent->new }
22             );
23              
24             has 'url' => (isa => Uri, is => 'ro', required => 1, coerce => 1);
25             has 'key' => (isa => 'Str', is => 'ro', required => 1);
26             has 'cert' => (isa => 'Str', is => 'ro', required => 1);
27             has 'idp_cert' => (isa => 'Str', is => 'ro', required => 1);
28             has 'cacert' => (isa => 'Str', is => 'ro', required => 1);
29              
30              
31             sub request {
32 0     0 1 0 my ($self, $message) = @_;
33 0         0 my $request = $self->create_soap_envelope($message);
34              
35 0         0 my $soap_action = 'http://www.oasis-open.org/committees/security';
36              
37 0         0 my $req = POST $self->url;
38 0         0 $req->header('SOAPAction' => $soap_action);
39 0         0 $req->header('Content-Type' => 'text/xml');
40 0         0 $req->header('Content-Length' => length $request);
41 0         0 $req->content($request);
42              
43 0         0 my $ua = $self->ua;
44 0         0 my $res = $ua->request($req);
45              
46 0         0 return $self->handle_response($res->content);
47             }
48              
49              
50             sub handle_response {
51 0     0 1 0 my ($self, $response) = @_;
52              
53             # verify the response
54 0         0 my $x = Net::SAML2::XML::Sig->new(
55             {
56             x509 => 1,
57             cert_text => $self->idp_cert,
58             exclusive => 1,
59             no_xml_declaration => 1,
60             });
61              
62 0         0 my $ret = $x->verify($response);
63 0 0       0 die "bad SOAP response" unless $ret;
64              
65             # verify the signing certificate
66 0         0 my $cert = $x->signer_cert;
67 0         0 my $ca = Crypt::OpenSSL::Verify->new($self->cacert, { strict_certs => 0, });
68 0         0 $ret = $ca->verify($cert);
69 0 0       0 die "bad signer cert" unless $ret;
70              
71 0         0 my $subject = sprintf("%s (verified)", $cert->subject);
72              
73             # parse the SOAP response and return the payload
74 0         0 my $dom = no_comments($response);
75              
76 0         0 my $parser = XML::LibXML::XPathContext->new($dom);
77 0         0 $parser->registerNs('soap-env', 'http://schemas.xmlsoap.org/soap/envelope/');
78 0         0 $parser->registerNs('samlp', 'urn:oasis:names:tc:SAML:2.0:protocol');
79              
80 0         0 my $saml = $parser->findnodes_as_string('/soap-env:Envelope/soap-env:Body/*');
81 0         0 return ($subject, $saml);
82             }
83              
84              
85             sub handle_request {
86 1     1 1 953 my ($self, $request) = @_;
87              
88 1         4 my $dom = no_comments($request);
89              
90 1         13 my $parser = XML::LibXML::XPathContext->new($dom);
91 1         7 $parser->registerNs('soap-env', 'http://schemas.xmlsoap.org/soap/envelope/');
92 1         4 $parser->registerNs('samlp', 'urn:oasis:names:tc:SAML:2.0:protocol');
93              
94 1         4 my ($nodes) = $parser->findnodes('/soap-env:Envelope/soap-env:Body/*');
95 1         76 my $saml = $nodes->toString;
96              
97 1 50       6 if (defined $saml) {
98 1         43 my $x = Net::SAML2::XML::Sig->new({ x509 => 1, cert_text => $self->idp_cert, exclusive => 1, });
99 1         6 my $ret = $x->verify($saml);
100 1 50       4 die "bad signature" unless $ret;
101              
102 1         4 my $cert = $x->signer_cert;
103 1         41 my $ca = Crypt::OpenSSL::Verify->new($self->cacert, { strict_certs => 0, });
104 1         80 $ret = $ca->verify($cert);
105 1 50       194 die "bad certificate in request: ".$cert->subject unless $ret;
106              
107 1         23 my $subject = $cert->subject;
108 1         45 return ($subject, $saml);
109             }
110              
111 0         0 return;
112             }
113              
114              
115             sub create_soap_envelope {
116 1     1 1 620 my ($self, $message) = @_;
117              
118             # sign the message
119 1         40 my $sig = Net::SAML2::XML::Sig->new({
120             x509 => 1,
121             key => $self->key,
122             cert => $self->cert,
123             exclusive => 1,
124             no_xml_declaration => 1,
125             });
126 1         18 my $signed_message = $sig->sign($message);
127              
128             # OpenSSO ArtifactResolve hack
129             #
130             # OpenSSO's ArtifactResolve parser is completely hateful. It demands that
131             # the order of child elements in an ArtifactResolve message be:
132             #
133             # 1: saml:Issuer
134             # 2: dsig:Signature
135             # 3: samlp:Artifact
136             #
137             # Really.
138             #
139 1 50       102 if ($signed_message =~ /ArtifactResolve/) {
140 0         0 $signed_message =~ s!(<dsig:Signature.*?</dsig:Signature>)!!s;
141 0         0 my $signature = $1;
142 0         0 $signed_message =~ s/(<\/saml:Issuer>)/$1$signature/;
143             }
144              
145             # test verify
146 1         5 my $ret = $sig->verify($signed_message);
147 1 50       4 die "failed to sign" unless $ret;
148              
149 1         9 my $soap = <<"SOAP";
150             <SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
151             <SOAP-ENV:Body>
152             $signed_message
153             </SOAP-ENV:Body>
154             </SOAP-ENV:Envelope>
155             SOAP
156 1         38 return $soap;
157             }
158              
159             __PACKAGE__->meta->make_immutable;
160              
161             __END__
162              
163             =pod
164              
165             =encoding UTF-8
166              
167             =head1 NAME
168              
169             Net::SAML2::Binding::SOAP - Net::SAML2::Binding::Artifact - SOAP binding for SAML
170              
171             =head1 VERSION
172              
173             version 0.42
174              
175             =head1 SYNOPSIS
176              
177             my $soap = Net::SAML2::Binding::SOAP->new(
178             url => $idp_url,
179             key => $key,
180             cert => $cert,
181             idp_cert => $idp_cert,
182             );
183              
184             my $response = $soap->request($req);
185              
186             =head1 NAME
187              
188             Net::SAML2::Binding::Artifact - SOAP binding for SAML2
189              
190             =head1 METHODS
191              
192             =head2 new( ... )
193              
194             Constructor. Returns an instance of the SOAP binding configured for
195             the given IdP service url.
196              
197             Arguments:
198              
199             =over
200              
201             =item B<ua>
202              
203             (optional) a LWP::UserAgent-compatible UA
204              
205             =item B<url>
206              
207             the service URL
208              
209             =item B<key>
210              
211             the key to sign with
212              
213             =item B<cert>
214              
215             the corresponding certificate
216              
217             =item B<idp_cert>
218              
219             the idp's signing certificate
220              
221             =item B<cacert>
222              
223             the CA for the SAML CoT
224              
225             =back
226              
227             =head2 request( $message )
228              
229             Submit the message to the IdP's service.
230              
231             Returns the Response, or dies if there was an error.
232              
233             =head2 handle_response( $response )
234              
235             Handle a response from a remote system on the SOAP binding.
236              
237             Accepts a string containing the complete SOAP response.
238              
239             =head2 handle_request( $request )
240              
241             Handle a request from a remote system on the SOAP binding.
242              
243             Accepts a string containing the complete SOAP request.
244              
245             =head2 create_soap_envelope( $message )
246              
247             Signs and SOAP-wraps the given message.
248              
249             =head1 AUTHOR
250              
251             Chris Andrews <chrisa@cpan.org>
252              
253             =head1 COPYRIGHT AND LICENSE
254              
255             This software is copyright (c) 2021 by Chris Andrews and Others, see the git log.
256              
257             This is free software; you can redistribute it and/or modify it under
258             the same terms as the Perl 5 programming language system itself.
259              
260             =cut