view release on metacpan or  search on metacpan

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

    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.
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

sub rescind { die "UNIMPLEMENTED" }

=head1 FACETS

=head2 database_facet($certtemplate)

Returns a facet of the CA database (as passed to L</load>) resticted
in read only and using a filter that only allow to consult certificates
generated using $certtemplate as first parameters issued to L</issue>.

=cut

sub database_facet {
    my ($self, $template) = @_;

    my $retval = Class::Facet->make("App::CamelPKI::CA::CADBFacet",
                                    $self->database);
    $retval->{template} = $template;
    return $retval;

    package App::CamelPKI::CA::CADBFacet;

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

    sub search {
        my ($facetself, $trueself) = Class::Facet->selves(\@_);
        return $trueself->search(template => $facetself->{template}, @_);
    }
}

=head2 facet_readonly()

Returns a copy of this object in read only: only L</certificate> and
L</database> methods can be invoked.

=cut

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

    package App::CamelPKI::CA::FacetReadonly;

    use Class::Facet from => "App::CamelPKI::CA",
        on_error => \&App::CamelPKI::Error::Privilege::on_facet_error,
            delegate => [qw(rescind certificate is_operational database
                            database_facet)];

    # Cascading facets (yow!)

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

    }
}

test "synopsis" => sub {
    my $code = My::Tests::Below->pod_code_snippet("synopsis");
    $code =~ s/my //g;
    my $directory = $cadir;
    my $pubkey = App::CamelPKI::PublicKey->parse($test_public_keys{"rsa1024"});
    my ($ca, $joecert, $fredcert, $crl);
    my $cadb = load App::CamelPKI::CADB($cadir);
    eval $code; die $@ if $@;

    ok($joecert->isa("App::CamelPKI::Certificate"));
    like($joecert->get_subject_DN->to_string, qr/Joe/);
    ok($fredcert->isa("App::CamelPKI::Certificate"));
    like($fredcert->get_subject_DN->to_string, qr/Fred/);
    ok($crl->isa("App::CamelPKI::CRL"));
    ok($crl->is_member($joecert));
    ok(! $crl->is_member($fredcert));
};

test "->facet_operational" => sub {
    my $ca = load_ca->facet_operational;
    my $cacert = $ca->certificate;
    try {
        $ca->set_keys(-certificate => $cacert);
        fail("this method is not allowed by the facet");
    } catch App::CamelPKI::Error::Privilege with {
        pass;
    };
    ok($ca->issue_crl->isa("App::CamelPKI::CRL"),
       "the facet_operational is operational");
    ok($ca->facet_operational->facet_operational->certificate
       ->isa("App::CamelPKI::Certificate"), "facet_operational idempotent");
};

test "Coherence and forced revocation" => sub {
    my $ca = load_ca;
    my $pubkey = App::CamelPKI::PublicKey->parse($test_public_keys{"rsa1024"});
    $ca->issue("App::CamelPKI::CertTemplate::Foo", $pubkey,
               name => "user1", uid => 1);

    # I freely pick in the $cert private fields: 
    my $cert = $ca->{signed}->[0]->{cert};
    is(ref($cert), "App::CamelPKI::Certificate");
    try {
        $ca->revoke("App::CamelPKI::CertTemplate::Foo", $cert);
        fail("It's prohibited to revoke certificates "
             . "in the current transaction");
    } catch App::CamelPKI::Error::Privilege with {
        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 {
        $ca->commit();
        fail("the coherence check should been triggered now");
    } catch App::CamelPKI::Error::User with {
        pass("two certificates for Frida, that's a bad thing");
    };
};

test "->facet_certtemplate" => sub {
    my $ca = load_ca->facet_certtemplate("No::Such::CertTemplate");
    my @no_certs = $ca->database->search(-revoked => 0);
    is(scalar(@no_certs), 0, "no certificate in the dummy template");
};

test "facets intersection" => sub {
    my $ca = load_ca->facet_certtemplate("No::Such::CertTemplate")
        ->facet_readonly;

    my @no_certs = $ca->database->search(-revoked => 0);
    is(scalar(@no_certs), 0, "no certificate in the dummy template");

    try {
        $ca->issue_crl();
        fail("this method is not in the facet");
    } catch App::CamelPKI::Error::Privilege with {
        pass;
    };
};

test "capability discipline "
    . "sur le CertTemplate->test_certificate_conflict" => sub {
    my $pubkey = App::CamelPKI::PublicKey->parse($test_public_keys{"rsa1024"});
    our $ca = load_ca;
    our ($cert_in_other_template) = $ca->database->search();
    ok($cert_in_other_template->isa("App::CamelPKI::Certificate"));
    {
        package Bogus::CertTemplate;

        our @ISA = qw(App::CamelPKI::CertTemplate::Foo); # The same as
                                                    # hereafter
        sub test_certificate_conflict {
            my ($class, $db, @keyvals) = @_;

            use Test::More;
            is($db->search(-revoked => undef,
                           -certificate => $cert_in_other_template)
              ->count(), 0, <<"MESSAGE");
test_certificate_conflict must not see other templates's certificates.
MESSAGE
            foreach my $cert (map {$_->{cert}} @{$ca->{signed}}) {
                is($db->search(-revoked => undef,