Use inc::LWP::Protocol::PSGI in tests instead of redefining LWP::UserAgent methods (#595)

This commit is contained in:
Xavier Guimard 2018-04-09 22:56:14 +02:00
parent d01a453f4e
commit 89e818d407
20 changed files with 687 additions and 729 deletions

View File

@ -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;
}

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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 = @{

View File

@ -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) . ' <==' );

View File

@ -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) . ' <==' );

View File

@ -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) . ' <==' );

View File

@ -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) . ' <==' );

View File

@ -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) . ' <==' );

View File

@ -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) . ' <==' );