view release on metacpan or  search on metacpan

t/lib/App/CamelPKI/Test.pm  view on Meta::CPAN

=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;

t/lib/App/CamelPKI/Test.pm  view on Meta::CPAN

PolicyConstraints ::= SEQUENCE {
     requireExplicitPolicy           [0] SkipCerts OPTIONAL,
     inhibitPolicyMapping            [1] SkipCerts OPTIONAL }

SkipCerts ::= INTEGER

-- CRL distribution points extension OID and syntax
-- id-ce-cRLDistributionPoints     OBJECT IDENTIFIER  ::=  {id-ce 31}

cRLDistributionPoints  ::= SEQUENCE OF DistributionPoint

DistributionPoint ::= SEQUENCE {
     distributionPoint       [0]     DistributionPointName OPTIONAL,
     reasons                 [1]     ReasonFlags OPTIONAL,
     cRLIssuer               [2]     GeneralNames OPTIONAL }

DistributionPointName ::= CHOICE {
     fullName                [0]     GeneralNames,
     nameRelativeToCRLIssuer [1]     RelativeDistinguishedName }

ReasonFlags ::= BIT STRING --{
--     unused                  (0),
--     keyCompromise           (1),
--     cACompromise            (2),
--     affiliationChanged      (3),
--     superseded              (4),
--     cessationOfOperation    (5),
--     certificateHold         (6),
--     privilegeWithdrawn      (7),
--     aACompromise            (8) }


-- extended key usage extension OID and syntax
-- id-ce-extKeyUsage OBJECT IDENTIFIER ::= {id-ce 37}

ExtKeyUsageSyntax ::= SEQUENCE OF KeyPurposeId

KeyPurposeId ::= OBJECT IDENTIFIER

-- extended key purpose OIDs
-- id-kp-serverAuth      OBJECT IDENTIFIER ::= { id-kp 1 }
-- id-kp-clientAuth      OBJECT IDENTIFIER ::= { id-kp 2 }
-- id-kp-codeSigning     OBJECT IDENTIFIER ::= { id-kp 3 }
-- id-kp-emailProtection OBJECT IDENTIFIER ::= { id-kp 4 }
-- id-kp-ipsecEndSystem  OBJECT IDENTIFIER ::= { id-kp 5 }
-- id-kp-ipsecTunnel     OBJECT IDENTIFIER ::= { id-kp 6 }
-- id-kp-ipsecUser       OBJECT IDENTIFIER ::= { id-kp 7 }
-- id-kp-timeStamping    OBJECT IDENTIFIER ::= { id-kp 8 }

SCHEMA

=item I<x509_decoder($name)>

Returns the same as L<Convert::ASN1/find> would when called upon an
object that would previously have L</x509_schema> fed to him.  The
difference is that I<x509_decoder> checks for errors and will
therefore never return undef.

The returned object has a C<< ->decode >> object that serves to
validate the various pieces of DER produced by OpenSSL from within the
tests.

=cut

use Convert::ASN1;
sub x509_decoder {
    my ($name) = @_;
    my $asn = Convert::ASN1->new;
    $asn->prepare(x509_schema());
    die $asn->error if $asn->error;

    my $retval = $asn->find($name);
    die "$name not found in X509 schema" if ! defined $retval;
    return $retval;
}

=item I<server_start>

Start the Catalyst server on the port number specified in C<camel_pki.yml>
(and readable in L</server_port>), do nothing if already started.

=cut

sub server_start {
    system("./script/start_stop_camel_pki.pl", "start");
    die if $?;
}

=item I<server_stop>

Stop the Catalyst server, do nothing if already stopped.

=cut

sub server_stop {
    system("./script/start_stop_camel_pki.pl", "stop");
    die if $?;
}

=item I<server_port>

Returns the port number on which the Catalyst server is (supposed) to
be running.

=cut

sub server_port {
    require App::CamelPKI;
    return App::CamelPKI->model("WebServer")->apache->https_port;
}

=item I<create_camel_pki_conf_php()>

Creates a file named C<t/php/tmp/camel_pki_conf.inc.php> which contains
PHP declarations for the host name and port number of the server, and
the administrator's certficate and private key, to be used by the PHP
tests.

=cut