1- use strict;
2- use warnings;
31package Net::SAML2::IdP ;
2+ use Moose;
3+
44# VERSION
55
6- use Moose;
76use MooseX::Types::URI qw/ Uri / ;
87
98# ABSTRACT: Net::SAML2::IdP - SAML Identity Provider object
@@ -121,36 +120,24 @@ sub new_from_xml {
121120
122121 my $data ;
123122
124- for my $sso (
125- $xpath -> findnodes(
126- ' //md:EntityDescriptor/md:IDPSSODescriptor/md:SingleSignOnService' )
127- )
128- {
123+ my $basepath = ' //md:EntityDescriptor/md:IDPSSODescriptor' ;
124+
125+ for my $sso ($xpath -> findnodes(" $basepath /md:SingleSignOnService" )) {
129126 my $binding = $sso -> getAttribute(' Binding' );
130127 $data -> {SSO }-> {$binding } = $sso -> getAttribute(' Location' );
131128 }
132129
133- for my $slo (
134- $xpath -> findnodes(
135- ' //md:EntityDescriptor/md:IDPSSODescriptor/md:SingleLogoutService' )
136- )
137- {
130+ for my $slo ($xpath -> findnodes(" $basepath /md:SingleLogoutService" )) {
138131 my $binding = $slo -> getAttribute(' Binding' );
139132 $data -> {SLO }-> {$binding } = $slo -> getAttribute(' Location' );
140133 }
141134
142- for my $art (
143- $xpath -> findnodes(
144- ' //md:EntityDescriptor/md:IDPSSODescriptor/md:ArtifactResolutionService' )
145- )
146- {
135+ for my $art ($xpath -> findnodes(" $basepath /md:ArtifactResolutionService" )) {
147136 my $binding = $art -> getAttribute(' Binding' );
148137 $data -> {Art }-> {$binding } = $art -> getAttribute(' Location' );
149138 }
150139
151- for my $format (
152- $xpath -> findnodes(' //md:EntityDescriptor/md:IDPSSODescriptor/md:NameIDFormat' ))
153- {
140+ for my $format ($xpath -> findnodes(" $basepath /md:NameIDFormat" )) {
154141 $format = $format -> string_value;
155142 $format =~ s / ^\s +// g ;
156143 $format =~ s /\s +$// g ;
@@ -164,50 +151,26 @@ sub new_from_xml {
164151 }
165152 }
166153
167- my @certs = ();
168-
169- for my $key (
170- $xpath -> findnodes(' //md:EntityDescriptor/md:IDPSSODescriptor/md:KeyDescriptor' ))
171- {
172- my @uses ;
173- push (@uses , $key -> getAttribute(' use' ) || ' signing' );
174- push (@uses , ' encryption' ) if !$key -> getAttribute(' use' );
175-
176-
177- $key -> setNamespace(' http://www.w3.org/2000/09/xmldsig#' , ' ds' );
178-
179- my ($text )
180- = $key -> findvalue(" ds:KeyInfo/ds:X509Data/ds:X509Certificate" , $key )
181- =~ / ^\s *(.+?)\s *$ /s ;
182-
183- # rewrap the base64 data from the metadata; it may not
184- # be wrapped at 64 characters as PEM requires
185- $text =~ s /\n // g ;
186-
187- my @lines ;
188- while (length $text > 64) {
189- push @lines , substr $text , 0, 64, ' ' ;
154+ my %certs = ();
155+ for my $key ($xpath -> findnodes(" $basepath /md:KeyDescriptor" )) {
156+ my $use = $key -> getAttribute(' use' );
157+ my $pem = $class -> _get_pem_from_keynode($key );
158+ if (!$use ) {
159+ push (@{$certs {signing }}, $pem );
160+ push (@{$certs {encryption }}, $pem );
190161 }
191- push @lines , $text ;
192-
193- $text = join " \n " , @lines ;
194-
195- # form a PEM certificate
196- for my $use (@uses ) {
197- my $pem -> {$use }
198- = sprintf (" -----BEGIN CERTIFICATE-----\n %s \n -----END CERTIFICATE-----\n " ,
199- $text );
200- push (@certs , $pem );
162+ else {
163+ push (@{$certs {$use }}, $pem );
201164 }
202165 }
203166
204- my $self = $class -> new(
167+ return $class -> new(
205168 entityid => $xpath -> findvalue(' //md:EntityDescriptor/@entityID' ),
206169 sso_urls => $data -> {SSO },
207170 slo_urls => $data -> {SLO } || {},
208171 art_urls => $data -> {Art } || {},
209- certs => \@ certs ,
210- cacert => $args {cacert },
172+ certs => \% certs ,
173+ cacert => $args {cacert },
211174 $data -> {DefaultFormat }
212175 ? (
213176 default_format => $data -> {DefaultFormat },
@@ -216,9 +179,34 @@ sub new_from_xml {
216179 : (),
217180 );
218181
219- return $self ;
220182}
221183
184+ sub _get_pem_from_keynode {
185+ my $self = shift ;
186+ my $node = shift ;
187+
188+ $node -> setNamespace(' http://www.w3.org/2000/09/xmldsig#' , ' ds' );
189+
190+ my ($text )
191+ = $node -> findvalue(" ds:KeyInfo/ds:X509Data/ds:X509Certificate" , $node )
192+ =~ / ^\s *(.+?)\s *$ /s ;
193+
194+ # rewrap the base64 data from the metadata; it may not
195+ # be wrapped at 64 characters as PEM requires
196+ $text =~ s /\n // g ;
197+
198+ my @lines ;
199+ while (length $text > 64) {
200+ push @lines , substr $text , 0, 64, ' ' ;
201+ }
202+ push @lines , $text ;
203+
204+ $text = join " \n " , @lines ;
205+
206+ return " -----BEGIN CERTIFICATE-----\n $text \n -----END CERTIFICATE-----\n " ;
207+ }
208+
209+
222210# BUILDARGS ( hashref of the parameters passed to the constructor )
223211#
224212# Called after the object is created to validate the IdP using the cacert
@@ -233,32 +221,22 @@ around BUILDARGS => sub {
233221 if ($params {cacert }) {
234222 my $ca = Crypt::OpenSSL::Verify-> new($params {cacert }, { strict_certs => 0, });
235223
236- my $verified = 0;
237- my %errors ;
238- my %certs ;
239-
240- for my $pem (@{ $params {certs } }) {
241- for my $use (keys %{$pem }) {
242- my @tmpcrt ;
243- my $cert = Crypt::OpenSSL::X509-> new_from_string($pem -> {$use });
224+ my %certificates ;
225+ for my $use (keys %{$params {certs }}) {
226+ my $certs = $params {certs }{$use };
227+ for my $pem (@{$certs }) {
228+ my $cert = Crypt::OpenSSL::X509-> new_from_string($pem );
244229 # # BUGBUG this is failing for valid things ...
245230 eval { $ca -> verify($cert ) };
246231 if ($@ ) {
247- $errors { $cert -> fingerprint_sha256} = $@ ;
232+ warn " Can't verify IdP cert: $@ " ;
248233 next ;
249234 }
250- $verified = 1;
251- push @tmpcrt , $pem -> {$use };
252-
253- $certs {$use } = \@tmpcrt ;
235+ push (@{$certificates {$use }}, $pem );
254236 }
255237 }
256238
257- $params {certs } = \%certs ;
258-
259- if (!$verified ) {
260- warn " Can't verify IdP signing cert: " , %errors , " \n " ;
261- }
239+ $params {certs } = \%certificates ;
262240 }
263241
264242 return $self -> $orig (%params );
0 commit comments