Use inc::LWP::Protocol::PSGI in tests instead of redefining LWP::UserAgent methods (#595)
This commit is contained in:
parent
d01a453f4e
commit
89e818d407
|
@ -2,12 +2,66 @@ use strict;
|
|||
use IO::String;
|
||||
use Test::More;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use JSON qw(to_json from_json);
|
||||
|
||||
BEGIN {
|
||||
require 't/test-lib.pm';
|
||||
}
|
||||
|
||||
LWP::Protocol::PSGI->register(
|
||||
sub {
|
||||
my $req = Plack::Request->new(@_);
|
||||
ok( $req->uri =~ m#^http://ws/(auth|user|confirm|modify)#,
|
||||
' ' . ucfirst($1) . ' REST request' )
|
||||
or explain( $req->uri, 'http://ws/(auth|user)' );
|
||||
my $type = $1;
|
||||
count(1);
|
||||
my $res = from_json( $req->content );
|
||||
ok( $res->{user} eq 'dwho', ' User is dwho' );
|
||||
count(1);
|
||||
|
||||
if ( $type eq 'auth' ) {
|
||||
ok( $res->{password} eq 'dwho', ' Password is dwho' )
|
||||
or explain( $res, 'password: dwho' );
|
||||
count(1);
|
||||
return [
|
||||
200,
|
||||
[ 'Content-Type' => 'application/json' ],
|
||||
['{"result":true,"info":{"uid":"dwho"}}']
|
||||
];
|
||||
}
|
||||
elsif ( $type eq 'modify' ) {
|
||||
ok( $res->{password} eq 'test', ' Password is test' );
|
||||
count(1);
|
||||
return [
|
||||
200, [ 'Content-Type' => 'application/json' ],
|
||||
['{"result":true}']
|
||||
];
|
||||
}
|
||||
elsif ( $type eq 'confirm' ) {
|
||||
ok( $res->{password} eq 'dwho', ' Password is dwho' );
|
||||
count(1);
|
||||
return [
|
||||
200, [ 'Content-Type' => 'application/json' ],
|
||||
['{"result":true}']
|
||||
];
|
||||
}
|
||||
elsif ( $type eq 'user' ) {
|
||||
return [
|
||||
200,
|
||||
[ 'Content-Type' => 'application/json' ],
|
||||
['{"result":true,"info":{"cn":"dwho"}}']
|
||||
];
|
||||
}
|
||||
else {
|
||||
fail('Unknwon URL');
|
||||
count(1);
|
||||
}
|
||||
return [ 500, [], [] ];
|
||||
}
|
||||
);
|
||||
|
||||
my $res;
|
||||
|
||||
my $client = LLNG::Manager::Test->new(
|
||||
|
@ -56,42 +110,3 @@ clean_sessions();
|
|||
|
||||
done_testing( count() );
|
||||
|
||||
no warnings 'redefine';
|
||||
|
||||
sub LWP::UserAgent::request {
|
||||
my ( $self, $req ) = @_;
|
||||
ok( $req->uri =~ m#^http://ws/(auth|user|confirm|modify)#,
|
||||
' ' . ucfirst($1) . ' REST request' )
|
||||
or explain( $req->uri, 'http://ws/(auth|user)' );
|
||||
my $type = $1;
|
||||
count(1);
|
||||
my $res = from_json( $req->content );
|
||||
ok( $res->{user} eq 'dwho', ' User is dwho' );
|
||||
count(1);
|
||||
my $resp = HTTP::Response->new( 200, 'OK' );
|
||||
|
||||
if ( $type eq 'auth' ) {
|
||||
ok( $res->{password} eq 'dwho', ' Password is dwho' )
|
||||
or explain( $res, 'password: dwho' );
|
||||
count(1);
|
||||
$resp->content('{"result":true,"info":{"uid":"dwho"}}');
|
||||
}
|
||||
elsif ( $type eq 'modify' ) {
|
||||
ok( $res->{password} eq 'test', ' Password is test' );
|
||||
count(1);
|
||||
$resp->content('{"result":true}');
|
||||
}
|
||||
elsif ( $type eq 'confirm' ) {
|
||||
ok( $res->{password} eq 'dwho', ' Password is dwho' );
|
||||
count(1);
|
||||
$resp->content('{"result":true}');
|
||||
}
|
||||
elsif ( $type eq 'user' ) {
|
||||
$resp->content('{"result":true,"info":{"cn":"dwho"}}');
|
||||
}
|
||||
else {
|
||||
fail('Unknwon URL');
|
||||
count(1);
|
||||
}
|
||||
return $resp;
|
||||
}
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -12,6 +14,34 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
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 => 'application/xml',
|
||||
),
|
||||
'Execute request'
|
||||
);
|
||||
ok( ( $res->[0] == 200 or $res->[0] == 400 ), 'Response is 200 or 400' )
|
||||
or explain( $res->[0], "200 or 400" );
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/xml#,
|
||||
'Content is XML' )
|
||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||
count(4);
|
||||
return $res;
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -139,40 +169,6 @@ count($maintests);
|
|||
clean_sessions();
|
||||
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 => 'application/xml',
|
||||
),
|
||||
'Execute request'
|
||||
);
|
||||
ok( ( $res->[0] == 200 or $res->[0] == 400 ), 'Response is 200 or 400' )
|
||||
or explain( $res->[0], "200 or 400" );
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^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] } ) );
|
||||
count(4);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -12,6 +14,33 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
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 => 'application/xml',
|
||||
),
|
||||
'Execute request'
|
||||
);
|
||||
expectOK($res);
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^application/xml#,
|
||||
'Content is XML' )
|
||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||
count(3);
|
||||
return $res;
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -192,39 +221,6 @@ done_testing( count() );
|
|||
|
||||
no warnings 'redefine';
|
||||
|
||||
# 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 => 'application/xml',
|
||||
),
|
||||
'Execute request'
|
||||
);
|
||||
expectOK($res);
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#^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] } ) );
|
||||
count(3);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -13,6 +15,16 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
LWP::Protocol::PSGI->register(
|
||||
sub {
|
||||
my $req = Plack::Request->new(@_);
|
||||
fail('POST should not launch SOAP requests');
|
||||
count(1);
|
||||
return [ 500, [], [] ];
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -189,17 +201,6 @@ count($maintests);
|
|||
clean_sessions();
|
||||
done_testing( count() );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
no warnings 'redefine';
|
||||
|
||||
sub LWP::UserAgent::request {
|
||||
my ( $self, $req ) = @_;
|
||||
fail('POST should not launch SOAP requests');
|
||||
my $httpResp = HTTP::Response->new(500);
|
||||
count(1);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -13,6 +15,16 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
LWP::Protocol::PSGI->register(
|
||||
sub {
|
||||
my $req = Plack::Request->new(@_);
|
||||
fail('POST should not launch SOAP requests');
|
||||
count(1);
|
||||
return [ 500, [], [] ];
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -208,17 +220,6 @@ count($maintests);
|
|||
clean_sessions();
|
||||
done_testing( count() );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
no warnings 'redefine';
|
||||
|
||||
sub LWP::UserAgent::request {
|
||||
my ( $self, $req ) = @_;
|
||||
fail('POST should not launch SOAP requests');
|
||||
my $httpResp = HTTP::Response->new(500);
|
||||
count(1);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -13,6 +15,16 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
LWP::Protocol::PSGI->register(
|
||||
sub {
|
||||
my $req = Plack::Request->new(@_);
|
||||
fail('POST should not launch SOAP requests');
|
||||
count(1);
|
||||
return [ 500, [], [] ];
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -169,17 +181,6 @@ count($maintests);
|
|||
clean_sessions();
|
||||
done_testing( count() );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
no warnings 'redefine';
|
||||
|
||||
sub LWP::UserAgent::request {
|
||||
my ( $self, $req ) = @_;
|
||||
fail('Redirect should not launch SOAP requests');
|
||||
my $httpResp = HTTP::Response->new(500);
|
||||
count(1);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -13,6 +15,16 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
LWP::Protocol::PSGI->register(
|
||||
sub {
|
||||
my $req = Plack::Request->new(@_);
|
||||
fail('POST should not launch SOAP requests');
|
||||
count(1);
|
||||
return [ 500, [], [] ];
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -216,17 +228,6 @@ count($maintests);
|
|||
clean_sessions();
|
||||
done_testing( count() );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
no warnings 'redefine';
|
||||
|
||||
sub LWP::UserAgent::request {
|
||||
my ( $self, $req ) = @_;
|
||||
fail('Redirect should not launch SOAP requests');
|
||||
my $httpResp = HTTP::Response->new(500);
|
||||
count(1);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -14,6 +16,16 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
LWP::Protocol::PSGI->register(
|
||||
sub {
|
||||
my $req = Plack::Request->new(@_);
|
||||
fail('POST should not launch SOAP requests');
|
||||
count(1);
|
||||
return [ 500, [], [] ];
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -184,17 +196,6 @@ count($maintests);
|
|||
eval { unlink 't/userdb.db' };
|
||||
done_testing( count() );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
no warnings 'redefine';
|
||||
|
||||
sub LWP::UserAgent::request {
|
||||
my ( $self, $req ) = @_;
|
||||
fail('POST should not launch SOAP requests');
|
||||
my $httpResp = HTTP::Response->new(500);
|
||||
count(1);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -13,6 +15,16 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
LWP::Protocol::PSGI->register(
|
||||
sub {
|
||||
my $req = Plack::Request->new(@_);
|
||||
fail('POST should not launch SOAP requests');
|
||||
count(1);
|
||||
return [ 500, [], [] ];
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -172,17 +184,6 @@ count($maintests);
|
|||
clean_sessions();
|
||||
done_testing( count() );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
no warnings 'redefine';
|
||||
|
||||
sub LWP::UserAgent::request {
|
||||
my ( $self, $req ) = @_;
|
||||
fail('POST should not launch SOAP requests');
|
||||
my $httpResp = HTTP::Response->new(500);
|
||||
count(1);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -13,6 +15,16 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
LWP::Protocol::PSGI->register(
|
||||
sub {
|
||||
my $req = Plack::Request->new(@_);
|
||||
fail('POST should not launch SOAP requests');
|
||||
count(1);
|
||||
return [ 500, [], [] ];
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso";
|
||||
if ($@) {
|
||||
|
@ -115,17 +127,6 @@ count($maintests);
|
|||
clean_sessions();
|
||||
done_testing( count() );
|
||||
|
||||
# Redefine LWP methods for tests
|
||||
no warnings 'redefine';
|
||||
|
||||
sub LWP::UserAgent::request {
|
||||
my ( $self, $req ) = @_;
|
||||
fail('Redirect should not launch SOAP requests');
|
||||
my $httpResp = HTTP::Response->new(500);
|
||||
count(1);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More; # skip_all => 'CAS is in rebuild';
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -11,7 +13,46 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
no warnings 'redefine';
|
||||
# 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 $query = $3;
|
||||
my $res;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
if ( $req->method eq 'POST' ) {
|
||||
my $s = $req->content;
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
$url, IO::String->new($s),
|
||||
length => length($s),
|
||||
query => $query,
|
||||
type => 'application/xml',
|
||||
),
|
||||
"Execute POST request to $url"
|
||||
);
|
||||
}
|
||||
else {
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
$url,
|
||||
type => 'application/xml',
|
||||
query => $query,
|
||||
),
|
||||
"Execute request to $url"
|
||||
);
|
||||
}
|
||||
expectOK($res);
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#xml#, 'Content is XML' )
|
||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||
count(3);
|
||||
return $res;
|
||||
}
|
||||
);
|
||||
|
||||
ok( $issuer = issuer(), 'Issuer portal' );
|
||||
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
||||
|
@ -130,8 +171,8 @@ ok(
|
|||
);
|
||||
count(1);
|
||||
expectRedirection( $res, 'http://auth.sp.com/?logout' );
|
||||
ok( getHeader( $res, 'Content-Security-Policy' ) !~ /frame-ancestors/,
|
||||
' Frame can be embedded' )
|
||||
my $h = getHeader( $res, 'Content-Security-Policy' );
|
||||
ok( ( not $h or $h !~ /frame-ancestors/ ), ' Frame can be embedded' )
|
||||
or explain( $res->[1],
|
||||
'Content-Security-Policy does not contain a frame-ancestors' );
|
||||
count(1);
|
||||
|
@ -154,53 +195,6 @@ expectRedirection( $res,
|
|||
clean_sessions();
|
||||
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 $query = $3;
|
||||
my $res;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
if ( $req->method eq 'POST' ) {
|
||||
my $s = $req->content;
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
$url, IO::String->new($s),
|
||||
length => length($s),
|
||||
query => $query,
|
||||
type => 'application/xml',
|
||||
),
|
||||
"Execute POST request to $url"
|
||||
);
|
||||
}
|
||||
else {
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
$url,
|
||||
type => 'application/xml',
|
||||
query => $query,
|
||||
),
|
||||
"Execute request to $url"
|
||||
);
|
||||
}
|
||||
expectOK($res);
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#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] } ) );
|
||||
count(3);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More; # skip_all => 'CAS is in rebuild';
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -11,7 +13,46 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
no warnings 'redefine';
|
||||
# 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 $query = $3;
|
||||
my $res;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
if ( $req->method eq 'POST' ) {
|
||||
my $s = $req->content;
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
$url, IO::String->new($s),
|
||||
length => length($s),
|
||||
query => $query,
|
||||
type => 'application/xml',
|
||||
),
|
||||
"Execute POST request to $url"
|
||||
);
|
||||
}
|
||||
else {
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
$url,
|
||||
type => 'application/xml',
|
||||
query => $query,
|
||||
),
|
||||
"Execute request to $url"
|
||||
);
|
||||
}
|
||||
expectOK($res);
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#xml#, 'Content is XML' )
|
||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||
count(3);
|
||||
return $res;
|
||||
}
|
||||
);
|
||||
|
||||
ok( $issuer = issuer(), 'Issuer portal' );
|
||||
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
||||
|
@ -140,8 +181,8 @@ ok(
|
|||
);
|
||||
count(1);
|
||||
expectRedirection( $res, 'http://auth.sp.com/?logout' );
|
||||
ok( getHeader( $res, 'Content-Security-Policy' ) !~ /frame-ancestors/,
|
||||
' Frame can be embedded' )
|
||||
my $h = getHeader( $res, 'Content-Security-Policy' );
|
||||
ok( ( not $h or $h !~ /frame-ancestors/ ), ' Frame can be embedded' )
|
||||
or explain( $res->[1],
|
||||
'Content-Security-Policy does not contain a frame-ancestors' );
|
||||
count(1);
|
||||
|
@ -167,53 +208,6 @@ expectRedirection( $res,
|
|||
clean_sessions();
|
||||
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([^\?]*)(?:\?(.*))?$#,
|
||||
' Request to ' . $req->uri );
|
||||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $query = $3;
|
||||
my $res;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
if ( $req->method eq 'POST' ) {
|
||||
my $s = $req->content;
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
$url, IO::String->new($s),
|
||||
length => length($s),
|
||||
query => $query,
|
||||
type => 'application/xml',
|
||||
),
|
||||
" Execute POST request to $url"
|
||||
);
|
||||
}
|
||||
else {
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
$url,
|
||||
type => 'application/xml',
|
||||
query => $query,
|
||||
),
|
||||
" Execute request to $url"
|
||||
);
|
||||
}
|
||||
expectOK($res);
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#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] } ) );
|
||||
count(3);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More; # skip_all => 'CAS is in rebuild';
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -11,7 +13,44 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
no warnings 'redefine';
|
||||
# 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([^\?]*)(?:\?(.*))?$#,
|
||||
' Request to ' . $req->uri );
|
||||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $query = $3;
|
||||
my $res;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
if ( $req->method eq 'POST' ) {
|
||||
my $s = $req->content;
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
$url, IO::String->new($s),
|
||||
length => length($s),
|
||||
query => $query,
|
||||
type => 'application/xml',
|
||||
),
|
||||
" Execute POST request to $url"
|
||||
);
|
||||
}
|
||||
else {
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
$url,
|
||||
type => 'application/xml',
|
||||
query => $query,
|
||||
),
|
||||
" Execute request to $url"
|
||||
);
|
||||
}
|
||||
expectOK($res);
|
||||
count(2);
|
||||
return $res;
|
||||
}
|
||||
);
|
||||
|
||||
ok( $issuer = issuer(), 'Issuer portal' );
|
||||
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::_onReload;
|
||||
|
@ -140,8 +179,8 @@ ok(
|
|||
);
|
||||
count(1);
|
||||
expectRedirection( $res, 'http://auth.sp.com/?logout' );
|
||||
ok( getHeader( $res, 'Content-Security-Policy' ) !~ /frame-ancestors/,
|
||||
' Frame can be embedded' )
|
||||
my $h = getHeader( $res, 'Content-Security-Policy' );
|
||||
ok( ( not $h or $h !~ /frame-ancestors/ ), ' Frame can be embedded' )
|
||||
or explain( $res->[1],
|
||||
'Content-Security-Policy does not contain a frame-ancestors' );
|
||||
count(1);
|
||||
|
@ -167,51 +206,6 @@ expectRedirection( $res,
|
|||
clean_sessions();
|
||||
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([^\?]*)(?:\?(.*))?$#,
|
||||
' Request to ' . $req->uri );
|
||||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $query = $3;
|
||||
my $res;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
if ( $req->method eq 'POST' ) {
|
||||
my $s = $req->content;
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
$url, IO::String->new($s),
|
||||
length => length($s),
|
||||
query => $query,
|
||||
type => 'application/xml',
|
||||
),
|
||||
" Execute POST request to $url"
|
||||
);
|
||||
}
|
||||
else {
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
$url,
|
||||
type => 'application/xml',
|
||||
query => $query,
|
||||
),
|
||||
" Execute request to $url"
|
||||
);
|
||||
}
|
||||
expectOK($res);
|
||||
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] } ) );
|
||||
count(2);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More; # skip_all => 'CAS is in rebuild';
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -13,7 +15,46 @@ my $debug = 'error';
|
|||
my ( $issuer, $sp, $res );
|
||||
my %handlerOR = ( issuer => [], sp => [] );
|
||||
|
||||
no warnings 'redefine';
|
||||
# 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 $query = $3;
|
||||
my $res;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
if ( $req->method eq 'POST' ) {
|
||||
my $s = $req->content;
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
$url, IO::String->new($s),
|
||||
length => length($s),
|
||||
query => $query,
|
||||
type => 'application/xml',
|
||||
),
|
||||
"Execute POST request to $url"
|
||||
);
|
||||
}
|
||||
else {
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
$url,
|
||||
type => 'application/xml',
|
||||
query => $query,
|
||||
),
|
||||
"Execute request to $url"
|
||||
);
|
||||
}
|
||||
expectOK($res);
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#xml#, 'Content is XML' )
|
||||
or explain( $res->[1], 'Content-Type => application/xml' );
|
||||
count(3);
|
||||
return $res;
|
||||
}
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
eval { require DBI; require DBD::SQLite; };
|
||||
|
@ -167,53 +208,6 @@ count($maintests);
|
|||
eval { unlink 't/userdb.db' };
|
||||
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([^\?]*)(?:\?(.*))?$#,
|
||||
' Request to ' . $req->uri );
|
||||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $query = $3;
|
||||
my $res;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
if ( $req->method eq 'POST' ) {
|
||||
my $s = $req->content;
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
$url, IO::String->new($s),
|
||||
length => length($s),
|
||||
query => $query,
|
||||
type => 'application/xml',
|
||||
),
|
||||
" Execute POST request to $url"
|
||||
);
|
||||
}
|
||||
else {
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
$url,
|
||||
type => 'application/xml',
|
||||
query => $query,
|
||||
),
|
||||
" Execute request to $url"
|
||||
);
|
||||
}
|
||||
expectOK($res);
|
||||
ok( getHeader( $res, 'Content-Type' ) =~ m#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] } ) );
|
||||
count(3);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
@Lemonldap::NG::Handler::Main::_onReload = @{
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -11,6 +13,57 @@ my $debug = 'error';
|
|||
my ( $op, $rp, $res );
|
||||
my %handlerOR = ( op => [], rp => [] );
|
||||
|
||||
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 [ 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;
|
||||
}
|
||||
);
|
||||
|
||||
# Initialization
|
||||
ok( $op = op(), 'OP portal' );
|
||||
|
||||
|
@ -149,65 +202,6 @@ expectReject($res);
|
|||
clean_sessions();
|
||||
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 {
|
||||
my $type = shift;
|
||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -12,6 +14,57 @@ my $maintests = 18;
|
|||
my ( $op, $rp, $res );
|
||||
my %handlerOR = ( op => [], rp => [] );
|
||||
|
||||
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: {
|
||||
eval { require DBI; require DBD::SQLite; };
|
||||
if ($@) {
|
||||
|
@ -186,65 +239,6 @@ count($maintests);
|
|||
eval { unlink 't/userdb.db' };
|
||||
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 {
|
||||
my $type = shift;
|
||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -11,6 +13,57 @@ my $debug = 'error';
|
|||
my ( $op, $rp, $res );
|
||||
my %handlerOR = ( op => [], rp => [] );
|
||||
|
||||
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 [ 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;
|
||||
}
|
||||
);
|
||||
|
||||
# Initialization
|
||||
ok( $op = op(), 'OP portal' );
|
||||
|
||||
|
@ -218,65 +271,6 @@ expectRedirection( $res, qr#^http://auth.rp.com/# );
|
|||
clean_sessions();
|
||||
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 {
|
||||
my $type = shift;
|
||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -11,6 +13,57 @@ my $debug = 'error';
|
|||
my ( $op, $rp, $res );
|
||||
my %handlerOR = ( op => [], rp => [] );
|
||||
|
||||
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 [ 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;
|
||||
}
|
||||
);
|
||||
|
||||
# Initialization
|
||||
ok( $op = op(), 'OP portal' );
|
||||
|
||||
|
@ -99,63 +152,6 @@ count(5);
|
|||
clean_sessions();
|
||||
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] } ) );
|
||||
}
|
||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
||||
count(4);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -11,6 +13,57 @@ my $debug = 'error';
|
|||
my ( $op, $rp, $res );
|
||||
my %handlerOR = ( op => [], rp => [] );
|
||||
|
||||
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 [ 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;
|
||||
}
|
||||
);
|
||||
|
||||
# Initialization
|
||||
ok( $op = op(), 'OP portal' );
|
||||
|
||||
|
@ -90,63 +143,6 @@ count(5);
|
|||
clean_sessions();
|
||||
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] } ) );
|
||||
}
|
||||
$httpResp->content( join( '', @{ $res->[2] } ) );
|
||||
count(4);
|
||||
return $httpResp;
|
||||
}
|
||||
|
||||
sub switch {
|
||||
my $type = shift;
|
||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
use Test::More;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use LWP::UserAgent;
|
||||
use inc::LWP::Protocol::PSGI;
|
||||
use MIME::Base64;
|
||||
|
||||
BEGIN {
|
||||
|
@ -11,6 +13,57 @@ my $debug = 'error';
|
|||
my ( $op, $rp, $res );
|
||||
my %handlerOR = ( op => [], rp => [] );
|
||||
|
||||
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 [ 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;
|
||||
}
|
||||
);
|
||||
|
||||
# Initialization
|
||||
ok( $op = op(), 'OP portal' );
|
||||
|
||||
|
@ -64,65 +117,6 @@ count(1);
|
|||
clean_sessions();
|
||||
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 {
|
||||
my $type = shift;
|
||||
pass( '==> Switching to ' . uc($type) . ' <==' );
|
||||
|
|
Loading…
Reference in New Issue
Block a user