view release on metacpan or  search on metacpan

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

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

=item I<certificate_chain_invalid_ok($pem_certificate, \@certchain )>

The converse of L</certificate_chain_ok>; checks that
I<$pem_certificate> is B<not> validly signed by @certchain.  Note,
however, that there is a case where both I<certificate_chain_ok> and
I<certificate_chain_invalid_ok> both fail, and that is when @certchain
doesn't contain any B<valid> CA certificate.

=cut

sub certificate_chain_invalid_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/error/, "verify failed as expected");
    });
}

=item I<x509_schema()>

Returns the ASN.1 schema for the whole X509 specification, as a string
that L<Convert::ASN1> will grok.

=cut

sub x509_schema { <<"SCHEMA" }
-- Taken from examples/x509decode in Convert::ASN1
Attribute ::= SEQUENCE {
        type                    AttributeType,
        values                  SET OF AttributeValue
                -- at least one value is required --
        }

AttributeType ::= OBJECT IDENTIFIER

AttributeValue ::= DirectoryString  --ANY

AttributeTypeAndValue ::= SEQUENCE {
        type                    AttributeType,
        value                   AttributeValue
        }


-- naming data types --

Name ::= CHOICE { -- only one possibility for now
        rdnSequence             RDNSequence
        }
RDNSequence ::= SEQUENCE OF RelativeDistinguishedName

DistinguishedName ::= RDNSequence

RelativeDistinguishedName ::=
        SET OF AttributeTypeAndValue  --SET SIZE (1 .. MAX) OF


-- Directory string type --

DirectoryString ::= CHOICE {
        teletexString           TeletexString,  --(SIZE (1..MAX)),
        printableString         PrintableString,  --(SIZE (1..MAX)),
        bmpString               BMPString,  --(SIZE (1..MAX)),
        universalString         UniversalString,  --(SIZE (1..MAX)),
        utf8String              UTF8String,  --(SIZE (1..MAX)),
        ia5String               IA5String  --added for EmailAddress
        }


-- certificate and CRL specific structures begin here

Certificate ::= SEQUENCE  {
        tbsCertificate          TBSCertificate,
        signatureAlgorithm      AlgorithmIdentifier,
        signature               BIT STRING
        }