Use inc::LWP::Protocol::PSGI in tests instead of redefining LWP::UserAgent methods (#595)
This commit is contained in:
parent
89e818d407
commit
6586b684dd
|
@ -219,8 +219,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
use MIME::Base64;
|
use MIME::Base64;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
|
@ -12,6 +14,36 @@ my $debug = 'error';
|
||||||
my ( $issuer, $sp, $res );
|
my ( $issuer, $sp, $res );
|
||||||
my %handlerOR = ( issuer => [], sp => [] );
|
my %handlerOR = ( issuer => [], sp => [] );
|
||||||
|
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.idp.com(.*)#,
|
||||||
|
' Request from SP to IdP' );
|
||||||
|
my $url = $1;
|
||||||
|
my ($res);
|
||||||
|
count(1);
|
||||||
|
if ( $req->method =~ /^post$/i ) {
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $issuer->_post(
|
||||||
|
$url, IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
accept => 'text/plain',
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
ok( $res = $issuer->_get( $url, accept => 'text/plain', ),
|
||||||
|
' Execute post request' );
|
||||||
|
}
|
||||||
|
expectOK($res);
|
||||||
|
count(1);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval { require Net::OpenID::Consumer; require Net::OpenID::Server; };
|
eval { require Net::OpenID::Consumer; require Net::OpenID::Server; };
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -105,42 +137,6 @@ sub switch {
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.idp.com(.*)#, ' Request from SP to IdP' );
|
|
||||||
my $url = $1;
|
|
||||||
my ($res);
|
|
||||||
count(1);
|
|
||||||
if ( $req->method =~ /^post$/i ) {
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $issuer->_post(
|
|
||||||
$url, IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
accept => 'text/plain',
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
ok( $res = $issuer->_get( $url, accept => 'text/plain', ),
|
|
||||||
' Execute post request' );
|
|
||||||
}
|
|
||||||
expectOK($res);
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
$httpResp->request($req);
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
count(1);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub issuer {
|
sub issuer {
|
||||||
return LLNG::Manager::Test->new(
|
return LLNG::Manager::Test->new(
|
||||||
{
|
{
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
require 't/test-lib.pm';
|
require 't/test-lib.pm';
|
||||||
|
@ -10,6 +12,55 @@ my $debug = 'error';
|
||||||
my ( $issuer, $sp, $res, $spId, $idpId );
|
my ( $issuer, $sp, $res, $spId, $idpId );
|
||||||
my %handlerOR = ( issuer => [], sp => [] );
|
my %handlerOR = ( issuer => [], sp => [] );
|
||||||
|
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok(
|
||||||
|
$req->uri =~ m#http://auth.idp.com(.*)#,
|
||||||
|
' @ REST request (' . $req->method . " $1)"
|
||||||
|
);
|
||||||
|
count(1);
|
||||||
|
my $url = $1;
|
||||||
|
my $res;
|
||||||
|
my $s = $req->content;
|
||||||
|
if ( $req->method =~ /^(post|put)$/i ) {
|
||||||
|
my $mth = '_' . lc($1);
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $issuer->$mth(
|
||||||
|
$url,
|
||||||
|
IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
),
|
||||||
|
' Post request'
|
||||||
|
);
|
||||||
|
count(1);
|
||||||
|
expectOK($res);
|
||||||
|
$idpId = expectCookie($res);
|
||||||
|
}
|
||||||
|
elsif ( $req->method =~ /^(get|delete)$/i ) {
|
||||||
|
my $mth = '_' . lc($1);
|
||||||
|
ok(
|
||||||
|
$res = $issuer->$mth(
|
||||||
|
$url,
|
||||||
|
accept => $req->header('Accept'),
|
||||||
|
cookie => $req->header('Cookie')
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
count(1);
|
||||||
|
expectOK($res);
|
||||||
|
}
|
||||||
|
ok(
|
||||||
|
getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/json#,
|
||||||
|
'Content is JSON'
|
||||||
|
) or explain( $res->[1], 'Content-Type => application/json' );
|
||||||
|
count(1);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
ok( $issuer = issuer(), 'Issuer portal' );
|
ok( $issuer = issuer(), 'Issuer portal' );
|
||||||
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
||||||
switch ('sp');
|
switch ('sp');
|
||||||
|
@ -175,63 +226,6 @@ clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
# Redefine LWP methods for tests
|
# Redefine LWP methods for tests
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok(
|
|
||||||
$req->uri =~ m#http://auth.idp.com(.*)#,
|
|
||||||
' @ REST request (' . $req->method . " $1)"
|
|
||||||
);
|
|
||||||
count(1);
|
|
||||||
my $url = $1;
|
|
||||||
my $res;
|
|
||||||
my $s = $req->content;
|
|
||||||
if ( $req->method =~ /^(post|put)$/i ) {
|
|
||||||
my $mth = '_' . lc($1);
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $issuer->$mth(
|
|
||||||
$url,
|
|
||||||
IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
),
|
|
||||||
' Post request'
|
|
||||||
);
|
|
||||||
count(1);
|
|
||||||
expectOK($res);
|
|
||||||
$idpId = expectCookie($res);
|
|
||||||
}
|
|
||||||
elsif ( $req->method =~ /^(get|delete)$/i ) {
|
|
||||||
my $mth = '_' . lc($1);
|
|
||||||
ok(
|
|
||||||
$res = $issuer->$mth(
|
|
||||||
$url,
|
|
||||||
accept => $req->header('Accept'),
|
|
||||||
cookie => $req->header('Cookie')
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
count(1);
|
|
||||||
expectOK($res);
|
|
||||||
}
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/json#,
|
|
||||||
'Content is JSON' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/json' );
|
|
||||||
count(1);
|
|
||||||
my $httpResp;
|
|
||||||
$httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
pass(' @ END OF REST REQUEST');
|
|
||||||
count(1);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
require 't/test-lib.pm';
|
require 't/test-lib.pm';
|
||||||
|
@ -11,6 +13,41 @@ my $debug = 'error';
|
||||||
my ( $issuer, $sp, $res );
|
my ( $issuer, $sp, $res );
|
||||||
my %handlerOR = ( issuer => [], sp => [] );
|
my %handlerOR = ( issuer => [], sp => [] );
|
||||||
|
|
||||||
|
# Redefine LWP methods for tests
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.((?:id|s)p).com(.*)#,
|
||||||
|
' @ SOAP REQUEST @' );
|
||||||
|
my $host = $1;
|
||||||
|
my $url = $2;
|
||||||
|
my $res;
|
||||||
|
my $s = $req->content;
|
||||||
|
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||||
|
switch ( $host eq 'idp' ? 'issuer' : 'sp' );
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url,
|
||||||
|
IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
custom => {
|
||||||
|
HTTP_SOAPACTION => $req->header('Soapaction'),
|
||||||
|
},
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
expectOK($res);
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/xml#,
|
||||||
|
' Content is XML' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||||
|
pass(' @ END OF SOAP REQUEST @');
|
||||||
|
count(4);
|
||||||
|
switch ( $host eq 'idp' ? 'sp' : 'issuer' );
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval 'use SOAP::Lite';
|
eval 'use SOAP::Lite';
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -96,46 +133,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
# Redefine LWP methods for tests
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.((?:id|s)p).com(.*)#, ' @ SOAP REQUEST @' );
|
|
||||||
my $host = $1;
|
|
||||||
my $url = $2;
|
|
||||||
my $res;
|
|
||||||
my $s = $req->content;
|
|
||||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
|
||||||
switch ( $host eq 'idp' ? 'issuer' : 'sp' );
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url,
|
|
||||||
IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
custom => {
|
|
||||||
HTTP_SOAPACTION => $req->header('Soapaction'),
|
|
||||||
},
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
expectOK($res);
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/xml#,
|
|
||||||
' Content is XML' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
pass(' @ END OF SOAP REQUEST @');
|
|
||||||
count(4);
|
|
||||||
switch ( $host eq 'idp' ? 'sp' : 'issuer' );
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
require 't/test-lib.pm';
|
require 't/test-lib.pm';
|
||||||
|
@ -10,6 +12,56 @@ my $debug = 'error';
|
||||||
my ( $issuer, $sp, $res, $spId );
|
my ( $issuer, $sp, $res, $spId );
|
||||||
my %handlerOR = ( issuer => [], sp => [] );
|
my %handlerOR = ( issuer => [], sp => [] );
|
||||||
|
|
||||||
|
# Redefine LWP methods for tests
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok(
|
||||||
|
$req->uri =~ m#http://auth.idp.com(.*?)(?:\?(.*))?$#,
|
||||||
|
' @ REST request (' . $req->method . " $1)"
|
||||||
|
);
|
||||||
|
count(1);
|
||||||
|
my $url = $1;
|
||||||
|
my $query = $2;
|
||||||
|
my $res;
|
||||||
|
my $s = $req->content;
|
||||||
|
if ( $req->method =~ /^(post|put)$/i ) {
|
||||||
|
my $mth = '_' . lc($1);
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $issuer->$mth(
|
||||||
|
$url,
|
||||||
|
IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
),
|
||||||
|
' Post request'
|
||||||
|
);
|
||||||
|
count(1);
|
||||||
|
expectOK($res);
|
||||||
|
}
|
||||||
|
elsif ( $req->method =~ /^(get|delete)$/i ) {
|
||||||
|
my $mth = '_' . lc($1);
|
||||||
|
ok(
|
||||||
|
$res = $issuer->$mth(
|
||||||
|
$url,
|
||||||
|
accept => $req->header('Accept'),
|
||||||
|
cookie => $req->header('Cookie'),
|
||||||
|
query => $query,
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
ok( ( $res->[0] == 200 or $res->[0] == 400 ),
|
||||||
|
' Response is 200 or 400' )
|
||||||
|
or explain( $res->[0], '200 or 400' );
|
||||||
|
count(2);
|
||||||
|
}
|
||||||
|
pass(' @ END OF REST REQUEST');
|
||||||
|
count(1);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
ok( $issuer = issuer(), 'Issuer portal' );
|
ok( $issuer = issuer(), 'Issuer portal' );
|
||||||
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
||||||
|
|
||||||
|
@ -103,63 +155,6 @@ expectReject($res);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
# Redefine LWP methods for tests
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok(
|
|
||||||
$req->uri =~ m#http://auth.idp.com(.*?)(?:\?(.*))?$#,
|
|
||||||
' @ REST request (' . $req->method . " $1)"
|
|
||||||
);
|
|
||||||
count(1);
|
|
||||||
my $url = $1;
|
|
||||||
my $query = $2;
|
|
||||||
my $res;
|
|
||||||
my $s = $req->content;
|
|
||||||
if ( $req->method =~ /^(post|put)$/i ) {
|
|
||||||
my $mth = '_' . lc($1);
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $issuer->$mth(
|
|
||||||
$url,
|
|
||||||
IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
),
|
|
||||||
' Post request'
|
|
||||||
);
|
|
||||||
count(1);
|
|
||||||
expectOK($res);
|
|
||||||
}
|
|
||||||
elsif ( $req->method =~ /^(get|delete)$/i ) {
|
|
||||||
my $mth = '_' . lc($1);
|
|
||||||
ok(
|
|
||||||
$res = $issuer->$mth(
|
|
||||||
$url,
|
|
||||||
accept => $req->header('Accept'),
|
|
||||||
cookie => $req->header('Cookie'),
|
|
||||||
query => $query,
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
ok( ( $res->[0] == 200 or $res->[0] == 400 ),
|
|
||||||
' Response is 200 or 400' )
|
|
||||||
or explain( $res->[0], '200 or 400' );
|
|
||||||
count(2);
|
|
||||||
}
|
|
||||||
my $httpResp;
|
|
||||||
$httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
pass(' @ END OF REST REQUEST');
|
|
||||||
count(1);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
require 't/test-lib.pm';
|
require 't/test-lib.pm';
|
||||||
|
@ -10,6 +12,56 @@ my $debug = 'error';
|
||||||
my ( $issuer, $sp, $res, $spId );
|
my ( $issuer, $sp, $res, $spId );
|
||||||
my %handlerOR = ( issuer => [], sp => [] );
|
my %handlerOR = ( issuer => [], sp => [] );
|
||||||
|
|
||||||
|
# Redefine LWP methods for tests
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok(
|
||||||
|
$req->uri =~ m#http://auth.idp.com(.*?)(?:\?(.*))?$#,
|
||||||
|
' @ REST request (' . $req->method . " $1)"
|
||||||
|
);
|
||||||
|
count(1);
|
||||||
|
my $url = $1;
|
||||||
|
my $query = $2;
|
||||||
|
my $res;
|
||||||
|
my $s = $req->content;
|
||||||
|
if ( $req->method =~ /^(post|put)$/i ) {
|
||||||
|
my $mth = '_' . lc($1);
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $issuer->$mth(
|
||||||
|
$url,
|
||||||
|
IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
),
|
||||||
|
' Post request'
|
||||||
|
);
|
||||||
|
count(1);
|
||||||
|
expectOK($res);
|
||||||
|
}
|
||||||
|
elsif ( $req->method =~ /^(get|delete)$/i ) {
|
||||||
|
my $mth = '_' . lc($1);
|
||||||
|
ok(
|
||||||
|
$res = $issuer->$mth(
|
||||||
|
$url,
|
||||||
|
accept => $req->header('Accept'),
|
||||||
|
cookie => $req->header('Cookie'),
|
||||||
|
query => $query,
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
ok( ( $res->[0] == 200 or $res->[0] == 400 ),
|
||||||
|
' Response is 200 or 400' )
|
||||||
|
or explain( $res->[0], '200 or 400' );
|
||||||
|
count(2);
|
||||||
|
}
|
||||||
|
pass(' @ END OF REST REQUEST');
|
||||||
|
count(1);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
ok( $issuer = issuer(), 'Issuer portal' );
|
ok( $issuer = issuer(), 'Issuer portal' );
|
||||||
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
||||||
switch ('sp');
|
switch ('sp');
|
||||||
|
@ -99,61 +151,6 @@ expectReject($res);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
# Redefine LWP methods for tests
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok(
|
|
||||||
$req->uri =~ m#http://auth.idp.com(.*)#,
|
|
||||||
' @ REST request (' . $req->method . " $1)"
|
|
||||||
);
|
|
||||||
count(1);
|
|
||||||
my $url = $1;
|
|
||||||
my $res;
|
|
||||||
my $s = $req->content;
|
|
||||||
if ( $req->method =~ /^(post|put)$/i ) {
|
|
||||||
my $mth = '_' . lc($1);
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $issuer->$mth(
|
|
||||||
$url,
|
|
||||||
IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
),
|
|
||||||
' Post request'
|
|
||||||
);
|
|
||||||
count(1);
|
|
||||||
expectOK($res);
|
|
||||||
}
|
|
||||||
elsif ( $req->method =~ /^(get|delete)$/i ) {
|
|
||||||
my $mth = '_' . lc($1);
|
|
||||||
ok(
|
|
||||||
$res = $issuer->$mth(
|
|
||||||
$url,
|
|
||||||
accept => $req->header('Accept'),
|
|
||||||
cookie => $req->header('Cookie')
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
ok( ( $res->[0] == 200 or $res->[0] == 400 ),
|
|
||||||
' Response is 200 or 400' )
|
|
||||||
or explain( $res->[0], '200 or 400' );
|
|
||||||
count(2);
|
|
||||||
}
|
|
||||||
my $httpResp;
|
|
||||||
$httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
pass(' @ END OF REST REQUEST');
|
|
||||||
count(1);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
require 't/test-lib.pm';
|
require 't/test-lib.pm';
|
||||||
|
@ -11,6 +13,39 @@ my $debug = 'error';
|
||||||
my ( $issuer, $sp, $res );
|
my ( $issuer, $sp, $res );
|
||||||
my %handlerOR = ( issuer => [], sp => [] );
|
my %handlerOR = ( issuer => [], sp => [] );
|
||||||
|
|
||||||
|
# Redefine LWP methods for tests
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.((?:id|s)p).com(.*)#,
|
||||||
|
' @ SOAP REQUEST @' );
|
||||||
|
my $host = $1;
|
||||||
|
my $url = $2;
|
||||||
|
my $res;
|
||||||
|
my $s = $req->content;
|
||||||
|
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url,
|
||||||
|
IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
custom => {
|
||||||
|
HTTP_SOAPACTION => $req->header('Soapaction'),
|
||||||
|
},
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
expectOK($res);
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/xml#,
|
||||||
|
' Content is XML' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||||
|
pass(' @ END OF SOAP REQUEST @');
|
||||||
|
count(4);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval 'use SOAP::Lite';
|
eval 'use SOAP::Lite';
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -89,44 +124,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
# Redefine LWP methods for tests
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.((?:id|s)p).com(.*)#, ' @ SOAP REQUEST @' );
|
|
||||||
my $host = $1;
|
|
||||||
my $url = $2;
|
|
||||||
my $res;
|
|
||||||
my $s = $req->content;
|
|
||||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url,
|
|
||||||
IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
custom => {
|
|
||||||
HTTP_SOAPACTION => $req->header('Soapaction'),
|
|
||||||
},
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
expectOK($res);
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/xml#,
|
|
||||||
' Content is XML' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
pass(' @ END OF SOAP REQUEST @');
|
|
||||||
count(4);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
require 't/test-lib.pm';
|
require 't/test-lib.pm';
|
||||||
|
@ -11,6 +13,39 @@ my $debug = 'error';
|
||||||
my ( $issuer, $sp, $res );
|
my ( $issuer, $sp, $res );
|
||||||
my %handlerOR = ( issuer => [], sp => [] );
|
my %handlerOR = ( issuer => [], sp => [] );
|
||||||
|
|
||||||
|
# Redefine LWP methods for tests
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.((?:id|s)p).com(.*)#,
|
||||||
|
' @ SOAP REQUEST @' );
|
||||||
|
my $host = $1;
|
||||||
|
my $url = $2;
|
||||||
|
my $res;
|
||||||
|
my $s = $req->content;
|
||||||
|
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url,
|
||||||
|
IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
custom => {
|
||||||
|
HTTP_SOAPACTION => $req->header('Soapaction'),
|
||||||
|
},
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
expectOK($res);
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/xml#,
|
||||||
|
' Content is XML' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||||
|
pass(' @ END OF SOAP REQUEST @');
|
||||||
|
count(4);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval 'use SOAP::Lite';
|
eval 'use SOAP::Lite';
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -77,44 +112,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
# Redefine LWP methods for tests
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.((?:id|s)p).com(.*)#, ' @ SOAP REQUEST @' );
|
|
||||||
my $host = $1;
|
|
||||||
my $url = $2;
|
|
||||||
my $res;
|
|
||||||
my $s = $req->content;
|
|
||||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url,
|
|
||||||
IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
custom => {
|
|
||||||
HTTP_SOAPACTION => $req->header('Soapaction'),
|
|
||||||
},
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
expectOK($res);
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/xml#,
|
|
||||||
' Content is XML' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
pass(' @ END OF SOAP REQUEST @');
|
|
||||||
count(4);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
use MIME::Base64;
|
use MIME::Base64;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
|
@ -13,6 +15,57 @@ my $debug = 'error';
|
||||||
my ( $op, $rp, $sp, $res );
|
my ( $op, $rp, $sp, $res );
|
||||||
my %handlerOR = ( op => [], rp => [], sp => [] );
|
my %handlerOR = ( op => [], rp => [], sp => [] );
|
||||||
|
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.((?:o|r)p).com(.*)#, ' REST request' );
|
||||||
|
my $host = $1;
|
||||||
|
my $url = $2;
|
||||||
|
my ( $res, $client );
|
||||||
|
count(1);
|
||||||
|
if ( $host eq 'op' ) {
|
||||||
|
pass(" Request from RP to OP, endpoint $url");
|
||||||
|
$client = $op;
|
||||||
|
}
|
||||||
|
elsif ( $host eq 'rp' ) {
|
||||||
|
pass(' Request from OP to RP');
|
||||||
|
$client = $rp;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
fail(' Aborting REST request (external)');
|
||||||
|
return HTTP::Response->new(500);
|
||||||
|
}
|
||||||
|
if ( $req->method =~ /^post$/i ) {
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url, IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
ok(
|
||||||
|
$res = $client->_get(
|
||||||
|
$url,
|
||||||
|
custom => {
|
||||||
|
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
||||||
|
}
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
ok( $res->[0] == 200, ' Response is 200' );
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
||||||
|
' Content is JSON' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/json' );
|
||||||
|
count(4);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval "use Lasso";
|
eval "use Lasso";
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -285,65 +338,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.((?:o|r)p).com(.*)#, ' REST request' );
|
|
||||||
my $host = $1;
|
|
||||||
my $url = $2;
|
|
||||||
my ( $res, $client );
|
|
||||||
count(1);
|
|
||||||
if ( $host eq 'op' ) {
|
|
||||||
pass(" Request from RP to OP, endpoint $url");
|
|
||||||
$client = $op;
|
|
||||||
}
|
|
||||||
elsif ( $host eq 'rp' ) {
|
|
||||||
pass(' Request from OP to RP');
|
|
||||||
$client = $rp;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
fail(' Aborting REST request (external)');
|
|
||||||
return HTTP::Response->new(500);
|
|
||||||
}
|
|
||||||
if ( $req->method =~ /^post$/i ) {
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url, IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
ok(
|
|
||||||
$res = $client->_get(
|
|
||||||
$url,
|
|
||||||
custom => {
|
|
||||||
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
|
||||||
}
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
ok( $res->[0] == 200, ' Response is 200' );
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
|
||||||
' Content is JSON' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/json' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
#print STDERR Dumper($res->[2]);
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
count(4);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
use MIME::Base64;
|
use MIME::Base64;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
|
@ -13,6 +15,57 @@ my $debug = 'error';
|
||||||
my ( $idp, $sp, $rp, $res );
|
my ( $idp, $sp, $rp, $res );
|
||||||
my %handlerOR = ( idp => [], sp => [], rp => [] );
|
my %handlerOR = ( idp => [], sp => [], rp => [] );
|
||||||
|
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.(rp|sp).com(.*)#, ' REST request' );
|
||||||
|
my $host = $1;
|
||||||
|
my $url = $2;
|
||||||
|
my ( $res, $client );
|
||||||
|
count(1);
|
||||||
|
if ( $host eq 'sp' ) {
|
||||||
|
pass(" Request from RP to OP(sp), endpoint $url");
|
||||||
|
$client = $sp;
|
||||||
|
}
|
||||||
|
elsif ( $host eq 'rp' ) {
|
||||||
|
pass(' Request from OP to RP(proxy)');
|
||||||
|
$client = $rp;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
fail(' Aborting REST request (external)');
|
||||||
|
return HTTP::Response->new(500);
|
||||||
|
}
|
||||||
|
if ( $req->method =~ /^post$/i ) {
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url, IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
ok(
|
||||||
|
$res = $client->_get(
|
||||||
|
$url,
|
||||||
|
custom => {
|
||||||
|
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
||||||
|
}
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
ok( $res->[0] == 200, ' Response is 200' );
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
||||||
|
' Content is JSON' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/json' );
|
||||||
|
count(4);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval "use Lasso";
|
eval "use Lasso";
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -231,65 +284,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.(rp|sp).com(.*)#, ' REST request' );
|
|
||||||
my $host = $1;
|
|
||||||
my $url = $2;
|
|
||||||
my ( $res, $client );
|
|
||||||
count(1);
|
|
||||||
if ( $host eq 'sp' ) {
|
|
||||||
pass(" Request from RP to OP(sp), endpoint $url");
|
|
||||||
$client = $sp;
|
|
||||||
}
|
|
||||||
elsif ( $host eq 'rp' ) {
|
|
||||||
pass(' Request from OP to RP(proxy)');
|
|
||||||
$client = $rp;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
fail(' Aborting REST request (external)');
|
|
||||||
return HTTP::Response->new(500);
|
|
||||||
}
|
|
||||||
if ( $req->method =~ /^post$/i ) {
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url, IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
ok(
|
|
||||||
$res = $client->_get(
|
|
||||||
$url,
|
|
||||||
custom => {
|
|
||||||
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
|
||||||
}
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
ok( $res->[0] == 200, ' Response is 200' );
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
|
||||||
' Content is JSON' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/json' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
#print STDERR Dumper($res->[2]);
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
count(4);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
use MIME::Base64;
|
use MIME::Base64;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
|
@ -13,6 +15,57 @@ my $debug = 'error';
|
||||||
my ( $idp, $sp, $rp, $res );
|
my ( $idp, $sp, $rp, $res );
|
||||||
my %handlerOR = ( idp => [], sp => [], rp => [] );
|
my %handlerOR = ( idp => [], sp => [], rp => [] );
|
||||||
|
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.(rp|sp).com(.*)#, ' REST request' );
|
||||||
|
my $host = $1;
|
||||||
|
my $url = $2;
|
||||||
|
my ( $res, $client );
|
||||||
|
count(1);
|
||||||
|
if ( $host eq 'sp' ) {
|
||||||
|
pass(" Request from RP to OP(sp), endpoint $url");
|
||||||
|
$client = $sp;
|
||||||
|
}
|
||||||
|
elsif ( $host eq 'rp' ) {
|
||||||
|
pass(' Request from OP to RP(proxy)');
|
||||||
|
$client = $rp;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
fail(' Aborting REST request (external)');
|
||||||
|
return HTTP::Response->new(500);
|
||||||
|
}
|
||||||
|
if ( $req->method =~ /^post$/i ) {
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url, IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
ok(
|
||||||
|
$res = $client->_get(
|
||||||
|
$url,
|
||||||
|
custom => {
|
||||||
|
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
||||||
|
}
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
ok( $res->[0] == 200, ' Response is 200' );
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
||||||
|
' Content is JSON' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/json' );
|
||||||
|
count(4);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval "use Lasso";
|
eval "use Lasso";
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -233,65 +286,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.(rp|sp).com(.*)#, ' REST request' );
|
|
||||||
my $host = $1;
|
|
||||||
my $url = $2;
|
|
||||||
my ( $res, $client );
|
|
||||||
count(1);
|
|
||||||
if ( $host eq 'sp' ) {
|
|
||||||
pass(" Request from RP to OP(sp), endpoint $url");
|
|
||||||
$client = $sp;
|
|
||||||
}
|
|
||||||
elsif ( $host eq 'rp' ) {
|
|
||||||
pass(' Request from OP to RP(proxy)');
|
|
||||||
$client = $rp;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
fail(' Aborting REST request (external)');
|
|
||||||
return HTTP::Response->new(500);
|
|
||||||
}
|
|
||||||
if ( $req->method =~ /^post$/i ) {
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url, IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
ok(
|
|
||||||
$res = $client->_get(
|
|
||||||
$url,
|
|
||||||
custom => {
|
|
||||||
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
|
||||||
}
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
ok( $res->[0] == 200, ' Response is 200' );
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
|
||||||
' Content is JSON' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/json' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
#print STDERR Dumper($res->[2]);
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
count(4);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
use MIME::Base64;
|
use MIME::Base64;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
|
@ -13,6 +15,57 @@ my $debug = 'error';
|
||||||
my ( $op, $proxy, $sp, $res );
|
my ( $op, $proxy, $sp, $res );
|
||||||
my %handlerOR = ( op => [], proxy => [], sp => [] );
|
my %handlerOR = ( op => [], proxy => [], sp => [] );
|
||||||
|
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.(op|proxy).com(.*)#, ' REST request' );
|
||||||
|
my $host = $1;
|
||||||
|
my $url = $2;
|
||||||
|
my ( $res, $client );
|
||||||
|
count(1);
|
||||||
|
if ( $host eq 'op' ) {
|
||||||
|
pass(" Request from RP(proxy) to OP, endpoint $url");
|
||||||
|
$client = $op;
|
||||||
|
}
|
||||||
|
elsif ( $host eq 'proxy' ) {
|
||||||
|
pass(' Request from OP to RP(proxy)');
|
||||||
|
$client = $proxy;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
fail(' Aborting REST request (external)');
|
||||||
|
return HTTP::Response->new(500);
|
||||||
|
}
|
||||||
|
if ( $req->method =~ /^post$/i ) {
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url, IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
ok(
|
||||||
|
$res = $client->_get(
|
||||||
|
$url,
|
||||||
|
custom => {
|
||||||
|
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
||||||
|
}
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
ok( $res->[0] == 200, ' Response is 200' );
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
||||||
|
' Content is JSON' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/json' );
|
||||||
|
count(4);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval "use Lasso";
|
eval "use Lasso";
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -205,65 +258,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.(op|proxy).com(.*)#, ' REST request' );
|
|
||||||
my $host = $1;
|
|
||||||
my $url = $2;
|
|
||||||
my ( $res, $client );
|
|
||||||
count(1);
|
|
||||||
if ( $host eq 'op' ) {
|
|
||||||
pass(" Request from RP(proxy) to OP, endpoint $url");
|
|
||||||
$client = $op;
|
|
||||||
}
|
|
||||||
elsif ( $host eq 'proxy' ) {
|
|
||||||
pass(' Request from OP to RP(proxy)');
|
|
||||||
$client = $proxy;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
fail(' Aborting REST request (external)');
|
|
||||||
return HTTP::Response->new(500);
|
|
||||||
}
|
|
||||||
if ( $req->method =~ /^post$/i ) {
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url, IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
ok(
|
|
||||||
$res = $client->_get(
|
|
||||||
$url,
|
|
||||||
custom => {
|
|
||||||
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
|
||||||
}
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
ok( $res->[0] == 200, ' Response is 200' );
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
|
||||||
' Content is JSON' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/json' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
#print STDERR Dumper($res->[2]);
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
count(4);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
use MIME::Base64;
|
use MIME::Base64;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
|
@ -13,6 +15,57 @@ my $debug = 'error';
|
||||||
my ( $op, $proxy, $sp, $res );
|
my ( $op, $proxy, $sp, $res );
|
||||||
my %handlerOR = ( op => [], proxy => [], sp => [] );
|
my %handlerOR = ( op => [], proxy => [], sp => [] );
|
||||||
|
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.(op|proxy).com(.*)#, ' REST request' );
|
||||||
|
my $host = $1;
|
||||||
|
my $url = $2;
|
||||||
|
my ( $res, $client );
|
||||||
|
count(1);
|
||||||
|
if ( $host eq 'op' ) {
|
||||||
|
pass(" Request from RP(proxy) to OP, endpoint $url");
|
||||||
|
$client = $op;
|
||||||
|
}
|
||||||
|
elsif ( $host eq 'proxy' ) {
|
||||||
|
pass(' Request from OP to RP(proxy)');
|
||||||
|
$client = $proxy;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
fail(' Aborting REST request (external)');
|
||||||
|
return HTTP::Response->new(500);
|
||||||
|
}
|
||||||
|
if ( $req->method =~ /^post$/i ) {
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url, IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
ok(
|
||||||
|
$res = $client->_get(
|
||||||
|
$url,
|
||||||
|
custom => {
|
||||||
|
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
||||||
|
}
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
ok( $res->[0] == 200, ' Response is 200' );
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
||||||
|
' Content is JSON' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/json' );
|
||||||
|
count(4);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
eval "use Lasso";
|
eval "use Lasso";
|
||||||
if ($@) {
|
if ($@) {
|
||||||
|
@ -205,65 +258,6 @@ count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.(op|proxy).com(.*)#, ' REST request' );
|
|
||||||
my $host = $1;
|
|
||||||
my $url = $2;
|
|
||||||
my ( $res, $client );
|
|
||||||
count(1);
|
|
||||||
if ( $host eq 'op' ) {
|
|
||||||
pass(" Request from RP(proxy) to OP, endpoint $url");
|
|
||||||
$client = $op;
|
|
||||||
}
|
|
||||||
elsif ( $host eq 'proxy' ) {
|
|
||||||
pass(' Request from OP to RP(proxy)');
|
|
||||||
$client = $proxy;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
fail(' Aborting REST request (external)');
|
|
||||||
return HTTP::Response->new(500);
|
|
||||||
}
|
|
||||||
if ( $req->method =~ /^post$/i ) {
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url, IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
ok(
|
|
||||||
$res = $client->_get(
|
|
||||||
$url,
|
|
||||||
custom => {
|
|
||||||
HTTP_AUTHORIZATION => $req->header('Authorization'),
|
|
||||||
}
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
}
|
|
||||||
ok( $res->[0] == 200, ' Response is 200' );
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/json#,
|
|
||||||
' Content is JSON' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/json' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
#print STDERR Dumper($res->[2]);
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
count(4);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub switch {
|
sub switch {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use strict;
|
use strict;
|
||||||
use IO::String;
|
use IO::String;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use inc::LWP::Protocol::PSGI;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
require 't/test-lib.pm';
|
require 't/test-lib.pm';
|
||||||
|
@ -10,6 +12,36 @@ my $maintests = 3;
|
||||||
my $debug = 'error';
|
my $debug = 'error';
|
||||||
my $client;
|
my $client;
|
||||||
|
|
||||||
|
# Redefine LWP methods for tests
|
||||||
|
LWP::Protocol::PSGI->register(
|
||||||
|
sub {
|
||||||
|
my $req = Plack::Request->new(@_);
|
||||||
|
ok( $req->uri =~ m#http://auth.example.com(.*)#, ' @ SOAP REQUEST @' );
|
||||||
|
my $url = $1;
|
||||||
|
my $res;
|
||||||
|
my $s = $req->content;
|
||||||
|
ok(
|
||||||
|
$res = $client->_post(
|
||||||
|
$url,
|
||||||
|
IO::String->new($s),
|
||||||
|
length => length($s),
|
||||||
|
type => $req->header('Content-Type'),
|
||||||
|
custom => {
|
||||||
|
HTTP_SOAPACTION => $req->header('Soapaction'),
|
||||||
|
},
|
||||||
|
),
|
||||||
|
' Execute request'
|
||||||
|
);
|
||||||
|
expectOK($res);
|
||||||
|
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/xml#,
|
||||||
|
' Content is XML' )
|
||||||
|
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||||
|
pass(' @ END OF SOAP REQUEST @');
|
||||||
|
count(4);
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
eval { unlink 't/20160530_dwho_dGVzdHJlZg==.xml' };
|
eval { unlink 't/20160530_dwho_dGVzdHJlZg==.xml' };
|
||||||
|
|
||||||
my $xml = '<?xml version="1.0" encoding="UTF-8"?>
|
my $xml = '<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
@ -76,39 +108,3 @@ eval { unlink 't/20160530_dwho_dGVzdHJlZg==.xml' };
|
||||||
count($maintests);
|
count($maintests);
|
||||||
clean_sessions();
|
clean_sessions();
|
||||||
done_testing( count() );
|
done_testing( count() );
|
||||||
|
|
||||||
# Redefine LWP methods for tests
|
|
||||||
no warnings 'redefine';
|
|
||||||
|
|
||||||
sub LWP::UserAgent::request {
|
|
||||||
my ( $self, $req ) = @_;
|
|
||||||
ok( $req->uri =~ m#http://auth.example.com(.*)#, ' @ SOAP REQUEST @' );
|
|
||||||
my $url = $1;
|
|
||||||
my $res;
|
|
||||||
my $s = $req->content;
|
|
||||||
ok(
|
|
||||||
$res = $client->_post(
|
|
||||||
$url,
|
|
||||||
IO::String->new($s),
|
|
||||||
length => length($s),
|
|
||||||
type => $req->header('Content-Type'),
|
|
||||||
custom => {
|
|
||||||
HTTP_SOAPACTION => $req->header('Soapaction'),
|
|
||||||
},
|
|
||||||
),
|
|
||||||
' Execute request'
|
|
||||||
);
|
|
||||||
expectOK($res);
|
|
||||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^(?:text|application)/xml#,
|
|
||||||
' Content is XML' )
|
|
||||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
|
||||||
my $httpResp = HTTP::Response->new( $res->[0], 'OK' );
|
|
||||||
|
|
||||||
while ( my $name = shift @{ $res->[1] } ) {
|
|
||||||
$httpResp->header( $name, shift( @{ $res->[1] } ) );
|
|
||||||
}
|
|
||||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
|
||||||
pass(' @ END OF SOAP REQUEST @');
|
|
||||||
count(4);
|
|
||||||
return $httpResp;
|
|
||||||
}
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user