$Net::SAML2::Binding::SOAP::VERSION
=
'0.10'
;
has
'ua'
=> (
isa
=> Object,
is
=>
'ro'
,
required
=> 1,
default
=>
sub
{ LWP::UserAgent->new });
has
'url'
=> (
isa
=> Uri,
is
=>
'ro'
,
required
=> 1,
coerce
=> 1);
has
'key'
=> (
isa
=> Str,
is
=>
'ro'
,
required
=> 1);
has
'cert'
=> (
isa
=> Str,
is
=>
'ro'
,
required
=> 1);
has
'idp_cert'
=> (
isa
=> Str,
is
=>
'ro'
,
required
=> 1);
has
'cacert'
=> (
isa
=> Str,
is
=>
'ro'
,
required
=> 1);
sub
request {
my
(
$self
,
$message
) =
@_
;
my
$request
=
$self
->create_soap_envelope(
$message
);
my
$req
= POST
$self
->url;
$req
->header(
'SOAPAction'
=>
$soap_action
);
$req
->header(
'Content-Type'
=>
'text/xml'
);
$req
->header(
'Content-Length'
=>
length
$request
);
$req
->content(
$request
);
my
$ua
=
$self
->ua;
my
$res
=
$ua
->request(
$req
);
return
$self
->handle_response(
$res
->content);
}
sub
handle_response {
my
(
$self
,
$response
) =
@_
;
my
$x
= Net::SAML2::XML::Sig->new({
x509
=> 1,
cert_text
=>
$self
->idp_cert });
my
$ret
=
$x
->verify(
$response
);
die
"bad SOAP response"
unless
$ret
;
my
$cert
=
$x
->signer_cert;
my
$ca
= Crypt::OpenSSL::VerifyX509->new(
$self
->cacert);
$ret
=
$ca
->verify(
$cert
);
die
"bad signer cert"
unless
$ret
;
my
$subject
=
sprintf
(
"%s (verified)"
,
$cert
->subject);
my
$parser
= XML::XPath->new(
xml
=>
$response
);
$parser
->set_namespace(
'samlp'
,
'urn:oasis:names:tc:SAML:2.0:protocol'
);
my
$saml
=
$parser
->findnodes_as_string(
'/soap-env:Envelope/soap-env:Body/*'
);
return
(
$subject
,
$saml
);
}
sub
handle_request {
my
(
$self
,
$request
) =
@_
;
my
$parser
= XML::XPath->new(
xml
=>
$request
);
$parser
->set_namespace(
'samlp'
,
'urn:oasis:names:tc:SAML:2.0:protocol'
);
my
$saml
=
$parser
->findnodes_as_string(
'/soap-env:Envelope/soap-env:Body/*'
);
if
(
defined
$saml
) {
my
$x
= Net::SAML2::XML::Sig->new({
x509
=> 1,
cert_text
=>
$self
->idp_cert });
my
$ret
=
$x
->verify(
$saml
);
die
"bad signature"
unless
$ret
;
my
$cert
=
$x
->signer_cert;
my
$ca
= Crypt::OpenSSL::VerifyX509->new(
$self
->cacert);
$ret
=
$ca
->verify(
$cert
);
die
"bad certificate in request: "
.
$cert
->subject
unless
$ret
;
my
$subject
=
$cert
->subject;
return
(
$subject
,
$saml
);
}
return
;
}
sub
create_soap_envelope {
my
(
$self
,
$message
) =
@_
;
my
$sig
= Net::SAML2::XML::Sig->new({
x509
=> 1,
key
=>
$self
->key,
cert
=>
$self
->cert,
});
my
$signed_message
=
$sig
->sign(
$message
);
if
(
$signed_message
=~ /ArtifactResolve/) {
$signed_message
=~ s!(<dsig:Signature.*?</dsig:Signature>)!!s;
my
$signature
= $1;
$signed_message
=~ s/(<\/saml:Issuer>)/$1
$signature
/;
}
my
$ret
=
$sig
->verify(
$signed_message
);
die
"failed to sign"
unless
$ret
;
my
$soap
=
<<"SOAP";
<SOAP-ENV:Body>
$signed_message
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
SOAP
return
$soap
;
}
__PACKAGE__->meta->make_immutable;