File Coverage

blib/lib/Net/SAML2/Protocol/AuthnRequest.pm
Criterion Covered Total %
statement 47 61 77.0
branch 10 14 71.4
condition 1 3 33.3
subroutine 10 10 100.0
pod 1 1 100.0
total 69 89 77.5


line stmt bran cond sub pod time code
1             package Net::SAML2::Protocol::AuthnRequest;
2              
3 13     13   112 use Moose;
  13         32  
  13         126  
4 13     13   96377 use MooseX::Types::URI qw/ Uri /;
  13         34  
  13         171  
5 13     13   34630 use MooseX::Types::Common::String qw/ NonEmptySimpleStr /;
  13         1450110  
  13         107  
6 13     13   51214 use XML::Writer 0.625;
  13         86522  
  13         532  
7 13     13   125 use List::Util qw(any);
  13         33  
  13         13102  
8              
9             with 'Net::SAML2::Role::ProtocolMessage';
10              
11             # ABSTRACT: SAML2 AuthnRequest object
12              
13             our $VERSION = '0.41';
14              
15              
16              
17             has 'nameid' => (
18             isa => NonEmptySimpleStr,
19             is => 'rw',
20             predicate => 'has_nameid'
21             );
22              
23             has 'nameidpolicy_format' => (
24             isa => 'Str',
25             is => 'rw',
26             predicate => 'has_nameidpolicy_format'
27             );
28              
29             has 'nameid_allow_create' => (
30             isa => 'Bool',
31             is => 'rw',
32             required => 0,
33             predicate => 'has_nameid_allow_create'
34             );
35              
36             has 'assertion_url' => (
37             isa => Uri,
38             is => 'rw',
39             coerce => 1,
40             predicate => 'has_assertion_url',
41             );
42              
43             has 'assertion_index' => (
44             isa => 'Int',
45             is => 'rw',
46             predicate => 'has_assertion_index',
47             );
48              
49             has 'attribute_index' => (
50             isa => 'Int',
51             is => 'rw',
52             predicate => 'has_attribute_index',
53             );
54              
55             has 'protocol_binding' => (
56             isa => Uri,
57             is => 'rw',
58             coerce => 1,
59             predicate => 'has_protocol_binding',
60             );
61             has 'provider_name' => (
62             isa => 'Str',
63             is => 'rw',
64             predicate => 'has_provider_name',
65             );
66              
67             # RequestedAuthnContext:
68             has 'AuthnContextClassRef' => (
69             isa => 'ArrayRef[Str]',
70             is => 'rw',
71             default => sub {[]}
72             );
73              
74             has 'AuthnContextDeclRef' => (
75             isa => 'ArrayRef[Str]',
76             is => 'rw',
77             default => sub {[]}
78             );
79              
80             has 'RequestedAuthnContext_Comparison' => (
81             isa => 'Str',
82             is => 'rw',
83             default => 'exact'
84             );
85              
86             around BUILDARGS => sub {
87             my $orig = shift;
88             my $self = shift;
89              
90             my %params = @_;
91             if ($params{nameid_format}) {
92             unless (defined $params{nameidpolicy_format}) {
93             $params{nameidpolicy_format} = $params{nameid_format};
94             }
95             }
96              
97             return $self->$orig(%params);
98             };
99              
100              
101             my $saml = 'urn:oasis:names:tc:SAML:2.0:assertion';
102             my $samlp = 'urn:oasis:names:tc:SAML:2.0:protocol';
103              
104             sub as_xml {
105 3     3 1 1148 my ($self) = @_;
106 3         89 my $x = XML::Writer->new(
107             OUTPUT => 'self',
108             NAMESPACES => 1,
109             FORCED_NS_DECLS => [$saml, $samlp],
110             PREFIX_MAP => {
111             $saml => 'saml2',
112             $samlp => 'saml2p'
113             }
114             );
115              
116 3         1604 my %req_atts = (
117             ID => $self->id,
118             IssueInstant => $self->issue_instant,
119             Version => '2.0',
120             );
121              
122 3         24 my %issuer_attrs = ();
123              
124 3         12 my %protocol_bindings = (
125             'HTTP-POST' => 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST'
126             );
127              
128 3         27 my %att_map = (
129             'assertion_url' => 'AssertionConsumerServiceURL',
130             'assertion_index' => 'AssertionConsumerServiceIndex',
131             'attribute_index' => 'AttributeConsumingServiceIndex',
132             'protocol_binding' => 'ProtocolBinding',
133             'provider_name' => 'ProviderName',
134             'destination' => 'Destination',
135             'issuer_namequalifier' => 'NameQualifier',
136             'issuer_format' => 'Format',
137             );
138              
139 3         22 my @opts = qw(
140             assertion_url assertion_index protocol_binding
141             attribute_index provider_name destination
142             issuer_namequalifier issuer_format
143             );
144              
145 3         12 foreach my $opt (@opts) {
146 24         55 my $predicate = 'has_' . $opt;
147 24 100       911 next unless $self->$predicate;
148              
149 4         130 my $val = $self->$opt;
150 4 50       47 if ($opt eq 'protocol_binding') {
    50          
151 0         0 $req_atts{ $att_map{$opt} } = $protocol_bindings{$val};
152             }
153 8     8   21 elsif (any { $opt eq $_ } qw(issuer_namequalifier issuer_format)) {
154 0         0 $issuer_attrs{ $att_map{$opt} } = $val;
155             }
156             else {
157 4         40 $req_atts{ $att_map{$opt} } = $val;
158             }
159             }
160              
161 3         47 $x->startTag([$samlp, 'AuthnRequest'], %req_atts);
162 3         2538 $x->dataElement([$saml, 'Issuer'], $self->issuer, %issuer_attrs);
163              
164 3         760 $self->_set_name_id($x);
165 3         14 $self->_set_name_policy_format($x);
166 3         17 $self->_set_requested_authn_context($x);
167              
168 3         15 $x->endTag();
169 3         269 $x->end();
170             }
171              
172             sub _set_name_id {
173 3     3   12 my ($self, $x) = @_;
174 3 50       128 return if !$self->has_nameid;
175 0         0 $x->startTag([$saml, 'Subject']);
176 0         0 $x->dataElement([$saml, 'NameID'], undef, NameQualifier => $self->nameid);
177 0         0 $x->endTag();
178 0         0 return;
179             }
180              
181             sub _set_name_policy_format {
182 3     3   9 my ($self, $x) = @_;
183 3 100       118 return if !$self->has_nameidpolicy_format;
184              
185 2 100       70 $x->dataElement([$samlp, 'NameIDPolicy'],
186             undef,
187             Format => $self->nameidpolicy_format,
188             $self->has_nameid_allow_create
189             ? (AllowCreate => $self->nameid_allow_create)
190             : (),
191             );
192 2         509 return;
193             }
194              
195             sub _set_requested_authn_context {
196 3     3   10 my ($self, $x) = @_;
197              
198 3 50 33     7 if (!@{ $self->AuthnContextClassRef } && !@{ $self->AuthnContextDeclRef })
  3         240  
  3         109  
199             {
200 3         11 return;
201             }
202              
203 0           $x->startTag([$samlp, 'RequestedAuthnContext'],
204             Comparison => $self->RequestedAuthnContext_Comparison);
205              
206 0           foreach my $ref (@{ $self->AuthnContextClassRef }) {
  0            
207 0           $x->dataElement([$saml, 'AuthnContextClassRef'], $ref);
208             }
209 0           foreach my $ref (@{ $self->AuthnContextDeclRef }) {
  0            
210 0           $x->dataElement([$saml, 'AuthnContextDeclRef'], $ref);
211             }
212              
213 0           $x->endTag();
214             }
215              
216             __PACKAGE__->meta->make_immutable;
217              
218             __END__
219              
220             =pod
221              
222             =encoding UTF-8
223              
224             =head1 NAME
225              
226             Net::SAML2::Protocol::AuthnRequest - SAML2 AuthnRequest object
227              
228             =head1 VERSION
229              
230             version 0.41
231              
232             =head1 SYNOPSIS
233              
234             my $authnreq = Net::SAML2::Protocol::AuthnRequest->new(
235             id => 'NETSAML2_Crypt::OpenSSL::Random::random_pseudo_bytes(16),
236             issuer => $self->{id}, # Service Provider (SP) Entity ID
237             destination => $destination, # Identity Provider (IdP) SSO URL
238             provider_name => $provider_name, # Service Provider (SP) Human Readable Name
239             issue_instant => DateTime->now, # Defaults to Current Time
240             );
241              
242             my $request_id = $authnreq->id; # Store and Compare to InResponseTo
243              
244             or
245              
246             my $request_id = 'NETSAML2_' . unpack 'H*', Crypt::OpenSSL::Random::random_pseudo_bytes(16);
247              
248             my $authnreq = Net::SAML2::Protocol::AuthnRequest->as_xml(
249             id => $request_id, # Unique Request ID will be returned in response
250             issuer => $self->{id}, # Service Provider (SP) Entity ID
251             destination => $destination, # Identity Provider (IdP) SSO URL
252             provider_name => $provider_name, # Service Provider (SP) Human Readable Name
253             issue_instant => DateTime->now, # Defaults to Current Time
254             );
255              
256             =head1 NAME
257              
258             Net::SAML2::Protocol::AuthnRequest - SAML2 AuthnRequest object
259              
260             =head1 METHODS
261              
262             =head2 new( ... )
263              
264             Constructor. Creates an instance of the AuthnRequest object.
265              
266             Important Note: Best practice is to always do this first. While it is possible
267             to call as_xml() first you do not have to set the id as it will be set for you
268             automatically.
269              
270             However tracking the id is important for security to ensure that the response
271             has the same id in the InResponseTo attribute.
272              
273             Arguments:
274              
275             =over
276              
277             =item B<nameidpolicy_format>
278              
279             Format attribute for NameIDPolicy
280              
281             =item B<AuthnContextClassRef>, B<AuthnContextDeclRef>
282              
283             Each one is an arrayref containing values for AuthnContextClassRef and AuthnContextDeclRef.
284             If any is populated, the RequestedAuthnContext will be included in the request.
285              
286             =item B<RequestedAuthnContext_Comparison>
287              
288             Value for the I<Comparison> attribute in case I<RequestedAuthnContext> is included
289             (see above). Default value is I<exact>.
290              
291             =back
292              
293             =head2 as_xml( )
294              
295             Returns the AuthnRequest as XML.
296              
297             =head1 AUTHOR
298              
299             Chris Andrews <chrisa@cpan.org>
300              
301             =head1 COPYRIGHT AND LICENSE
302              
303             This software is copyright (c) 2021 by Chris Andrews and Others, see the git log.
304              
305             This is free software; you can redistribute it and/or modify it under
306             the same terms as the Perl 5 programming language system itself.
307              
308             =cut