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   960 use strict;
  4         9  
  4         156  
2 4     4   19 use warnings;
  4         12  
  4         245  
3             package Net::SAML2::Protocol::Artifact;
4             our $VERSION = '0.72'; # TRIAL VERSION
5              
6 4     4   23 use Moose;
  4         13  
  4         31  
7 4     4   27244 use MooseX::Types::DateTime qw/ DateTime /;
  4         57118  
  4         53  
8 4     4   8266 use DateTime::Format::XSD;
  4         362957  
  4         161  
9 4     4   35 use Net::SAML2::XML::Util qw/ no_comments /;
  4         10  
  4         241  
10 4     4   44 use XML::LibXML;
  4         9  
  4         39  
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 2230 my($class, %args) = @_;
40              
41 2         14 my $dom = no_comments($args{xml});
42 2         7 my $key_file = $args{key_file};
43 2         5 my $cacert = $args{cacert};
44              
45 2         28 my $xpath = XML::LibXML::XPathContext->new($dom);
46 2         17 $xpath->registerNs('saml', 'urn:oasis:names:tc:SAML:2.0:assertion');
47 2         9 $xpath->registerNs('samlp', 'urn:oasis:names:tc:SAML:2.0:protocol');
48              
49 2         4 my $response;
50 2 100       11 if (my $node = $xpath->findnodes('/samlp:ArtifactResponse/samlp:Response')) {
51 1         132 $response = $node->get_node(1)->cloneNode( 1 );
52             }
53 2         160 my $logoutresponse;
54 2 100       7 if (my $node = $xpath->findnodes('/samlp:ArtifactResponse/samlp:LogoutResponse')) {
55 1         52 $logoutresponse = $node->get_node(1)->cloneNode( 1 );
56             }
57              
58 2         91 my $issue_instant;
59              
60 2 50       9 if (my $value = $xpath->findvalue('/samlp:ArtifactResponse/@IssueInstant')) {
61 2         185 $issue_instant = DateTime::Format::XSD->parse_datetime($value);
62             }
63              
64 2 100       1918 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         4494 return $self;
75             }
76              
77              
78             sub response {
79 2     2 1 1063 my $self = shift;
80 2         63 return $self->response_object->toString;
81             }
82              
83              
84             sub logout_response {
85 2     2 1 468 my $self = shift;
86 2         60 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 2002 my ($self) = @_;
99 2 100       93 return $self->logout_response if $self->has_logout_response;
100 1         5 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.72
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