view release on metacpan or  search on metacpan

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

template may indicate to the CA that some already issued certificates are
conflicting with some of the newly asked ones in the current transaction.
For now, the CA honors the template request revoking old certificates; Future
version of this CA will be able to cancel the transaction albeith the said
certificates are already revoked, or certify bypassing the template policy.

Note that certificates created during the I<same transaction> are not
concerned by I<test_certificate_conflict()>, and will not be visible in the
database facet used by this method. To test the internal coherence of the
transaction, I<test_issued_certs_coherent()> is used, as indicated hereafter.

=item B<the certificate template may block some certificate combinations>

Using the
L<App::CamelPKI::CertTemplate/test_issued_certs_coherent> method, the certificate
template has the right of veto to cancel the transaction if it detects than
some certificates are conflicting with some others (for example because they
contains the same nominative informations).

=back

=head1 CAPABILITY DISCIPLINE

The ownership of one instance of C<App::CamelPKI::CA> gives privilege to
modify certificate an key, read certificate (but not the key), issue
a CRL, issue and revoke certificates in any existing 
L<App::CamelPKI::CertTemplate>, and to performs maintenance operations on
the database.

The L</facet_operational>, L</facet_certtemplate> and 
L</facet_readonly> facets helps to restrict theses privileges.

=cut

use Class::Facet;
use File::Spec::Functions qw(catdir catfile);
use File::Path qw(mkpath);
use File::Slurp;
use Crypt::OpenSSL::CA;
use App::CamelPKI::Error;
use App::CamelPKI::RestrictedClassMethod ':Restricted';
use App::CamelPKI::Time;
use App::CamelPKI::CADB;
use App::CamelPKI::CertTemplate;
use App::CamelPKI::Certificate;
use App::CamelPKI::PublicKey;
use App::CamelPKI::CRL;

=head1 CLASS CONSTRUCTORS AND METHODS

=head2 load($directory, $cadb)

Restricted constructor (See L<App::CamelPKI::RestrictedClassMethod>).
Load the cryptographic material (private keys and certificates)
from $directory, creating it if needed, and use $cadb, an read-write
instance of L<App::CamelPKI::CADB>, as storage backend.

=cut

sub load : Restricted {
    throw App::CamelPKI::Error::Internal("WRONG_NUMBER_ARGS") if (@_ != 3);
    my ($class, $directory, $cadb) = @_;
    if (! -d $directory) {
        mkpath($directory) or
            throw App::CamelPKI::Error::IO("cannot create directory",
                                      -IOfile => $directory);
    }
    return bless {
                  db => $cadb,
                  cryptdir => $directory,
                 }, $class;
}


=head1 METHODS

=head2 set_keys(-certificate => $cert, -key => $key)

Install the certificate and private key passed in argument in the
CA permanent storage space. The CA is unable to issue certificates
and CRLs until this step is not completed.
$cert is an L<App::CamelPKI::Certificate> object, and $key is an
L<App::CamelPKI::PrivateKey> object.

=cut

sub set_keys {
    throw App::CamelPKI::Error::Internal("WRONG_NUMBER_ARGS")
        unless (@_ % 2);
    my ($self, @args) = @_;
    while(my ($k, $v) = splice(@args, 0, 2)) {
        if ($k eq "-certificate") {
            write_file($self->_certificate_path,
                       $v->serialize(-format => "PEM"));
        } elsif ($k eq "-key") {
            write_file($self->_key_path,
                       $v->serialize(-format => "PEM"));
        } else {
            throw App::CamelPKI::Error::Internal
                ("INCORRECT_ARGS",
                 -details => "Unknown cryptographic material",
                 -type => $k);
        }
    }
}

=head2 is_operational()

Returns true only if a key and a certificate has been added to this CA
using L</set_keys>.

=cut

sub is_operational {
    my ($self) = @_;
    return (-r $self->_certificate_path && -r $self->_key_path);
}

=head2 database()

Returns a B<read only> instance of L<App::CamelPKI::CADB>> which modelise
the CA database. (The read/write access is reserved to the only 
I<App::CamelPKI::CA> class.)

=cut

sub database { shift->{db}->facet_readonly }

=head2 certificate()

Returns the CA certificate, in the form of an L<App::CamelPKI::Certificate>
object.

=cut

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}});
        push(@retval, $signed->{cert});
    }
    $self->{db}->commit;

    return @retval;
}

=head2 issue_crl(-option1 => $val1, ...)

Builds a CRL taking account of previously marked as revoked certificates
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.

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

    # Cascading facets (yow!)
    BEGIN { foreach my $methname
                (qw(facet_readonly facet_crl_only
                    facet_certtemplate facet_operational)) {
                    no strict "refs";
                    *{"$methname"} = \&{"App::CamelPKI::CA::$methname"};
                }
        }
}

=head2 facet_crl_only()

Returns a copy of this object with restricted privileges: besides the
read-only accessors (see L</facet_readonly>), a holder of a reference
to the returned object only has the right to issue a new CRL.  This is
an appropriate level of privilege to hand out to an unauthenticated
user.

=cut

sub facet_crl_only {
    return Class::Facet->make("App::CamelPKI::CA::FacetCRLOnly", shift);

    package App::CamelPKI::CA::FacetCRLOnly;
    BEGIN { our @ISA = qw(App::CamelPKI::CA::FacetReadonly); }
    use Class::Facet delegate => "issue_crl";
}


=head2 facet_certtemplate($certtemplate)

Returns a copy of this object with restricted privileges: among the
methods that writes, only L</certificate>, L</commit>, L</issue>,
L</revoke> and L</database> can be invoked, and for the last three
methods, access is restricted to certificates belonging to
$certtemplate. The returned object represents the right to generate
and to revoke certificates in a specific template.

=cut

sub facet_certtemplate {
    my ($self, $certtemplate) = @_;

    my $facet = Class::Facet->make("App::CamelPKI::CA::FacetCertTemplate",
                                   $self);
    $facet->{certtemplate} = $certtemplate;
    return $facet;

    package App::CamelPKI::CA::FacetCertTemplate;

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

    use Class::Facet delegate => [qw(issue_crl commit)];

    # Still meta-programming a bit, but I don't think Class::Facet could
    # help me much here and remain generic.
    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