433 lines
12 KiB
Perl
433 lines
12 KiB
Perl
# Base library for portal tests
|
|
package main;
|
|
|
|
use strict;
|
|
use Data::Dumper;
|
|
use LWP::UserAgent;
|
|
use URI::Escape;
|
|
use Lemonldap::NG::Common::FormEncode;
|
|
use 5.10.0;
|
|
|
|
no warnings 'redefine';
|
|
|
|
BEGIN {
|
|
use_ok('Lemonldap::NG::Portal::Main');
|
|
}
|
|
|
|
our $count = 1;
|
|
$Data::Dumper::Deparse = 1;
|
|
$Data::Dumper::Sortkeys = 1;
|
|
$Data::Dumper::Useperl = 1;
|
|
my $ini;
|
|
|
|
sub count {
|
|
my $c = shift;
|
|
$count += $c if ($c);
|
|
return $count;
|
|
}
|
|
|
|
sub main::explain {
|
|
my ( $get, $ref ) = @_;
|
|
$get = Dumper($get) if ( ref $get );
|
|
diag("Expect $ref, get $get\n");
|
|
}
|
|
|
|
sub clean_sessions {
|
|
opendir D, 't/sessions' or die $!;
|
|
foreach ( grep { /^[^\.]/ } readdir(D) ) {
|
|
unlink "t/sessions/$_", "t/sessions/lock/Apache-Session-$_.lock";
|
|
}
|
|
foreach my $dir (qw(t/sessions/lock t/sessions/saml/lock t/sessions/saml)) {
|
|
if ( -d $dir ) {
|
|
opendir D, $dir or die $!;
|
|
foreach ( grep { /^[^\.]/ } readdir(D) ) {
|
|
unlink "$dir/$_";
|
|
}
|
|
}
|
|
}
|
|
my $cache = getCache();
|
|
$cache->clear;
|
|
}
|
|
|
|
sub getCache {
|
|
require Cache::FileCache;
|
|
return Cache::FileCache->new(
|
|
{
|
|
namespace => 'lemonldap-ng-session',
|
|
cache_root => 't/',
|
|
cache_depth => 0,
|
|
}
|
|
);
|
|
}
|
|
|
|
sub expectRedirection {
|
|
my ( $res, $location ) = @_;
|
|
ok( $res->[0] == 302, ' Get redirection' )
|
|
or explain( $res->[0], 302 );
|
|
count(1);
|
|
if ( ref $location ) {
|
|
my @match;
|
|
@match = ( getRedirection($res) =~ $location );
|
|
ok( @match, ' Location header found' )
|
|
or explain( $res->[1], "Location match: " . Dumper($location) );
|
|
count(1);
|
|
return @match;
|
|
}
|
|
else {
|
|
ok( getRedirection($res) eq $location, " Location is $location" )
|
|
or explain( $res->[1], "Location => $location" );
|
|
count(1);
|
|
}
|
|
}
|
|
|
|
sub expectAutoPost {
|
|
my @r = expectForm(@_);
|
|
my $method = pop @r;
|
|
ok( $method =~ /^post$/i, ' Method is POST' ) or explain( \@r, 'POST' );
|
|
count(1);
|
|
return @r;
|
|
}
|
|
|
|
sub expectForm {
|
|
my ( $res, $hostRe, $uriRe, @requiredFields ) = @_;
|
|
expectOK($res);
|
|
count(1);
|
|
if (
|
|
ok(
|
|
$res->[2]->[0] =~
|
|
m@<form.+?action="(?:(?:http://([^/]+))?(/.*?)?|(#))".+method="(post|get)"@is,
|
|
' Page contains a form'
|
|
)
|
|
)
|
|
{
|
|
my ( $host, $uri, $hash, $method ) = ( $1, $2, $3, $4 );
|
|
if ( $hash and $hash eq '#' ) {
|
|
$host = '#';
|
|
$uri = '';
|
|
}
|
|
if ($hostRe) {
|
|
if ( ref $hostRe ) {
|
|
ok( $host =~ $hostRe, ' Host match' )
|
|
or explain( $host, $hostRe );
|
|
}
|
|
else {
|
|
ok( $host eq $hostRe, ' Host match' )
|
|
or explain( $host, $hostRe );
|
|
}
|
|
count(1);
|
|
}
|
|
if ($uriRe) {
|
|
if ( ref $uriRe ) {
|
|
ok( $uri =~ $uriRe, ' URI match' ) or explain( $uri, $uriRe );
|
|
}
|
|
else {
|
|
ok( $uri eq $uriRe, ' URI match' ) or explain( $uri, $uriRe );
|
|
}
|
|
count(1);
|
|
}
|
|
my %fields =
|
|
( $res->[2]->[0] =~
|
|
m#<input.+?name="([^"]+)"[^>]+?value="([^"]*?)"#gs );
|
|
my $query = join( '&',
|
|
map { "$_=" . uri_escape( uri_unescape( $fields{$_} ) ) }
|
|
keys(%fields) );
|
|
foreach my $f (@requiredFields) {
|
|
ok( defined $fields{$f}, qq{ Field "$f" is defined} );
|
|
count(1);
|
|
}
|
|
exceptCspFormOK( $res, $host );
|
|
return ( $host, $uri, $query, $method );
|
|
}
|
|
else {
|
|
return ();
|
|
}
|
|
}
|
|
|
|
sub expectAuthenticatedAs {
|
|
my ( $res, $user ) = @_;
|
|
ok( getHeader( $res, 'Lm-Remote-User' ) eq $user,
|
|
" Authenticated as $user" )
|
|
or explain( $res->[1], "Lm-Remote-User => $user" );
|
|
count(1);
|
|
}
|
|
|
|
sub expectOK {
|
|
my ($res) = @_;
|
|
ok( $res->[0] == 200, ' HTTP code is 200' ) or explain( $res, 200 );
|
|
count(1);
|
|
}
|
|
|
|
sub expectBadRequest {
|
|
my ($res) = @_;
|
|
ok( $res->[0] == 400, ' HTTP code is 400' ) or explain( $res->[0], 400 );
|
|
count(1);
|
|
}
|
|
|
|
sub expectReject {
|
|
my ( $res, $code ) = @_;
|
|
ok( $res->[0] == 401, ' Response is 401' ) or explain( $res->[0], 401 );
|
|
eval { $res = JSON::from_json( $res->[2]->[0] ) };
|
|
ok( not($@), 'Content is JSON' )
|
|
or explain( $res->[2]->[0], 'JSON content' );
|
|
if ( defined $code ) {
|
|
ok( $res->{error} == $code, "Error code is $code" )
|
|
or explain( $res->{error}, $code );
|
|
}
|
|
else {
|
|
pass("Error code is $res->{error}");
|
|
}
|
|
count(3);
|
|
}
|
|
|
|
sub expectCookie {
|
|
my ( $res, $cookieName ) = @_;
|
|
$cookieName ||= 'lemonldap';
|
|
my $cookies = getCookies($res);
|
|
my $id;
|
|
ok(
|
|
defined( $id = $cookies->{$cookieName} ),
|
|
" Get cookie $cookieName ($id)"
|
|
) or explain( $res->[1], "Set-Cookie: $cookieName=something" );
|
|
count(1);
|
|
return $id;
|
|
}
|
|
|
|
sub exceptCspFormOK {
|
|
my ( $res, $host ) = @_;
|
|
return 1 unless ($host);
|
|
my $csp = getHeader( $res, 'Content-Security-Policy' );
|
|
return 1 unless ($csp);
|
|
unless ( $csp =~ s/^.*form-action (.*?)(?:;.*)?$/$1/ ) {
|
|
$csp =~ s/^.*default-src (.*?)(?:;.*)?$/$1/;
|
|
}
|
|
if ( $csp =~ /\s\*(?:\s.*)?\s*$/
|
|
or ( $host eq '#' and $csp =~ /'self'/ )
|
|
or $csp =~ m#\bhttps?://$host\b# )
|
|
{
|
|
pass(" CSP header authorize POST request to $host");
|
|
}
|
|
else {
|
|
fail(" CSP header authorize POST request to $host");
|
|
explain( $res->[1], "form-action ... $host" );
|
|
}
|
|
count(1);
|
|
}
|
|
|
|
sub getCookies {
|
|
my ($resp) = @_;
|
|
my @hdrs = @{ $resp->[1] };
|
|
my $res = {};
|
|
while ( my $name = shift @hdrs ) {
|
|
my $v = shift @hdrs;
|
|
if ( $name eq 'Set-Cookie' ) {
|
|
if ( $v =~ /^(\w+)=([^;]*)/ ) {
|
|
$res->{$1} = $2;
|
|
}
|
|
}
|
|
}
|
|
return $res;
|
|
}
|
|
|
|
sub getHeader {
|
|
my ( $resp, $hname ) = @_;
|
|
my @hdrs = @{ $resp->[1] };
|
|
my $res = {};
|
|
while ( my $name = shift @hdrs ) {
|
|
my $v = shift @hdrs;
|
|
if ( $name eq $hname ) {
|
|
return $v;
|
|
}
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub getRedirection {
|
|
my ($resp) = @_;
|
|
return getHeader( $resp, 'Location' );
|
|
}
|
|
|
|
sub getUser {
|
|
my ($resp) = @_;
|
|
return getHeader( $resp, 'Lm-Remote-User' );
|
|
}
|
|
|
|
package LLNG::Manager::Test;
|
|
|
|
use strict;
|
|
use Mouse;
|
|
|
|
extends 'Lemonldap::NG::Common::PSGI::Cli::Lib';
|
|
|
|
our $defaultIni = {
|
|
configStorage => {
|
|
type => 'File',
|
|
dirName => 't',
|
|
},
|
|
localSessionStorage => 'Cache::FileCache',
|
|
localSessionStorageOptions => {
|
|
namespace => 'lemonldap-ng-session',
|
|
cache_root => 't/',
|
|
cache_depth => 0,
|
|
},
|
|
logLevel => 'error',
|
|
cookieName => 'lemonldap',
|
|
domain => 'example.com',
|
|
templateDir => 'site/templates',
|
|
staticPrefix => '/static',
|
|
securedCookie => 0,
|
|
https => 0,
|
|
};
|
|
|
|
has app => (
|
|
is => 'rw',
|
|
isa => 'CodeRef',
|
|
);
|
|
|
|
has p => ( is => 'rw' );
|
|
|
|
has ini => (
|
|
is => 'rw',
|
|
default => sub { $defaultIni; },
|
|
trigger => sub {
|
|
my ( $self, $ini ) = @_;
|
|
foreach my $k ( keys %$defaultIni ) {
|
|
$ini->{$k} //= $defaultIni->{$k};
|
|
}
|
|
$self->{ini} = $ini;
|
|
main::ok( $self->{p} = Lemonldap::NG::Portal::Main->new(),
|
|
'Portal object' );
|
|
main::ok( $self->{p}->init($ini), 'Init' );
|
|
main::ok( $self->{app} = $self->{p}->run(), 'Portal app' );
|
|
main::count(3);
|
|
no warnings 'redefine';
|
|
eval
|
|
'sub Lemonldap::NG::Common::Logger::Std::error {return $_[0]->warn($_[1])}';
|
|
$Lemonldap::NG::Portal::UserDB::Demo::demoAccounts{french} = {
|
|
uid => 'french',
|
|
cn => 'Frédéric Accents',
|
|
mail => 'fa@badwolf.org',
|
|
};
|
|
$Lemonldap::NG::Portal::UserDB::Demo::demoAccounts{russian} = {
|
|
uid => 'russian',
|
|
cn => 'Русский',
|
|
mail => 'ru@badwolf.org',
|
|
};
|
|
$self;
|
|
}
|
|
);
|
|
|
|
sub logout {
|
|
my ( $self, $id ) = @_;
|
|
my $res;
|
|
main::ok(
|
|
$res = $self->_get(
|
|
'/',
|
|
query => 'logout',
|
|
cookie => "lemonldap=$id",
|
|
accept => 'text/html'
|
|
),
|
|
'Logout request'
|
|
);
|
|
main::ok( $res->[0] == 200, ' Response is 200' )
|
|
or main::explain( $res->[0], 200 );
|
|
my $c;
|
|
main::ok(
|
|
( defined( $c = main::getCookies($res)->{lemonldap} ) and not $c ),
|
|
' Cookie is deleted' )
|
|
or main::explain( $res->[1], "Set-Cookie => 'lemonldap='" );
|
|
main::ok( $res = $self->_get( '/', cookie => "lemonldap=$id" ),
|
|
'Disconnect request' )
|
|
or explain( $res, '[<code>,<hdrs>,<content>]' );
|
|
main::ok( $res->[0] == 401, ' Response is 401' )
|
|
or main::explain( $res, 401 );
|
|
main::count(5);
|
|
|
|
}
|
|
|
|
sub _get {
|
|
my ( $self, $path, %args ) = @_;
|
|
return $self->app->(
|
|
{
|
|
'HTTP_ACCEPT' => $args{accept}
|
|
|| 'application/json, text/plain, */*',
|
|
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
|
|
'HTTP_CACHE_CONTROL' => 'max-age=0',
|
|
( $args{cookie} ? ( HTTP_COOKIE => $args{cookie} ) : () ),
|
|
'HTTP_HOST' => 'auth.example.com',
|
|
'HTTP_USER_AGENT' =>
|
|
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
|
|
'PATH_INFO' => $path,
|
|
( $args{referer} ? ( REFERER => $args{referer} ) : () ),
|
|
(
|
|
$args{ip} ? ( 'REMOTE_ADDR' => $args{ip} )
|
|
: ( 'REMOTE_ADDR' => '127.0.0.1' )
|
|
),
|
|
(
|
|
$args{remote_user} ? ( 'REMOTE_USER' => $args{remote_user} )
|
|
: ()
|
|
),
|
|
'REQUEST_METHOD' => $args{method} || 'GET',
|
|
'REQUEST_URI' => $path . ( $args{query} ? "?$args{query}" : '' ),
|
|
( $args{query} ? ( QUERY_STRING => $args{query} ) : () ),
|
|
'SCRIPT_NAME' => '',
|
|
'SERVER_NAME' => 'auth.example.com',
|
|
'SERVER_PORT' => '80',
|
|
'SERVER_PROTOCOL' => 'HTTP/1.1',
|
|
( $args{custom} ? %{ $args{custom} } : () ),
|
|
}
|
|
);
|
|
}
|
|
|
|
sub _post {
|
|
my ( $self, $path, $body, %args ) = @_;
|
|
die "$body must be a IO::Handle"
|
|
unless ( ref($body) and $body->can('read') );
|
|
return $self->app->(
|
|
{
|
|
'HTTP_ACCEPT' => $args{accept}
|
|
|| 'application/json, text/plain, */*',
|
|
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
|
|
'HTTP_CACHE_CONTROL' => 'max-age=0',
|
|
( $args{cookie} ? ( HTTP_COOKIE => $args{cookie} ) : () ),
|
|
'HTTP_HOST' => 'auth.example.com',
|
|
'HTTP_USER_AGENT' =>
|
|
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
|
|
'PATH_INFO' => $path,
|
|
( $args{query} ? ( QUERY_STRING => $args{query} ) : () ),
|
|
( $args{referer} ? ( REFERER => $args{referer} ) : () ),
|
|
'REMOTE_ADDR' => '127.0.0.1',
|
|
(
|
|
$args{remote_user}
|
|
? ( 'REMOTE_USER' => $args{remote_user} )
|
|
: ()
|
|
),
|
|
'REQUEST_METHOD' => $args{method} || 'POST',
|
|
'REQUEST_URI' => $path . ( $args{query} ? "?$args{query}" : '' ),
|
|
'SCRIPT_NAME' => '',
|
|
'SERVER_NAME' => 'auth.example.com',
|
|
'SERVER_PORT' => '80',
|
|
'SERVER_PROTOCOL' => 'HTTP/1.1',
|
|
( $args{custom} ? %{ $args{custom} } : () ),
|
|
'psgix.input.buffered' => 0,
|
|
'psgi.input' => $body,
|
|
'CONTENT_LENGTH' => $args{length} // scalar( ( stat $body )[7] ),
|
|
'CONTENT_TYPE' => $args{type}
|
|
|| 'application/x-www-form-urlencoded',
|
|
}
|
|
);
|
|
}
|
|
|
|
sub _delete {
|
|
my ( $self, $path, %args ) = @_;
|
|
$args{method} = 'DELETE';
|
|
return $self->_get( $path, %args );
|
|
}
|
|
|
|
sub _put {
|
|
my ( $self, $path, $body, %args ) = @_;
|
|
$args{method} = 'PUT';
|
|
return $self->_post( $path, $body, %args );
|
|
}
|
|
|
|
1;
|