view release on metacpan or  search on metacpan

lib/App/CamelPKI/CADB.pm  view on Meta::CPAN

        pass;
    };

    $cadb = open_db;
    $cadb->add($cert, template => "foobar"); # Works because the
    # transaction has been rollbacked
    $cadb->add(App::CamelPKI::Certificate->parse
               ($test_entity_certs{"rsa1024"}),
               foo => "bar",
               zoinx => ["is", "tan" ],
              );
    $cadb->commit;
    is($cadb->search()->count(), 2, "certificates in base");
};

test "->search() in list context" => sub {
    my $cadb = open_db;
    my @certs = $cadb->search(-initially_valid_at => "20010101020400Z");
    is(scalar(@certs), 0);
    @certs = $cadb->search(-initially_valid_at => "now");
    is(scalar(@certs), 2, "all certificates");
    grep { ok($_->isa("App::CamelPKI::Certificate")) } @certs;

    @certs = $cadb->search(-certificate => $cert);
    is(scalar(@certs), 1);
    ok($certs[0]->equals($cert));
};

test "->search() with a cursor" => sub {
    my $cadb = open_db;
    my $cursor = $cadb->search(-revoked => undef);
    is($cursor->count, 2);
    ok($cursor->has_more);
    ok($cursor->certificate->isa("App::CamelPKI::Certificate"));
    $cursor->next;
    ok($cursor->has_more);
    ok($cursor->certificate->isa("App::CamelPKI::Certificate"));
    $cursor->next;
    ok(! $cursor->has_more);

    $cursor = $cadb->search(-revoked => undef);
    isnt($cursor->infos, undef,
         "consulting ->infos available "
         . "even if we don't look for them");

    $cursor = $cadb->search(template => "foobar", -revoked => 0);
    ok($cursor->has_more);
    is($cursor->infos->{template}->[0], "foobar");
    ok($cursor->has_more, "the cursor did not move");
    $cursor->next; ok(! $cursor->has_more);

    $cursor = $cadb->search(template => "foobar", -revoked => 1);
    ok(! $cursor->has_more);
    is($cursor->count, 0, 'Filter "and" which exclude all');

    # This one is tricky: the search matches for two reasons (zoinx =>
    # "is" and zoinx => "tan"), but we want only one response back.
    $cursor = $cadb->search(zoinx => undef);
    is($cursor->count, 1);
    is_deeply([ sort @{$cursor->infos->{zoinx}}], [qw(is tan)])
        or warn Data::Dumper::Dumper(scalar $cursor->infos);
};

test "REGRESSION: searching with multiple nominatives keys" => sub {
    my $cadb = open_db;
    my @certs = $cadb->search(foo => "bar", zoinx => "is");
    is(scalar(@certs), 1);

    @certs = $cadb->search(foo => "bar", zoinx => "is", zoinx => "tan");
    is(scalar(@certs), 1);
};

test "->revoke()" => sub {
    my $cadb = open_db;
    $cadb->revoke($cert, -revocation_reason => "keyCompromise",
                  -compromise_time => "now");
    $cadb->commit();
    is($cadb->search()->count(), 1, "only valid certificates by default");
    is($cadb->search(-revoked => undef)->count(), 2,
       "all certificates");
    is($cadb->search(-revoked => 1)->revocation_reason, "keyCompromise");
    like($cadb->search(-revoked => 1)->compromise_time,
         qr/^\d{4}\d{2}\d{2}\d{2}\d{2}\d{2}Z$/,
         "the compromise time has been canonicalized");

    $cadb->revoke($cert, -revocation_reason => "removeFromCRL");
    $cadb->commit();
    is($cadb->search()->count(), 2, "certificate redemption");
};

test "->next_serial() et ->max_serial()" => sub {
    my $cadb = open_db;
    my @serialz = map { $cadb->next_serial("corn") } (1..10);
    grep { cmp_ok($serialz[$_], ">=", 2) } (0..$#serialz);
    grep { cmp_ok($serialz[$_ - 1], "<", $serialz[$_]) } (1..$#serialz);
    my $maxserial = $cadb->max_serial("corn");
    is($cadb->max_serial("corn"), $maxserial,
       "->max_serial is idempotent");

    grep { cmp_ok($serialz[$_], "<=", $maxserial) } (0..$#serialz);
    cmp_ok($cadb->next_serial("corn"), ">", $maxserial);
};

test "real unicity for ->next_serial() and ->max_serial()" => sub {
    my $numprocs = 5; my $numincs = 10; my $numcommits = 10;
    my $resultsfile = catfile($testdir, "serialz.txt");
    my $fd = new IO::File($resultsfile, ">");
    $fd->autoflush(1);
    my @pids = map { fork_and_do {
        my $base = open_db;
        COMMIT: for my $i (1..$numcommits) {
            my $done = try {
                for my $j (1..$numincs) {
                    $fd->print($base->next_serial("zoinx") . "\n");
                }
                $base->commit;
                1;
            } catch Error with {
                my $E = shift;
                die($E) unless ($E =~ m/database is locked/i);
                select(undef, undef, undef, rand);

lib/App/CamelPKI/CADB.pm  view on Meta::CPAN

    my @lines = read_file($resultsfile);
    is(scalar(@lines), $numprocs * $numincs * $numcommits,
       "right number of lines in $resultsfile");
    my %serialz = map { $_ => 1 } (@lines);
    is(scalar(keys %serialz), scalar(@lines),
       "no collision in $resultsfile");
};

change_db_dir();
use App::CamelPKI::Test qw(%test_public_keys %test_keys_plaintext);

test "->search() and left-join request optimization"
    => sub {
  my $cadb = open_db;
  my $pubkey = Crypt::OpenSSL::CA::PublicKey
      ->parse_RSA($test_public_keys{rsa1024});
  my $privkey = Crypt::OpenSSL::CA::PrivateKey
      ->parse($test_keys_plaintext{rsa1024});

  foreach my $i (1..100) {
      my $cert_to_be = Crypt::OpenSSL::CA::X509->new($pubkey);
      $cert_to_be->set_notBefore("20070101000000Z");
      $cert_to_be->set_notAfter("20570101000000Z");
      $cert_to_be->set_serial(sprintf("0x%x", $i));
      my $cert = App::CamelPKI::Certificate->parse
          ($cert_to_be->sign($privkey, "sha256"));
      $cadb->add($cert, foo => "bar", baz => "quux");
  }
  $cadb->commit();

  @queries = ();
  my $cursor = $cadb->search(-revoked => undef);
  foreach my $i (1..100) {
      ok($cursor->has_more);
      is($cursor->infos->{foo}->[0], "bar");
      is($cursor->infos->{baz}->[0], "quux");
      $cursor->next;
  }
  ok(! $cursor->has_more);

  cmp_ok(scalar(@queries), "<", 10,
         "the number of requests is sub-linear "
         . "wrt the number of fetched certificates");
};


change_db_dir();

test "REGRESSION: searching by infos must not mask some of them"
    => sub {
    my $cadb = open_db;
    my $cert = App::CamelPKI::Certificate->parse
        ($test_self_signed_certs{"rsa2048"});
    $cadb->add($cert, foo => "bar", baz => [ "quux", "bloggs" ]);

    # Witness Experiency:
    my $cursor = $cadb->search();
    is($cursor->count, 1);
    my $infos = $cursor->infos;
    is($infos->{foo}->[0], "bar")
        or warn Data::Dumper::Dumper($infos);
    is_deeply([sort @{$infos->{baz}}], [qw(bloggs quux)]);

    # Experiency test:
    $cursor = $cadb->search(foo => "bar");
    is($cursor->count, 1);
    is_deeply(scalar($cursor->infos), $infos)
        or warn Data::Dumper::Dumper(scalar($cursor->infos));
};

change_db_dir();

test "synopsis" => sub {
    my $code = My::Tests::Below->pod_code_snippet("synopsis");
    $code =~ s/\bmy /our /g;

    my $dir = $testdir;
    my $certificate = $cert;
    eval "package Synopsis; $code"; fail($@) if $@;

    cmp_ok($Synopsis::serial, ">=", 2);
    ok($Synopsis::cadb->isa("App::CamelPKI::CADB"));
    ok($Synopsis::cursor->isa("App::CamelPKI::CADB::Cursor"));
    is($Synopsis::cert->serialize(), $certificate->serialize());
    is($Synopsis::infos{foo}->[0], "bar");
    is_deeply([sort @{$Synopsis::infos{baz}}], [qw(bloggs quux)]);
    like($Synopsis::revocation_time, qr/^\d{4}\d{2}\d{2}\d{2}\d{2}\d{2}Z$/,
         "revocation time looks ok");
    is($Synopsis::revocation_reason, "keyCompromise");
    is($Synopsis::compromise_time, "20070313104800Z");
};

=end internals

=cut