File Coverage

blib/lib/Net/SAML2/Binding/POST.pm
Criterion Covered Total %
statement 41 41 100.0
branch 4 8 50.0
condition n/a
subroutine 11 11 100.0
pod 2 2 100.0
total 58 62 93.5


line stmt bran cond sub pod time code
1 25     25   164 use strict;
  25         51  
  25         760  
2 25     25   122 use warnings;
  25         53  
  25         1245  
3             package Net::SAML2::Binding::POST;
4             our $VERSION = '0.72'; # TRIAL VERSION
5              
6 25     25   130 use Moose;
  25         60  
  25         143  
7 25     25   145123 use Carp qw(croak);
  25         76  
  25         1271  
8              
9             # ABSTRACT: HTTP POST binding for SAML
10              
11              
12 25     25   9850 use Net::SAML2::XML::Sig;
  25         78  
  25         249  
13 25     25   1322 use MIME::Base64 qw/ decode_base64 /;
  25         53  
  25         1286  
14 25     25   9382 use Crypt::OpenSSL::Verify;
  25         15561  
  25         650  
15 25     25   162 use MIME::Base64;
  25         59  
  25         1069  
16 25     25   167 use URI::Escape;
  25         47  
  25         8553  
17              
18             with 'Net::SAML2::Role::VerifyXML';
19              
20              
21             has 'cert_text' => (isa => 'Str', is => 'ro');
22             has 'cacert' => (isa => 'Maybe[Str]', is => 'ro');
23              
24             has 'cert' => (isa => 'Str', is => 'ro', required => 0, predicate => 'has_cert');
25             has 'key' => (isa => 'Str', is => 'ro', required => 0, predicate => 'has_key');
26              
27              
28             sub handle_response {
29 3     3 1 560 my ($self, $response) = @_;
30              
31             # unpack and check the signature
32 3         130 my $xml = decode_base64($response);
33              
34 3 50       111 $self->verify_xml(
    50          
35             $xml,
36             no_xml_declaration => 1,
37             $self->cert_text ? (
38             cert_text => $self->cert_text
39             ) : (),
40             $self->cacert ? (
41             cacert => $self->cacert
42             ) : (),
43              
44             );
45 3         39 return $xml;
46             }
47              
48              
49             sub sign_xml {
50 3     3 1 349 my ($self, $request) = @_;
51              
52 3 50       97 croak("Need to have a cert specified") unless $self->has_cert;
53 3 50       81 croak("Need to have a key specified") unless $self->has_key;
54              
55 3         72 my $signer = XML::Sig->new({
56             key => $self->key,
57             cert => $self->cert,
58             no_xml_declaration => 1,
59             }
60             );
61              
62 3         2710 my $signed_message = $signer->sign($request);
63              
64             # saml-schema-protocol-2.0.xsd Schema hack
65             #
66             # The real fix here is to fix XML::Sig to accept a XPATH to
67             # place the signature in the correct location. Or use XML::LibXML
68             # here to do so
69             #
70             # The protocol schema defines a sequence which requires the order
71             # of the child elements in a Protocol based message:
72             #
73             # The dsig:Signature (should it exist) MUST follow the saml:Issuer
74             #
75             # 1: saml:Issuer
76             # 2: dsig:Signature
77             #
78             # Seems like an oversight in the SAML schema specifiation but...
79              
80 3         6796 $signed_message =~ s!(<dsig:Signature.*?</dsig:Signature>)!!s;
81 3         18 my $signature = $1;
82 3         48 $signed_message =~ s/(<\/saml\d*:Issuer>)/$1$signature/;
83              
84 3         57 my $encoded_request = encode_base64($signed_message, "\n");
85              
86 3         168 return $encoded_request;
87              
88             }
89             __PACKAGE__->meta->make_immutable;
90              
91             __END__
92              
93             =pod
94              
95             =encoding UTF-8
96              
97             =head1 NAME
98              
99             Net::SAML2::Binding::POST - HTTP POST binding for SAML
100              
101             =head1 VERSION
102              
103             version 0.72
104              
105             =head1 SYNOPSIS
106              
107             my $post = Net::SAML2::Binding::POST->new(
108             cacert => '/path/to/ca-cert.pem'
109             );
110             my $ret = $post->handle_response(
111             $saml_response
112             );
113              
114             =head1 NAME
115              
116             Net::SAML2::Binding::POST - HTTP POST binding for SAML2
117              
118             =head1 METHODS
119              
120             =head2 new( )
121              
122             Constructor. Returns an instance of the POST binding.
123              
124             Arguments:
125              
126             =over
127              
128             =item B<cacert>
129              
130             path to the CA certificate for verification
131              
132             =back
133              
134             =head2 handle_response( $response )
135              
136             Decodes and verifies the response provided, which should be the raw
137             Base64-encoded response, from the SAMLResponse CGI parameter.
138              
139             =head2 sign_xml( $request )
140              
141             Sign and encode the SAMLRequest.
142              
143             =head1 AUTHORS
144              
145             =over 4
146              
147             =item *
148              
149             Chris Andrews <chrisa@cpan.org>
150              
151             =item *
152              
153             Timothy Legge <timlegge@gmail.com>
154              
155             =back
156              
157             =head1 COPYRIGHT AND LICENSE
158              
159             This software is copyright (c) 2023 by Venda Ltd, see the CONTRIBUTORS file for others.
160              
161             This is free software; you can redistribute it and/or modify it under
162             the same terms as the Perl 5 programming language system itself.
163              
164             =cut