App-CamelPKI

 view release on metacpan or  search on metacpan

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

sub certificate {
    my ($self) = @_;
    $self->{certificate} ||= App::CamelPKI::Certificate->load
        ($self->_certificate_path);
}

=head2 issue($certtemplate, $pubkey, $key1 => $val1, ...)

Issue on to many new certificates. $pubkey is a public key, in the
form of an L<App::CamelPKI::PublicKey> object. $certtemplate is the name
of a subclass of L<App::CamelPKI::CertTemplate>; $key1 => $val1, ... are
nominatives parameters to pass to $certtemplate for him to generate
associated certificates (see details in 
L<App::CamelPKI::CertTemplate/prepare_certificate> and
L<App::CamelPKI::CertTemplate/list_keys>).

Internally, I<sign> control arguments, and the calls

  $certtemplate->test_certificate_conflict($db, $key1 => $val1, ...)

to verify if the certificate to create is compliant to the existing
certificates. If it's ok, I<sign> invokes

  $certtemplate->prepare_certificate($cacert, $newcert, $key1 => $val1, ...)

At last, I<sign> fix the serial number, conforming to the current CA status,
and records the certificate in database. The certificate may then be retrieved
using L</commit>.

=cut

sub issue {
    my ($self, $template, $pubkey, @opts) = @_;

    # Note the explicit class call: so the template has no authority
    # to overload this method at will.
    my %dbopts = $template->App::CamelPKI::CertTemplate::normalize_opts(@opts);
    delete $dbopts{time}; # Sémantique réservée
    $dbopts{template} = $template;
    my %templateopts = %dbopts;
    $templateopts{time} = App::CamelPKI::Time->now->zulu;

    foreach my $conflictcert
        ($template->test_certificate_conflict
         ($self->database_facet($template), %templateopts)) {
        # FIXME: should be more flexible (refuse the operation
        # instead of revoking conflicting certificates, or give the
        # "superseded" reason in the CRL...)
        $self->revoke($template, $conflictcert) unless
            grep {$conflictcert->equals($_->{cert})} @{$self->{signed}};
    }

    my $cert = Crypt::OpenSSL::CA::X509->new
        ($pubkey->as_crypt_openssl_ca_publickey);
    $template->prepare_certificate
        ($self->certificate, $cert, %templateopts);
    $cert->set_serial(sprintf("0x%x",
                              $self->{db}->next_serial("certificate")));
    $cert = App::CamelPKI::Certificate->parse
        ($cert->sign($self->_private_key,
                     $template->signature_hash));
    push @{$self->{signed}}, { cert => $cert, opts => \%dbopts };
    return;
}

=head2 revoke($certtemplate, $certificate, %options)

Marks $certificate, an object of the L<App::CamelPKI::Certificate> class,
which has been certified via the $certtemplate template, as revoked.
It's prohibited to revoke a certificate that has just been certified
in the current transaction (see L</Coherence>); If this situation
is detected, triggers an exception. In the same way, the template
may cause additional revocations following the revocation of
 $certificate (see L<App::CamelPKI::CertTemplate/test_cascaded_revocation>).

This method is delegated to L<App::CamelPKI::CADB/revoke>, and recognized named
options are documented at this section.

=cut

sub revoke {
    throw App::CamelPKI::Error::Internal("WRONG_NUMBER_ARGS")
        unless (@_ % 2);
    my ($self, $template, $cert, %options) = @_;
    throw App::CamelPKI::Error::Internal("INCORRECT_ARGS")
        if (! defined $cert);

    throw App::CamelPKI::Error::Privilege
        ("Attempt to revoke a certificate foreign to this template",
         -certificate => $cert,
         -template => $template)
            unless $self->database_facet($template)
                ->search(-certificate => $cert,
                         -revoked => undef)->count;
    $self->{db}->revoke($cert, %options);
}

=head2 commit()

Records all writes in database, and returns the certificate list issued
with L</sign> scince the creation of the object or scince the previous
call to I<commit>. Certificates are returned in the form of a list of
L<App::CamelPKI::Certificate> objects, in the same order as the corresponding
call to L</sign>.

=cut

sub commit {
    my ($self) = @_;

    my @signed = @{delete($self->{signed}) || []};

    my $checks = {};
    push @{$checks->{$_->{opts}->{template}}}, $_ foreach @signed;
    $_->test_issued_certs_coherent(@{$checks->{$_}}) foreach
        (keys %$checks);

    my @retval;
    foreach my $signed (@signed) {
        $self->{db}->add($signed->{cert}, %{$signed->{opts}});

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

in database, and returns it in the form of an L<App::CamelPKI::CRL> object.

Recognized named options are:

=over

=item I<< -validity => $days >>

Allows to specify the validity duration of the CRL. Default value is 7
days.

=item I<< -signature_hash => $hashname >>

Allows to specify the cryptographic algorithm to use for the CRL
signing, on the form of a name (for example "sha256").
The default value is "sha256", as "md5" and "sha1" are not recommanded
due to progress done in their cryptanalysis
(L<http://www.win.tue.nl/~bdeweger/CollidingCertificates/>).

=back

=cut

sub issue_crl {
    throw App::CamelPKI::Error::Internal("WRONG_NUMBER_ARGS")
        unless (@_ % 2);
    my ($self, %opts) = @_;
    $opts{-validity} ||= 7;
    $opts{-signature_hash} ||= "sha256";

    my $crl = new Crypt::OpenSSL::CA::X509_CRL;
    $crl->set_issuer_DN($self->certificate->as_crypt_openssl_ca_x509
                        ->get_subject_DN);
    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,
                                           $opts{-signature_hash}));
}

=head2 get_certificates_issued()

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.

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

    BEGIN { foreach my $methname (qw(issue revoke)) {
        my $method = sub {
            my ($facetself, $trueself) = Class::Facet->selves(\@_);
            throw App::CamelPKI::Error::Privilege
                ("Unauthorized certificate template $_[0]")
                    if ($_[0] && $_[0] ne $facetself->{certtemplate});
            unshift @_, $trueself;
            goto $trueself->can($methname);
        };
        { no strict "refs"; *{"$methname"} = $method; }
    } }

  sub database {
      my $self = shift;
      return $self->{delegate}->database_facet($self->{certtemplate});
  }
}

=head2 facet_operational()

Returns a copy of this object with restricted privileges: the L</set_keys>
cannot be revoked anymore. This facet is suitable to pass to a "regular"
controller which has no rights to modify the CA keys.

Instead of returning an object which could do nothing, I<facet_operational>
throw an exception if L</is_operational> is not true.

=cut

sub facet_operational {
    my ($self) = @_;
    throw App::CamelPKI::Error::State
        ("cannot make operational facet "
         . "of non-operational CA") unless $self->is_operational;
    return bless { delegate => $self }, "App::CamelPKI::CA::FacetOperational";

    package App::CamelPKI::CA::FacetOperational;
    BEGIN { our @ISA = qw(App::CamelPKI::CA::FacetReadonly); }

    use Class::Facet delegate => [qw(issue revoke commit issue_crl get_certificates_issued get_certificates_revoked get_certificate_by_serial)];
}

=begin internals

=cut

=head1 INTERNAL METHODS

=head2 _certificate_path

=head2 _key_path

Retrun respectives access paths to the certificate and private keys, in
the directory passed to L</load>.

=cut

sub _certificate_path { catfile(shift->{cryptdir}, "ca.crt") }
sub _key_path { catfile(shift->{cryptdir}, "ca.key") }

=head2 _private_key

Returns an instance of 
L<Crypt::OpenSSL::CA/Crypt::OpenSSL::CA::PrivateKey> which modelise the
CA private key.

=cut

sub _private_key {
    my ($self) = @_;
    $self->{private_key} ||=
        Crypt::OpenSSL::CA::PrivateKey->parse
            (scalar(read_file($self->_key_path)));
}

require My::Tests::Below unless caller;

1;

__END__

=head1 TEST SUITE

=cut

use Test::More qw(no_plan);
use Test::Group;
use File::Spec::Functions qw(catdir catfile);
use Fatal qw(mkdir);
use App::CamelPKI::Certificate;
use App::CamelPKI::PrivateKey;
use App::CamelPKI::Test qw(%test_rootca_certs %test_keys_plaintext
                      %test_public_keys);
use App::CamelPKI::Error;
use App::CamelPKI::CADB;

=pod

If the following code is activated (replacing C<if (0)> by 
C<if (1)>), SQL requests done by L<App::CamelPKI::CADB> will be printed
during tests execution.

=cut

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

my $cadir = catdir(My::Tests::Below->tempdir, "test-CA");
mkdir($cadir);

sub load_ca {
    my $cadb = load App::CamelPKI::CADB($cadir);
    return load App::CamelPKI::CA($cadir, $cadb);
}

test "creation and key ceremony for a CA" => sub {
    my $ca = load_ca;
    ok(! $ca->is_operational);
    try {
        $ca->certificate;
        fail;
    } catch Error with {
        pass;
    };
    my $cert = parse App::CamelPKI::Certificate($test_rootca_certs{"rsa1024"});
    my $key = parse App::CamelPKI::PrivateKey($test_keys_plaintext{"rsa1024"});
    $ca->set_keys(-certificate => $cert, -key => $key);
    ok($ca->is_operational);