File Coverage

blib/lib/Net/SAML2/Protocol/Artifact.pm
Criterion Covered Total %
statement 46 49 93.8
branch 11 14 78.5
condition n/a
subroutine 11 12 91.6
pod 5 5 100.0
total 73 80 91.2


line stmt bran cond sub pod time code
1 4     4   1084 use strict;
  4         14  
  4         178  
2 4     4   34 use warnings;
  4         12  
  4         262  
3             package Net::SAML2::Protocol::Artifact;
4             our $VERSION = '0.73'; # VERSION
5              
6 4     4   37 use Moose;
  4         14  
  4         34  
7 4     4   31232 use MooseX::Types::DateTime qw/ DateTime /;
  4         69824  
  4         47  
8 4     4   9031 use DateTime::Format::XSD;
  4         454103  
  4         162  
9 4     4   39 use Net::SAML2::XML::Util qw/ no_comments /;
  4         11  
  4         304  
10 4     4   37 use XML::LibXML;
  4         15  
  4         62  
11              
12             with 'Net::SAML2::Role::ProtocolMessage';
13              
14             # ABSTRACT: SAML2 artifact object
15              
16              
17             has 'issue_instant' => (isa => DateTime, is => 'ro', required => 1);
18             has 'in_response_to' => (isa => 'Str', is => 'ro', required => 1);
19             has 'issuer' => (isa => 'Str', is => 'ro', required => 1);
20             has 'status' => (isa => 'Str', is => 'ro', required => 1);
21             has 'logoutresponse_object' => (
22             isa => 'XML::LibXML::Element',
23             is => 'ro',
24             required => 0,
25             init_arg => 'logout_response',
26             predicate => 'has_logout_response'
27             );
28             has 'response_object' => (
29             isa => 'XML::LibXML::Element',
30             is => 'ro',
31             required => 0,
32             init_arg => 'response',
33             predicate => 'has_response'
34             );
35              
36              
37              
38             sub new_from_xml {
39 2     2 1 2287 my($class, %args) = @_;
40              
41 2         11 my $dom = no_comments($args{xml});
42 2         11 my $key_file = $args{key_file};
43 2         12 my $cacert = $args{cacert};
44              
45 2         32 my $xpath = XML::LibXML::XPathContext->new($dom);
46 2         23 $xpath->registerNs('saml', 'urn:oasis:names:tc:SAML:2.0:assertion');
47 2         10 $xpath->registerNs('samlp', 'urn:oasis:names:tc:SAML:2.0:protocol');
48              
49 2         4 my $response;
50 2 100       10 if (my $node = $xpath->findnodes('/samlp:ArtifactResponse/samlp:Response')) {
51 1         187 $response = $node->get_node(1)->cloneNode( 1 );
52             }
53 2         182 my $logoutresponse;
54 2 100       15 if (my $node = $xpath->findnodes('/samlp:ArtifactResponse/samlp:LogoutResponse')) {
55 1         64 $logoutresponse = $node->get_node(1)->cloneNode( 1 );
56             }
57              
58 2         95 my $issue_instant;
59              
60 2 50       12 if (my $value = $xpath->findvalue('/samlp:ArtifactResponse/@IssueInstant')) {
61 2         192 $issue_instant = DateTime::Format::XSD->parse_datetime($value);
62             }
63              
64 2 100       2302 my $self = $class->new(
    100          
65             id => $xpath->findvalue('/samlp:ArtifactResponse/@ID'),
66             in_response_to => $xpath->findvalue('/samlp:ArtifactResponse/@InResponseTo'),
67             issue_instant => $issue_instant,
68             issuer => $xpath->findvalue('/samlp:ArtifactResponse/saml:Issuer'),
69             status => $xpath->findvalue('/samlp:ArtifactResponse/samlp:Status/samlp:StatusCode/@Value'),
70             $response ? (response => $response) : (),
71             $logoutresponse ? (logout_response => $logoutresponse) : (),
72             );
73              
74 2         3903 return $self;
75             }
76              
77              
78             sub response {
79 2     2 1 768 my $self = shift;
80 2         128 return $self->response_object->toString;
81             }
82              
83              
84             sub logout_response {
85 2     2 1 445 my $self = shift;
86 2         76 return $self->logoutresponse_object->toString;
87             }
88              
89              
90             sub success {
91 0     0 1 0 my ($self) = @_;
92 0 0       0 return 1 if $self->status eq $self->status_uri('success');
93 0         0 return 0;
94             }
95              
96              
97             sub get_response {
98 2     2 1 2039 my ($self) = @_;
99 2 100       96 return $self->logout_response if $self->has_logout_response;
100 1         4 return $self->response
101             }
102              
103             1;
104              
105             __END__
106              
107             =pod
108              
109             =encoding UTF-8
110              
111             =head1 NAME
112              
113             Net::SAML2::Protocol::Artifact - SAML2 artifact object
114              
115             =head1 VERSION
116              
117             version 0.73
118              
119             =head1 SYNOPSIS
120              
121             my $artifact = Net::SAML2::Protocol::Artifact->new_from_xml(
122             xml => Net::SAML2::Binding::SOAP->request(
123             Net::SAML2::SP->artifact_request(
124             $art_url,
125             $artifact
126             )->as_xml)
127             );
128              
129             or
130              
131             my $request = Net::SAML2::SP->artifact_request($art_url, $artifact)->as_xml;
132             my soap_response = Net::SAML2::Binding::SOAP->request($request);
133             my $artifact = Net::SAML2::Protocol::Artifact->new_from_xml(soap_response);
134              
135             # get_response returns the Response or LogoutResponse
136             my art_response = $artifact->get_response();
137              
138             =head1 NAME
139              
140             Net::SAML2::Protocol::Artifact - SAML2 artifact object
141              
142             =head1 METHODS
143              
144             =head2 new_from_xml( ... )
145              
146             Constructor. Creates an instance of the Artifact object, parsing the
147             given XML to find the response and logout_response should they exist as
148             well as the issuer, issue_instant and in_response_to.
149              
150             Arguments:
151              
152             =over
153              
154             =item B<xml>
155              
156             XML data
157              
158             =back
159              
160             =head2 response
161              
162             Returns the response
163              
164             =head2 logout_response
165              
166             Returns the logoutresponse
167              
168             =head2 success( )
169              
170             Returns true if the Response's status is Success.
171              
172             =head2 get_response ( )
173              
174             Returns the LogoutResponse or Response depending on which is defined
175              
176             =head1 AUTHORS
177              
178             =over 4
179              
180             =item *
181              
182             Chris Andrews <chrisa@cpan.org>
183              
184             =item *
185              
186             Timothy Legge <timlegge@gmail.com>
187              
188             =back
189              
190             =head1 COPYRIGHT AND LICENSE
191              
192             This software is copyright (c) 2023 by Venda Ltd, see the CONTRIBUTORS file for others.
193              
194             This is free software; you can redistribute it and/or modify it under
195             the same terms as the Perl 5 programming language system itself.
196              
197             =cut