App::CamelPKI::CA - Model of a Certificate Authority in Camel-PKI.

  my $ca = App::CamelPKI::CA->load($directory, $cadb)->facet_operational;
  $ca->issue("App::CamelPKI::CertTemplate::Foo", $pubkey,
             name => "Joe", uid => 42);
  $ca->issue("App::CamelPKI::CertTemplate::Foo", $pubkey,
             name => "Fred", uid => 43);
  my ($joecert, $fredcert) = $ca->commit();
  $ca->revoke("App::CamelPKI::CertTemplate::Foo", $joecert);
  $ca->commit();
  my $crl = $ca->issue_crl;

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

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

#!perl -w

package App::CamelPKI::CA;
use strict;
use warnings;

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;

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;
}

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);
        }
    }
}

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

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

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

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;
}

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);
}

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;
}

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}));
}

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;
}

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;
}

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;
    }
}

sub rescind { die "UNIMPLEMENTED" }

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}, @_);
    }
}

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!)
    BEGIN { foreach my $methname
                (qw(facet_readonly facet_crl_only
                    facet_certtemplate facet_operational)) {
                    no strict "refs";
                    *{"$methname"} = \&{"App::CamelPKI::CA::$methname"};
                }
        }
}

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";
}

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});
  }
}

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)];
}

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

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__

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;

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);
    ok($ca->certificate->equals($cert));
};

{
    package App::CamelPKI::CertTemplate::Foo;

    use base "App::CamelPKI::CertTemplate";
    use Crypt::OpenSSL::CA;

    sub list_keys { qw(name uid) }

    sub prepare_certificate {
        my ($class, $cacert, $cert, %opts) = @_;
        $class->copy_from_ca_cert($cacert, $cert);
        $cert->set_notBefore($opts{time});
        $cert->set_notAfter($cacert->get_notAfter());
        $cert->set_subject_DN
            (Crypt::OpenSSL::CA::X509_NAME->new_utf8
             ("2.5.4.11" => "Internet widgets",
              CN => $opts{name}, x500UniqueIdentifier => $opts{uid}));
        # ...
    }

    # Only one certificate may be valid at one time for a given UID:
    sub test_certificate_conflict {
        my ($class, $db, %opts) = @_;
        return $db->search(uid => $opts{uid});
    }

    # Sample coherency enforcement: no duplicate names, no duplicate
    # UIDs.
    sub test_issued_certs_coherent {
        my ($class, $db, @opts_array) = @_;
        $class->test_no_duplicates(["uid"], @opts_array);
        $class->test_no_duplicates(["name"], @opts_array);
    }
}

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,
                               -certificate => $cert)->count(), 0,
                   <<"MESSAGE");
test_certificate_conflict must not see certificates of the current
transaction.
MESSAGE
            }
            return $class->SUPER::test_certificate_conflict($db, @keyvals);
        }
    }
    #

    $ca->issue("Bogus::CertTemplate", $pubkey,
               name => "Harry", uid => 1001);
    $ca->issue("Bogus::CertTemplate", $pubkey,
               name => "Sally", uid => 1002);
    $ca->commit();
};

test "Evil CertTemplate" => sub {
    my $ca = load_ca;
    our ($oups_evil_certificat) = $ca->database->search();
    ok($oups_evil_certificat->isa("App::CamelPKI::Certificate"));
    {
        package Evil::CertTemplate;

        our @ISA = qw(App::CamelPKI::CertTemplate::Foo); # The one of L</SYNOPSIS>

        sub normalize_args {
            fail("GOTCHA!");
        }

        sub test_certificate_conflict {
            return $oups_evil_certificat;
        }
    }
    #

    my $pubkey = App::CamelPKI::PublicKey->parse($test_public_keys{"rsa1024"});
    try {
        $ca->issue("Evil::CertTemplate", $pubkey,
                   name => "zoinx", uid => 2000);
        fail("He sank my certificate!!!");
    } catch App::CamelPKI::Error::Privilege with {
        pass("Well tried, but boo, you failed!");
    };
};