view release on metacpan or  search on metacpan

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

=head2 commit()

Commits all modifications made with L</add>, L</revoke> and
L</next_serial> since the construction of this object, or the previous
call to I<commit()>, whichever is latest.  B<If commit() is not
called, no write will be made to the file system, and all
modifications will be lost!>.

=cut

sub commit {
    my ($self) = @_;
    $self->{dbix}->txn_commit();
    $self->{dbix}->txn_begin();
}

=head2 max_serial($seqname)

Returns (an approximation of) the current status of the sequence named
$seqname, ie an integer which is guaranteed to be superior or equal to
all previous values previously returned by L</next_serial>, and
strictly inferior to all values that will be returned in the future.

=cut

sub max_serial {
    my ($self, $seqname) = @_;
    my $row = $self->{dbix}->resultset("Sequence")->find_or_new
        ({name => $seqname});
    return ($row->in_storage ? $row->val : 0);
}


=head2 facet_readonly()

Returns a read-only copy of the database object: only L</search> and
L</max_serial> methods are available.

=cut

sub facet_readonly {
    my ($self) = @_;
    return bless { delegate => $self },
        "App::CamelPKI::CADB::FacetReadOnly";

    package App::CamelPKI::CADB::FacetReadOnly;

    use Class::Facet from => "App::CamelPKI::CADB",
        on_error => \&App::CamelPKI::Error::Privilege::on_facet_error,
        delegate => [qw(search max_serial)];
}

=head2 debug_statements($debugsub)

This restricted method (see L<App::CamelPKI::RestrictedClassMethod>)
installs $debugsub as the SQL request observer on all
I<App::CamelPKI::CADB> objects constructed later. This method will be
called thusly for each SQL request:

   $debugsub->($sql, @bind_values);

This mecanism is only destined for testing purposes; it should not
be used in production.

=cut

sub debug_statements : Restricted {
    my ($class, $debugsub) = @_;
    our $debugsub = $debugsub;
}

=head1 App::CamelPKI::CADB::Cursor

This class models a read only SQL cursor equivalent; instancies may be
constructed using L</search>.

An attentive reader will probably understand that's a fairly trivial
derivation of the L<DBIx::Class> API; However there is no reason to
return directly an instance of I<DBIx::Class> in L</search> because
it will violate the encapsulation of I<App::CamelPKI::CADB>. Consequence
could be a induced coupling (it should be impossible to refactor the
scheme without breaking the whole calling code), and worse, a 
privilege escape leading to a security breach (because it's also
possible to write with a I<DBIx::Class> cursor).

=cut

package App::CamelPKI::CADB::Cursor;

=begin internals

=head2 _new($realcursor, $infos_resultset)

Constructor. $realcursor is an instance of
L<DBIx::Class::ResultSet> coming from
L</App::CamelPKI::CADB::_Schema::Certificate> which represents all certificates
to be enumerated; $infos_resultset is an instance of
L<DBIx::Class::ResultSet> coming from L</App::CamelPKI::CADB::_Schema::CertInfos>
which represents the B<totality> of B<CertInfos> in database, and it's the
job of I<App::CamelPKI::CADB::Cursor> to restrict this search to what it is
interresting.

=cut

sub _new {
    my ($class, $cursor, $infos_resultset) = @_;
    return bless {
                      index => 0,
                      cursor => $cursor,
                      infos_set => $infos_resultset,
                     }, $class;
}

=head2 _fetch_certificates()

Execute the SQL request that rocks, grab in one shot all certificates
and their revocation informations, and cache them in $self->{certs}
which become a list of objects form the
L</App::CamelPKI::CADB::_Schema::Certificate>.

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

        $schema = Bogus::Schema->connect($testdsn);
        is($schema->resultset('Beware')->first->blob, $bogon,
           "bogon has persisted as planned");

        my $resultset = $schema->resultset('Beware')
            ->search({blob => $bogon});
        is($resultset->count, 1, "searching per blob 1/2");
        $resultset = $schema->resultset('Beware')
            ->search({blob => $bogon . "\0"});
        is($resultset->count, 0, "searching per blob 2/2");
};

my $cert = App::CamelPKI::Certificate->parse
    ($test_self_signed_certs{"rsa1024"});


=head2 change_db_dir()

Change the value of $testdir and recreates an empty database therein.

=cut

my $testdir;
{
    my $unique = 0;
    sub change_db_dir {
        $unique++;
        $testdir = catdir(My::Tests::Below->tempdir, "testdb$unique");
    }
}
change_db_dir();

test "initialisation of the DB" => sub {
    local $SIG{__WARN__} = sub {
    								my $warn = shift;
    								if ($warn !~ /closing dbh with active statement handles/){
    									warn shift; fail
    								} 
    							}; # Making warnings
    # fatal, such as the usual suspect "Issuing rollback() ..."

    my $db = App::CamelPKI::CADB->load($testdir);
    ok($db->isa("App::CamelPKI::CADB"));
    is($db->search()->count(), 0);
};

=head2 open_db()

Open a connection to the database for testing purposes. SQL requests
are recorded in the @queries global variable, so that tests are able
to inspect the requests they caused to be made.  If the $debug_queries
variable is set to a true value, SQL requests will also be printed to
STDERR.

=cut

our @queries;
our $debug_queries;

App::CamelPKI::CADB->debug_statements(sub {
    my ($sql, @bind_values) = @_;
    push(@queries, $sql);
    map { $_ = "<der>" if m/[\000-\010]/ } @bind_values;
    diag join(" / ", $sql, @bind_values) . "\n" if $debug_queries;
});

sub open_db {
    my $cadb = load App::CamelPKI::CADB($testdir);
    return $cadb;
}

test "->add()" => sub {
    my $cadb = open_db;
    $cadb->add($cert, template => "foobar");
    try {
        $cadb->add($cert, zoinx => ["deux", "mille" ]);
        fail("inserting doubled bloom prohibited");
    } catch App::CamelPKI::Error::Database with {
        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);