App-CamelPKI
view release on metacpan or search on metacpan
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
-IOfile => $dir);
}
$class->_connect($dir)->deploy();
return;
}
=head2 load($dir)
Restricted constructor (see L<App::CamelPKI::RestrictedClassMethod>).
Loads the database from the $dir directory and returns a read-write
object.
=cut
sub load : Restricted {
my ($class, $dir) = @_;
$class->initdb($dir);
my $self = bless
{ dbix => $class->_connect($dir),
}, $class;
$self->{dbix}->txn_begin;
if (defined(our $debugsub)) { # See L</debug_statements>
$self->{dbix}->storage->debugobj
(App::CamelPKI::CADB::_Logger->new($debugsub));
$self->{dbix}->storage->debug(1);
}
return $self;
}
=head2 add($cert, %infos)
Add a certificate to the database. $cert is an instance of
L<App::CamelPKI::Certificate> which must not be already existing.
%infos is a table of nominative informations, dealt as an opaque chain,
where keys must been validaded by the regular expression qr/[a-z0-9_]+/,
and values are character chains or references to a character chains table.
Semantics on these informations is at the caller's choice; from the
I<App::CamelPKI::CADB> point of view, these informations can be used as
search expression in L</search>, and be consulted using L</infos> in
L</App::CamelPKI::CADB::Cursor>.
=cut
sub add {
throw App::CamelPKI::Error::Internal("WRONG_NUMBER_ARGS")
if (@_ % 2);
my ($self, $cert, %infos) = @_;
my $dercert = $cert->serialize(-format => "DER");
throw App::CamelPKI::Error::Database("Certificate already entered")
if $self->{dbix}->resultset("Certificate")
->search({der => $dercert})->count;
my $certid = $self->{dbix}->resultset("Certificate")->create
({der => $dercert, serial => $cert->get_serial,
not_before => $cert->get_notBefore,
not_after => $cert->get_notAfter,
})->id;
foreach my $key (keys %infos) {
foreach my $val (ref($infos{$key}) eq "ARRAY" ? @{$infos{$key}} :
($infos{$key})) {
$self->{dbix}->resultset("CertInfo")
->create({certid => $certid,
key => $key,
val => $val});
}
}
1;
}
=head2 search(%criteria)
Search certificates that were added (L</add>) precedently, using
%criteria criteria in a conjonctive way (ie, dealt with the "AND"
operator).
If %criteria does not contain any key C<< -initially_valid_at >>
and C<< -revoked >>, then %criteria is supposed to implicitly contain
-initially_valid_at => "now", -revoked => 0
to make I<search()> returns only valid certificates (in the RFC3280
way), if not stated otherwise.
In a more general way, keys and values for %criteria are:
=over
=item I<< -certificate => $cert >>
Renvoie uniquement le certificat identique à $cert, une instance de
L<App::CamelPKI::Certificate>.
=item I<< -initially_valid_at => $time >>
Returns only certificates that were initially scheduled to be valid at
$time date, regardless of whether they have been revoked (but see also
C<< -revoked >>). In other words, returns certificates that match
notBefore <= $time && $time <= notAfter
$time is either an object of class L<App::CamelPKI::Time>, a date in the
"zulu" format (yyyymmddhhmmssZ), or the special string "now".
=item I<< -revoked => 1 >>
Returns only revoked certificates, ie those for which the most recent
call to L</revoke> did not specify C<< -reason => "removeFromCRL" >>.
=item I<< -revoked => 0 >>
Returns only valid certificates, or those that were un-revoked by
passing C<< -reason => "removeFromCRL" >> to L</revoke>.
=item I<< -revoked => undef >>
Search certificates without consideration for their revocation status.
Used to cancel the effect of the implicit value mentioned above.
=item I<< -serial => serial >>
Search certificates for the certifiate serial.
=item I<< $infokey => $infoval >>
where $infokey doesn't start by a hyphen (-): returns only
certificate(s) that had $infokey and $infoval among their %infos at
the time they where added using L</add>. $infoval may be undef,
indicating that any value for $infokey in %infos is acceptable.
=back
The return value in list context is a list of L<App::CamelPKI::Certificate>
object class. In scalar context, a B<cursor object> of the
L</App::CamelPKI::CADB::Cursor> class is returned.
=cut
sub search {
throw App::CamelPKI::Error::Internal("WRONG_NUMBER_ARGS")
unless (@_ % 2);
my ($self, %searchkeys) = @_;
if (! exists $searchkeys{-initially_valid_at} &&
! exists $searchkeys{-revoked}) {
$searchkeys{-initially_valid_at} = "now";
$searchkeys{-revoked} = 0;
}
# Using DBIx::Class release 0.07003, the join list to execute don't
# support iterative enumeration, unlike the WHERE clauses. We must
# use this dirty kludge, that violates DBIx::Class encapsulation in
# two points:
my @joins;
my $cursor = $self->{dbix}->resultset("Certificate")
->search({ }, { join => \@joins }); # Encaps violation
# number 1: we will be modifying \@joins later
while(my ($k, $v) = each %searchkeys) {
if ($k !~ m/^-/) {
push(@joins, "infos");
my $qualifier = (@joins == 1) ? "" : "_" . scalar(@joins);
# encapsulation violation number 2: we try to guess the
# way DBIx::Class disambiguates the join column names.
$cursor = $cursor->search
({ "infos${qualifier}.key" => $k,
( defined($v) ? ("infos${qualifier}.val" => $v) : () ),
});
} elsif ($k eq "-certificate") {
throw App::CamelPKI::Error::Internal("INCORRECT_ARGS")
unless eval { $v->isa("App::CamelPKI::Certificate") };
$cursor = $cursor->search
( { der => $v->serialize(-format => "DER") } );
} elsif ($k eq "-initially_valid_at") {
$v = App::CamelPKI::Time->parse($v);
$cursor = $cursor->search
( { not_before => { "<=", $v->zulu },
not_after => { " >=", $v->zulu }} );
} elsif ($k eq "-serial") {
$cursor = $cursor->search
( { serial => { "=", $v } } );
} elsif ($k eq "-revoked") {
if (! defined($v)) {
# no-op
} elsif ($v) {
# Only revoked certificates
$cursor = $cursor->search
# Yes, { "!=", undef } correctly translates to "IS
# NOT NULL". Props to SQL::Abstract!
( [ -and => { revocation_time => { "!=", undef } },
{ revocation_reason => { "!=", "removeFromCRL" } }
] );
} else {
# Only *not* revoked certificates
$cursor = $cursor->search
( [ -or => { revocation_time => { "==", undef } },
{ revocation_reason => "removeFromCRL" }
] );
}
} else {
throw App::CamelPKI::Error::Internal
("INCORRECT_ARGS", -details => "Unknown search key $k");
}
}
$cursor = (ref($self) . "::Cursor")->_new
($cursor, $self->{dbix}->resultset("CertInfo"));
return $cursor if ! wantarray;
my @retval;
for(; $cursor->has_more; $cursor->next) {
push(@retval, $cursor->certificate);
}
return @retval;
}
=head2 revoke($cert, %options)
Mark a certificate as revoked, for the CA to know it must been
included in the next CRLs. $cert is an instance of
L<App::CamelPKI::Certificate>. Known Named options are:
=over
=item I<< -revocation_time => $time >>
The revocation date, in "zulu" format (yyyymmddhhmmssZ). By default,
the current date is used.
=item I<< -revocation_reason => $reason >>
=item I<< -hold_instruction => $oid >> (B<NOT IMPLEMENTED YET>)
=item I<< -hold_instruction => $string >> (B<NOT IMPLEMENTED YET>)
=item I<< -compromise_time => $time >>
Values of the extensions of the same name in the CRL, as documented in
L<Crypt::OpenSSL::CA/add_entry>. By default, these extensions are
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
=head2 App::CamelPKI::CADB::_Schema::Certificate
An instance of this class represents a line in the C<certificate>
table, which in its turn represent a certifice (what a surprise!)
and its revocation status informations.
=cut
package App::CamelPKI::CADB::_Schema::Certificate;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw(PK::Auto Core));
__PACKAGE__->table("certificate");
__PACKAGE__->add_columns
# An unique number of certificate, which must *never be*
# visible outside of the present class.
(certid => { data_type => "integer",
is_nullable => 0,
auto_increment => 1,
},
# The certificate in the form of a DER encoded blob.
der => { data_type => "blob",
is_nullable => 0,
},
# La date de révocation, au format "zulu" à 4 chiffres pour
# l'année; ou la date de retour en grâce dans un cas d'une
# révocation temporaire abandonnée. Initialement NULL au
# moment de la certification.
# The revocation date, in "zulu" format with 4 digits for the year
# date; or the return in grace date in case of a canceled temporary
# revocation. Initially NULL at the time of the certification.
revocation_time => { data_type => "text",
is_nullable => 1,
},
# The reason for revocation, in the form of a character string
# (for example: "cessationOfOperation")
revocation_reason => { data_type => "text",
is_nullable => 1,
},
# The date of compromission, in "zulu" format.
compromise_time => { data_type => "text",
is_nullable => 1,
},
# The "hold instruction", in the form of an decimal OID notation
# separated by dots.
hold_instruction => { data_type => "text",
is_nullable => 1,
},
# Fields that follow are de-normalisations on the "der" field,
# to allow searchs.
# The serial number, on a hexadecimal textual form, used by
# Crypt::OpenSSL::CA (ie "0x1234deadbeef").
serial => {data_type => "text",
is_nullable => 0,
},
# Dates of validity for the certificate, in "zulu" format with
# 4 digit for the year date.
not_before => { data_type => "text",
is_nullable => 0 },
not_after => { data_type => "text",
is_nullable => 0 },
);
__PACKAGE__->set_primary_key("certid");
__PACKAGE__->has_many("infos",
"App::CamelPKI::CADB::_Schema::CertInfo", "certid");
=head2 App::CamelPKI::CADB::_Schema::Sequence
This class represents the "sequences" table, which contains one line
for each sequence created with L</next_serial> or L</max_serial>.
=cut
package App::CamelPKI::CADB::_Schema::Sequence;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw(Core));
__PACKAGE__->table("sequences");
__PACKAGE__->add_columns
# The name of the sequence, in minor case
(name => { data_type => "text",
is_nullable => 0,
},
# The current sequence number
val => { data_type => "integer",
is_nullable => 0,
});
__PACKAGE__->set_primary_key("name");
=head2 App::CamelPKI::CADB::_Schema
This class represents the whole database schema. Instances of this
class (created by L</_connect>) represent a connection to a concrete
database.
=cut
package App::CamelPKI::CADB::_Schema;
use base qw/DBIx::Class::Schema/;
__PACKAGE__->load_classes(qw(Certificate CertInfo Sequence));
=head3 throw_exception
Overload of the parent class to throw
L<App::CamelPKI::Error/App::CamelPKI::Error::Database>.
=cut
sub throw_exception {
my $self = shift;
throw App::CamelPKI::Error::Database(join(" ", @_));
}
=head2 App::CamelPKI::CADB::_Logger
( run in 0.501 second using v1.01-cache-2.11-cpan-5a3173703d6 )