App-CamelPKI
view release on metacpan or search on metacpan
t/lib/App/CamelPKI/Test.pm view on Meta::CPAN
run_perl_ok(<<"SCRIPT");
use App::CamelPKI::Test;
warn "Hello world";
SCRIPT
=for My::Tests::Below "synopsis" end
=for My::Tests::Below "synopsis-asn1" begin
use App::CamelPKI::Test qw(x509_decoder);
my $dn_as_tree = x509_decoder('Name')->decode($dn_der);
=for My::Tests::Below "synopsis-asn1" end
server_start();
server_stop();
=head1 DESCRIPTION
This module is a library which aims at simplifying App-PKI test writing.
It started as a raw copy of I<Crypt::OpenSSL::CA:Test> you can find in
the C<t/lib> directory of the source L<Crypt::OpenSSL::CA> CPAN source
package.
=head1 EXPORTED FUNCTIONS
All functions described in this section factor some useful test
tactics and are exported by default. The L</SAMPLE INPUTS> may also
be exported upon request.
=over
=cut
use Test::Builder;
use Test::More;
use Test::Group;
use File::Find;
use File::Path ();
use File::Spec::Functions qw(catfile catdir);
use File::Slurp;
use File::Temp ();
use POSIX ":sys_wait_h";
use File::Which ();
use IO::Socket::SSL;
use LWP::UserAgent;
use HTTP::Request;
#pour formulaires
use URI::URL;
use HTTP::Request::Common;
use HTTP::Request::Form;
use HTML::TreeBuilder 3.0;
use base 'Exporter';
BEGIN {
our @EXPORT =
qw(openssl_path run_thru_openssl run_dumpasn1
run_perl run_perl_ok
certificate_looks_ok
certificate_chain_ok certificate_chain_invalid_ok
x509_schema x509_decoder
run_php run_php_script
http_request_prepare http_request_execute
plaintextcall_remote
call_remote formcall_remote formreq_remote
jsoncall_local jsonreq_remote jsoncall_remote
is_php_cli_present);
our @EXPORT_OK = (@EXPORT,
qw(test_simple_utf8 test_bmp_utf8
@test_DN_CAs
%test_der_DNs
%test_public_keys
%test_reqs_SPKAC %test_reqs_PKCS10
%test_keys_plaintext %test_keys_password
%test_self_signed_certs %test_rootca_certs
%test_entity_certs
test_CRL
server_start server_stop server_port
create_camel_pki_conf_php
camel_pki_chain
));
our %EXPORT_TAGS = ("default" => \@EXPORT);
}
=item I<plaintextcall_remote($url)>
Qureies a real Apache server at $url, which must be fully-qualified.
Throws an exception if the HTTP request isn't a success; otherwise,
Returns the C<text/plain> response as a string.
Available named options are:
=over
=item I<< -certificate => $certobj >>
=item I<< -certificate => $certpem >>
The certificate to identify oneself as, as an L<App::CamelPKI::Certificate>
instance or PEM string.
=item I<< -key => $keyobj >>
=item I<< -key => $keypem >>
The private key to use along with the certificate, as an
L<App::CamelPKI::PrivateKey> instance or PEM string.
=cut
sub plaintextcall_remote {
my ($url, @args) = @_;
my $req = http_request_prepare($url, @args);
my $res = http_request_execute($req, @args);
die sprintf("plain request at $url failed with code %d\n%s\n",
$res->code, $res->content)
unless $res->is_success;
die sprintf("plain request at $url returned a %s document\n%s\n",
$res->header("content-type"), $res->content)
t/lib/App/CamelPKI/Test.pm view on Meta::CPAN
=item I<run_perl_ok($scripttext)>
=item I<run_perl_ok($scripttext, \$stdout)>
=item I<run_perl_ok($scripttext, \$stdout, $testname)>
Like L</run_perl> but simultaneously asserts (using L<Test::More>)
that the exit value is successful. The return value of the sub is the
status of the assertion; the output of $scripttext (that is, the
return value of the underlying call to I<run_perl>) is transmitted to
the caller by modifying in-place the scalar reference passed as the
second argument, if any. Additionally the aforementioned output is
passed to L<Test::More/diag> if the script does exit with nonzero
status.
=cut
sub run_perl {
my ($scripttext, $outref, $testname) = @_;
Carp::croak "Bizarre first argument passed to run_perl()"
if (! defined($scripttext) || ref($scripttext));
if ($ENV{DEBUG}) {
my $scriptdir = catdir(tempdir(), "run_perl_ok");
File::Path::mkpath($scriptdir);
my $scriptfile = catfile
($scriptdir, sprintf("run_perl_ok_%d_%d", $$,
_unique_number()));
write_file($scriptfile, $scripttext);
diag(<<"FOR_CONVENIENCE");
run_perl: a copy of the script to run was saved in $scriptfile
to ease debugging.
FOR_CONVENIENCE
}
my ($perl) = ($^X =~ m/^(.*)$/); # Untainted
my @perlcmdline = ($perl, (map { -I => $_ }
(grep {! m|/usr|} @INC)), # Shame, shame.
);
diag(join(" ", @perlcmdline)) if $ENV{DEBUG};
my $stdout;
IPC::Run::run(\@perlcmdline, \$scripttext, \$stdout, \$stdout);
return $stdout;
}
sub run_perl_ok {
my ($code, $outref, $testname) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
$testname ||= "run_perl_ok";
my $out = run_perl($code);
$$outref = $out if ref($outref) eq "SCALAR";
my $retval = is($?, 0, $testname);
diag($out) if ! $retval;
return $retval;
}
=item I<certificate_looks_ok($pem_certificate)>
=item I<certificate_looks_ok($pem_certificate, $test_name)>
Checks that a certificate passed as a PEM string looks OK to OpenSSL,
meaning that the signature validates OK and OpenSSL is able to parse
it.
=cut
sub certificate_looks_ok {
my ($pem_certificate, $test_name) = @_;
$test_name ||= "certificate_looks_ok";
test $test_name => sub {
my ($out, $err);
($out, $err) =
run_thru_openssl($pem_certificate, qw(x509 -noout -text));
unless (is($?, 0, "openssl execution failed with code $?")) {
diag $err;
return;
}
unlike($out, qr/error/,
"openssl seemed to dislike the certificate");
like($out, qr/Certificate:/,
"openssl seemed not to be able to parse the certificate");
};
}
=item I<certificate_chain_ok($pem_certificate, \@certchain )>
=item I<certificate_chain_ok($pem_certificate, \@certchain , $test_name)>
Checks that a certificate passed as a PEM string is validly signed by
the certificate chain @certchain, which is a list of PEM strings
passed as a reference.
=cut
sub certificate_chain_ok {
my ($cert, $certchain, $testname) = @_;
test (($testname || "certificate_chain_ok") => sub {
my $out = _run_openssl_verify($cert, $certchain, $testname);
return if ! defined $out; # Already failed
like($out, qr/OK/, "verify successful");
unlike($out, qr/error/, "no errors");
});
}
sub _run_openssl_verify {
my ($cert, $certchain, $testname) = @_;
# This is mostly a hack to get the test suite to
# work, but CA:FALSE certificates *really* should
# not be made part of a certification chain.
my @certchain = grep {
my $out = run_thru_openssl($_, qw(x509 -noout -text));
( $out =~ m/CA:TRUE/ ) ? 1 : (warn(<<"WARNING"), 0);
$testname: ignoring a non-CA certificate that was passed as
part of the chain.
WARNING
} @$certchain;
fail("no remaining certificates in chain"), return undef
if ! @certchain;
my $bundlefile = catfile
(tempdir(), sprintf("ca-bundle-%d-%d.crt", $$,
_unique_number()));
write_file($bundlefile,
join("\n", @certchain));
return scalar run_thru_openssl($cert, qw(verify),
-CAfile => $bundlefile);
t/lib/App/CamelPKI/Test.pm view on Meta::CPAN
=cut
test "run_thru_openssl" => sub {
my $version = run_thru_openssl(undef, "version");
is($?, 0);
like($version, qr/openssl/i);
unlike($version, qr/uninitialized/); # In case there is some barfage
# going on in the forked Perls...
my ($out, $err) = run_thru_openssl(undef, "version");
is($err, ""); # Yes, this is OpenSSL. Welcome onboard.
my ($modulus, $error) =
run_thru_openssl
($App::CamelPKI::Test::test_keys_plaintext{rsa1024},
qw(rsa -modulus -noout));
is($?, 0);
like($modulus, qr/modulus=/i)
or diag $error;
run_thru_openssl(undef, "rsa");
isnt($?, 0);
};
test "run_perl and run_perl_ok" => sub {
my $out;
run_perl_ok(<<"SCRIPT_OK", \$out);
print "hello"; # STDOUT
warn "coucou"; # STDERR
SCRIPT_OK
like($out, qr/hello/);
like($out, qr/coucou/);
my $tempdir = My::Tests::Below->tempdir;
$out = run_perl(<<"SCRIPT_WRAPPER");
use Test::More qw(no_plan);
use App::CamelPKI::Test qw(run_perl_ok);
run_perl_ok <<'SCRIPT_OK';
warn "yipee";
exit 0;
SCRIPT_OK
run_perl_ok <<'SCRIPT_NOT_OK';
die "argl";
SCRIPT_NOT_OK
exit(1);
SCRIPT_WRAPPER
isnt($?, 0, "run_perl: that script shall exit with nonzero status");
like($out, qr/not ok 2/m);
unlike($out, qr/Crypt.*CA/,
"errors are reported at the proper stack depth");
# Errors must be propagated:
like($out, qr/argl/m);
# But not successes:
unlike($out, qr/yipee/m);
};
test "certificate_looks_ok" => sub {
my $ok_cert = <<'OK_CERT';
-----BEGIN CERTIFICATE-----
MIICsDCCAhmgAwIBAgIJAPV18QziY9UvMA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV
BAYTAkFVMRMwEQYDVQQIEwpTb21lLVN0YXRlMSEwHwYDVQQKExhJbnRlcm5ldCBX
aWRnaXRzIFB0eSBMdGQwHhcNMDcwMTI5MDgyODI0WhcNMDcwMjI4MDgyODI0WjBF
MQswCQYDVQQGEwJBVTETMBEGA1UECBMKU29tZS1TdGF0ZTEhMB8GA1UEChMYSW50
ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKB
gQDfGYmlOYbpGkBD/agTUnixLcdh6H1XM13w17RbzaoA7byZD6L+Dn8MZd69PuXc
ZAQEUG4Oe6QyAcafsvDb7SHjyJHLoPTOsAZ0ex/0zIJVpw+XyppA8fZx6bnuHKUa
bqfj83OLk/ACfQSBX7bcL7Y8hwYcZJcqyjMzt9BT7oCldwIDAQABo4GnMIGkMB0G
A1UdDgQWBBTu+qGX79xcvFE8pG5zx2FcqAuV5TB1BgNVHSMEbjBsgBTu+qGX79xc
vFE8pG5zx2FcqAuV5aFJpEcwRTELMAkGA1UEBhMCQVUxEzARBgNVBAgTClNvbWUt
U3RhdGUxITAfBgNVBAoTGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZIIJAPV18Qzi
Y9UvMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADgYEAFRkTlHJwSgOFQtxG
h0HHr4UES2xR+wD9xZOeFGZk066ZEdiOuUvNLYMFEe+Vo9OxAL/SdPt4oOcWremD
lTRumdcVP9vA8K4asPpXKqhpE/2EwDRmYE9g73n50yy2yazifourQmRVqSixs/ew
RSQ7/6JIpIihvyCUDUzM2bvexk8=
-----END CERTIFICATE-----
OK_CERT
certificate_looks_ok($ok_cert);
certificate_looks_ok($ok_cert . "\n"); # Robustness
my $out = run_perl(<<"SCRIPT");
use strict;
use warnings;
use Test::More qw(no_plan);
use App::CamelPKI::Test qw(certificate_looks_ok);
my \$certificate = <<'OK_CERT';
$ok_cert
OK_CERT
certificate_looks_ok(\$certificate, "OK certificate"); # expecting OK
\$certificate =~ s/CQYDVQQGE/CQYDVQQGF/;
certificate_looks_ok(\$certificate, "botched certificate"); # expecting not OK
\$certificate = <<'DUD_CERT'; # Generated with an early version of
# Crypt::OpenSSL::CA; a public key is missing
-----BEGIN CERTIFICATE-----
MIHaMEWgAwIBAgIBATANBgkqhkiG9w0BAQUFADAAMB4XDTcwMDEwMTAwMDAwMFoX
DTcwMDEwMTAwMDAwMFowADAIMAMGAQADAQAwDQYJKoZIhvcNAQEFBQADgYEAsURd
sgu7sYyODuo5bCzkYBLrYb8653jjVt8hecoQj1Ete0X6uHk6t+nJ8qCwURc4FayF
kzapy9zWAGMy+6A/9CQz5862Phf3MkFM4OwkjJARBF7I73WfVEVX4e1PIgl4qjjJ
lgiG5TCUNWQrbRGa6LVDx7DErReEJE5vRwNxvjo=
-----END CERTIFICATE-----
DUD_CERT
certificate_looks_ok(\$certificate, "REGRESSION: dud cert");
# expecting not OK, lest REGRESSION
certificate_looks_ok({}, "Should have thrown (bad input)"); # Should throw
SCRIPT
like($out, qr/^ok 1/m);
like($out, qr/^not ok 2/m);
like($out, qr/^not ok 3/m);
unlike($out, qr/^ok 4/m); # Should have died in run_thru_openssl()
unlike($out, qr/source for input redirection/,
"REGRESSION: passing undef to certificate_looks_ok() caused a strange error");
};
use App::CamelPKI::Test qw(test_CRL %test_rootca_certs);
use File::Spec::Functions qw(catfile);
test "test_CRL" => sub {
my $cafile = catfile(App::CamelPKI::Test->tempdir, "cafile");
write_file($cafile, $test_rootca_certs{"rsa1024"});
my $crl = test_CRL("rsa1024");
my $crldump = run_thru_openssl($crl, "crl", "-text",
-CAfile => $cafile);
is($?, 0);
like($crldump, qr/no revoked certificates/i);
write_file($cafile, $test_rootca_certs{"rsa2048"});
$crl = test_CRL("rsa2048", -members => [ "0x42" ]);
$crldump = run_thru_openssl($crl, "crl", "-text",
-CAfile => $cafile);
like($crldump, qr/42/);
};
my $cert_pem = $App::CamelPKI::Test::test_self_signed_certs{"rsa1024"};
# REFACTORME into App::CamelPKI::Test::pem2der or something
my $cert_der = do {
use MIME::Base64 ();
local $_ = $cert_pem;
is(scalar(s/^-+(BEGIN|END) CERTIFICATE-+$//gm), 2,
"test PEM certificate looks good") or warn $cert_pem;
MIME::Base64::decode_base64($_);
};
test "x509_decoder" => sub {
use MIME::Base64;
my $decoder = App::CamelPKI::Test::x509_decoder('Certificate');
ok($decoder->can("decode"));
my $tree = $decoder->decode($cert_der);
is($tree->{tbsCertificate}->{subjectPublicKeyInfo}
->{algorithm}->{algorithm},
"1.2.840.113549.1.1.1", "rsaEncryption");
};
=head2 Synopsis tests
=cut
test "synopsis" => sub {
# Thank you Test::Group for being fully reflexive!
eval My::Tests::Below->pod_code_snippet("synopsis");
die $@ if $@;
};
test "synopsis asn1" => sub {
my $synopsis = My::Tests::Below->pod_code_snippet("synopsis-asn1");
ok(defined(my $dn_der =
$App::CamelPKI::Test::test_der_DNs{"CN=Zoinx,C=fr"}),
"\$dn_der defined");
eval $synopsis; die $@ if $@;
pass;
};
=head2 Sample Input Validation
=cut
test "test_simple_utf8 and test_bmp_utf8" => sub {
is(length(App::CamelPKI::Test->test_simple_utf8()), 6);
ok(utf8::is_utf8(App::CamelPKI::Test->test_simple_utf8()));
is(length(App::CamelPKI::Test->test_bmp_utf8()), 3);
ok(utf8::is_utf8(App::CamelPKI::Test->test_bmp_utf8()));
};
test "%test_keys_plaintext and %test_keys_password" => sub {
is_deeply
([sort keys %App::CamelPKI::Test::test_keys_plaintext],
[sort keys %App::CamelPKI::Test::test_keys_password],
"same keys in both");
if (defined(my $openssl_bin = openssl_path)) {
while(my ($k, $v) =
each %App::CamelPKI::Test::test_keys_password) {
my ($out, $err) = run_thru_openssl
($v, qw(rsa -passin pass:secret));
is($out,
$App::CamelPKI::Test::test_keys_plaintext{$k});
}
}
( run in 2.054 seconds using v1.01-cache-2.11-cpan-97f6503c9c8 )