| 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 |