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 )