view release on metacpan or  search on metacpan

lib/Crypt/OpenSSL/CA.pm  view on Meta::CPAN

    my $pos = 0; my @mismatched;
    RLE: foreach my $rle (@{$test_crl->{revoked_ext_count_rle}}) {
        for(my $i = $rle->{count} ; $i > 0; $i--, $pos++) {
            if ($pos > $#entries) {
                fail(sprintf("Parsing CRL yielded too few @entries (%d)", @entries));
                last RLE;
            }

            my $entry = $entries[$pos];
            push @mismatched, $pos unless scalar @{$entry->{exts}} == $rle->{ext_count};
        }
    }
    is([@mismatched], []);
};

sub christmasify_crl {
    my ($crl) = @_;
    $crl->set_issuer_DN($crl_issuer_dn);
    $crl->set_lastUpdate("20070101000000Z");
    $crl->set_nextUpdate("20570101000000Z");

    $crl->set_extension("authorityKeyIdentifier",
                        { keyid => "de:ad:be:ef",
                          issuer => $crl_issuer_dn,
                          serial => "0x41" });
    $crl->set_extension("crlNumber", "0x42deadbeef42", -critical => 1);

    $crl->set_extension("freshestCRL",
                        "URI:http://www.example.com/deltacrl.crl",
                        -critical => 0);
}

sub add_entries_to_crl {
    my ($crl) = @_;
    $crl->add_entry("0x10", "20070212100000Z");
    $crl->add_entry("0x11", "20070212100100Z", -reason => "unspecified");
    $crl->add_entry("0x42deadbeef32", "20070212090100Z",
                    -hold_instruction => "holdInstructionPickupToken");
    $crl->add_entry("0x12", "20070212100200Z", -reason => "keyCompromise",
                    -compromise_time => "20070210000000Z");
}

subtest "Christmas-tree CRL" => sub {
    my $crl = Crypt::OpenSSL::CA::X509_CRL->new();
    ok($crl->is_crlv2);
    christmasify_crl($crl);
    add_entries_to_crl($crl);
    my $crlpem = $crl->sign($cakey, "sha1");
    my ($crldump, $err) =
        run_thru_openssl($crlpem, qw(crl -noout -text));
    is($?, 0, "``openssl crl'' ran successfully")
        or die $err;
    like($crldump, qr/last update:.*2007/i);
    like($crldump, qr/next update:.*2057/i);
    like($crldump, qr/keyid.*DE:AD:BE:EF/);
    like($crldump, qr/CRL Number.*critical/i);
    # Right now OpenSSL cannot parse freshest CRL indicator:
    like($crldump, qr/deltacrl\.crl/);

    my @crlentries = split m/Serial Number: /, $crldump;
    shift(@crlentries); # Leading garbage
    my %crlentries;
    for(@crlentries) {
        if (! m/^([0-9A-F]+)(.*)$/si) {
            fail("Incorrect CRL entry\n$_\n");
            next;
        }
        $crlentries{uc($1)} = $2;
    }
    like($crlentries{"10"}, qr/Feb 12/, "revocation dates");
    like($crlentries{"11"}, qr/unspecified/i) or do {
        my $dumpasn1 = run_dumpasn1
            (run_thru_openssl($crlpem, qw(crl -outform der)));
        warn $dumpasn1;
    };
    like($crlentries{"12"}, qr/key.*compromise/i);
    like($crlentries{"12"}, qr/Invalidity Date/i);
    like($crlentries{"42DEADBEEF32"}, qr/hold/i)
        or warn $crldump;
};

subtest "CRL memory leaks" => sub {
    skip_all "Cannot check bytes leaks" if cannot_check_bytes_leaks;
    leaks_bytes_ok {
        for(1..100) {
            my $crl = Crypt::OpenSSL::CA::X509_CRL->new();
            for(1..200) { # Checks for robustness and leaks
                christmasify_crl($crl);
            }
            for(1..20) { # Not too many entries, as that would cause
                # false positives
                add_entries_to_crl($crl);
            }
            $crl->sign($cakey, "sha1");
        }
    };

    my $crlpem = $test_crls{"admin.ch"}->{pem};
    leaks_bytes_ok {
        for(1..2000) {
            my $crl = Crypt::OpenSSL::CA::X509_CRL->parse($crlpem);
            my @ignored = $crl->get_entries;
            $crl->get_issuer_DN();
            $crl->get_lastUpdate();
            $crl->get_nextUpdate();
        }
    } -max => 131072; # There's quite a lot of churn going on in ->get_entries

    leaks_SVs_ok {
        for(1..100) {
            my @ignored = Crypt::OpenSSL::CA::X509_CRL->parse($crlpem)->get_entries;
        }
    };
};

=head2 Synopsis test

We only check that it runs.  Thorough black-box testing of
I<Crypt::OpenSSL::CA> happens in C<t/> instead.