App-CamelPKI
view release on metacpan or search on metacpan
lib/App/CamelPKI/CA.pm view on Meta::CPAN
my $now = App::CamelPKI::Time->now;
$crl->set_lastUpdate($now);
$crl->set_nextUpdate($now->advance_days($opts{-validity}));
$crl->set_extension
("crlNumber", sprintf("0x%x", $self->{db}->next_serial("crl")),
-critical => 1);
$crl->set_extension("authorityKeyIdentifier",
{ keyid => $self->certificate->
as_crypt_openssl_ca_x509->get_subject_keyid });
for(my $cursor = $self->{db}->search(-initially_valid_at => "now",
-revoked => 1);
$cursor->has_more; $cursor->next) {
my $serial = $cursor->certificate->get_serial;
my $time = $cursor->revocation_time;
my $reason = $cursor->revocation_reason;
my $ctime = $cursor->compromise_time;
my $holdoid = $cursor->hold_instruction;
$crl->add_entry
($serial, $time,
(defined($reason) ? (-reason => $reason) : ()),
(defined($ctime) ? (-compromise_time => $ctime) : ()),
(defined($holdoid) ? (-hold_instruction => $holdoid) : ()),
);
}
return App::CamelPKI::CRL->parse($crl->sign($self->_private_key,
lib/App/CamelPKI/CA.pm view on Meta::CPAN
Builds a list of certificates already issued by the CA and not revoked.
Certificates are returned as an array of L<App::CamelPKI::Certificate>.
=cut
sub get_certificates_issued(){
my ($self) = @_;
my @certs;
for(my $cursor = $self->{db}->search();
$cursor->has_more; $cursor->next) {
push @certs, $cursor->certificate;
}
return @certs;
}
=head2 get_certificates_revoked()
Builds a list of certificates already issued by the CA and not revoked.
Certificates are returned as an array of L<App::CamelPKI::Certificate>.
=cut
sub get_certificates_revoked(){
my ($self) = @_;
my @certs;
for(my $cursor = $self->{db}->search(-revoked => 1);
$cursor->has_more; $cursor->next) {
push @certs, $cursor->certificate;
}
return @certs;
}
=head2 get_certificate_by_serial($serial)
Builds a list of certificates already issued by the CA and not revoked.
Certificates are returned as an array of L<App::CamelPKI::Certificate>.
=cut
sub get_certificate_by_serial(){
my ($self, $serial) = @_;
for(my $cursor = $self->{db}->search( -serial=>$serial, -revoked=>undef ); $cursor->has_more; $cursor->next) {
warn "on est bon";
return $cursor->certificate;
}
}
=head2 rescind()
Cancels the ingoing transaction and let the object in an unusable
status. Invoked automatically in case of a template exception.
=cut
lib/App/CamelPKI/CA.pm view on Meta::CPAN
pass;
};
# This operation may have made the $ca object unusable, so we
# try again:
$ca = load_ca->facet_certtemplate("App::CamelPKI::CertTemplate::Foo");
$ca->issue("App::CamelPKI::CertTemplate::Foo", $pubkey,
name => "user1", uid => 1);
# A new certificate for UID 43 must revoke the old one:
my $cursor = $ca->database->search(name => "Fred");
is($cursor->revocation_time(), undef,
"The Fred's certificate is not yet revoked");
is(my $fredid = $cursor->infos->{uid}->[0], 43,
"Using CADB to get the Fred's UID")
or warn Data::Dumper::Dumper(scalar($cursor->infos));
# Fred got his operation, so he need a new certificate:
$ca->issue("App::CamelPKI::CertTemplate::Foo", $pubkey,
name => "Frida", uid => $fredid);
$cursor = $ca->database->search(name => "Fred", -revoked => undef);
isnt($cursor->revocation_time(), undef,
"the Fred certificate is revoked");
is($ca->database->search(-revoked => undef, name => "Frida")->count, 0,
q"No means to use $ca->databae to get "
. q"new certificats in preview");
$ca->issue("App::CamelPKI::CertTemplate::Foo", $pubkey,
name => "Frida", uid => 555);
pass("the template did not catched the trickery...");
try {
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
# ... making a $certificate with $serial ...
$cadb->add($cert, foo => "bar", baz => [ "quux", "bloggs" ]);
$cadb->revoke($certificate, -revocation_reason => "keyCompromise",
-compromise_time => "20070313104800Z");
$cadb->commit();
for(my $cursor = $cadb->search(-initially_valid_at => "now",
-revoked => 1);
$cursor->has_more; $cursor->next) {
my $cert = $cursor->certificate;
my %infos = $cursor->infos;
my $revocation_time = $cursor->revocation_time;
my $revocation_reason = $cursor->revocation_reason;
my $compromise_time = $cursor->compromise_time;
# ... making the CRL ...
}
=for My::Tests::Below "synopsis" end
=head1 DESCRIPTION
This class modelizes a CA database; this database store issued
certificates, nominative datas used for their creation, revocation
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
=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:
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
sub revoke {
throw App::CamelPKI::Error::Internal("WRONG_NUMBER_ARGS")
if (@_ % 2);
my ($self, $cert, %options) = @_;
throw App::CamelPKI::Error::Internal("UNIMPLEMENTED")
if ($options{-hold_instruction});
# ... And thus, I can just skip field canonicalization issues for
# now!
my $cursor = $self->{dbix}->resultset("Certificate")
->search({ der => $cert->serialize(-format => "DER") });
throw App::CamelPKI::Error::Database
("Unknown certificate", -certificate => $cert)
unless defined(my $row = $cursor->next);
throw App::CamelPKI::Error::Database
("Duplicate certificate", -certificate => $cert)
if $cursor->next;
$row->revocation_time
(App::CamelPKI::Time->parse($options{-revocation_time} || "now")
->zulu);
$row->compromise_time
(App::CamelPKI::Time->parse($options{-compromise_time})->zulu)
if (exists $options{-compromise_time});
$row->revocation_reason($options{-revocation_reason})
if (exists $options{-revocation_reason});
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
=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
why we cannot use the "streaming" mode of DBIx::Class without a complex
system of statement caching in one time, I'm just too lazy to implement
right now...
=cut
sub _fetch_certificates {
my ($self) = @_;
return if $self->{certs};
$self->{certs} = [];
$self->{cursor}->reset;
while(my $row = $self->{cursor}->next) {
push (@{$self->{certs}}, $row);
}
return;
}
=head2 _fetch_infos()
Functions as L</_fetch_certificates> (which is called before each operation
of this method), grab in one shot all nominative informations about
certificates, and cache them in $self->{infos} in the form of a reference
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
=cut
sub _fetch_infos {
my ($self) = @_;
return if $self->{infos};
$self->_fetch_certificates;
my %infos;
# FIXME: we could repeat the $self->{cursor} SQL instead.
# This could helps to play too much DBI placeholders...
my $infocursor = $self->{infos_set}->search
({ certid => { in => [ map { $_->certid } @{$self->{certs}} ] }});
$infocursor->reset;
while(my $info = $infocursor->next) {
push(@{$infos{$info->certid}->{$info->key}},
$info->val);
}
$self->{infos} = [ map { ($infos{$_->certid} || {}) }
@{$self->{certs}} ];
return;
}
=head2 _current()
Returns the tuple object currently under the cursor.
=cut
sub _current {
my ($self) = @_;
$self->_fetch_certificates;
return $self->{certs}->[$self->{index}];
}
=end internals
=head2 count
Returns the total number of entries in this cursor, independently of the number
of times L</next> has already been called.
=cut
sub count {
my ($self) = @_;
return @{$self->{certs}} if $self->{certs};
# No-camel optimization, isn't it? No! learning test of
# DBIx::Class! Syntagm found in
# L<DBIx::Class::Manual::Cookbook>.
my $count = $self->{cursor}->search
({}, {
select => [ { count => { distinct => 'me.certid' } } ],
as => [ 'count' ]
});
my $retval = $count->next->get_column("count");
$count->next; # Reach the end of records, close the statment
# subjacent handle, and so remove an useless warning.
return $retval;
}
=head2 has_more
Returns true if, and only if, the cursor has still some results to propose.
All methods hereafter have an undef behavior when I<has_more> returns false.
=cut
sub has_more { defined(shift->_current) }
=head2 next
Makes the cursor advance one position.
=cut
sub next {
my ($self) = @_;
$self->{index}++;
return;
}
=head2 certificate
Returns the certificate currently under the cursor, in a
L<App::CamelPKI::Certificate> object.
=cut
sub certificate { App::CamelPKI::Certificate->parse(shift->_current->der) }
=head2 infos
Returns a table of structures and contents simliar to the table
%infos passed to L</add> at the time of the certiticate insertion
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
=head2 revocation_time
=head2 revocation_reason
=head2 compromise_time
=head2 hold_instruction
Returns the canonical form of the revocation informations corresponding
to the certificate present under the cursor at that time: time stamps
are in "zulu" format; I<revocation_reason()> returns a symbolic character
chains among the one listed in RFC3280 section 5.3.1; I<hold_instruction()>
returns an OID in decimal notation separated by dots (for example
C<1.2.840.10040.2.1>).
=cut
sub revocation_time { shift->_current->revocation_time }
sub revocation_reason { shift->_current->revocation_reason }
sub compromise_time { shift->_current->compromise_time }
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
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);
};
lib/App/CamelPKI/CADB.pm view on Meta::CPAN
$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
lib/App/CamelPKI/PEM.pm view on Meta::CPAN
use strict;
=head1 NAME
B<App::CamelPKI::PEM> - Base class for all model classes that manipulate
PEM strings
=head1 DESCRIPTION
L<Crypt::OpenSSL::CA::AlphabetSoup/PEM> means I<Privacy Enhanced
Mail>. The PEM system and protocol suite, an early precursor to PGP,
is all but fallen into oblivion these days; in the PKIX world, it
survives as an SMTP-safe cryptographic payload encapsulation format
that states the type of the payload (which "native" ASN.1 format like
DER, don't). The general syntax is:
-----BEGIN FOO----
<Base64-encoded ASN.1>
-----END FOO----
The I<App::CamelPKI::PEM> class is a superclass to all model classes which
root/src/css/perso.css view on Meta::CPAN
margin: 0;
padding: 0;
list-style-type: none;
}
#menu dl {
float: left;
width: 9.71em;
margin: 0 1px;
}
#menu dt {
cursor: pointer;
<!--color: #fff;--!>
text-align: center;
text-decoration: none;
font-weight: bold;
font-size: 15px;
<!--background: #000;--!>
border: 1px solid #B4B079;
}
#menu dd {
<!--border: 1px solid #B4B079;--!>
root/src/css/perso.css view on Meta::CPAN
font-family: "lucida grande";
}
/*---------------- Navigation links ------------------*/
a { color: black; }
a:link { text-decoration: none; }
a:visited { text-decoration: none; }
a:hover { text-decoration: none; }
a:active { text-decoration: none; }
a.bold { font-weight: bold; }
a.info:link { cursor:none; border-bottom: 1px dotted #333 }
a.info:visited { cursor:none; border-bottom: 1px dotted #333 }
a.info:hover { cursor:help; text-decoration: none}
a.info:active { cursor:help; text-decoration: none}
*{
margin:0;
padding:0;
}
body{
font-family:"lucida grande",helvetica,arial,sans-serif;
text-align:center;
( run in 0.273 second using v1.01-cache-2.11-cpan-4d50c553e7e )