#! /usr/bin/perl
use strict;
use warnings;
use Template;
use IO::File;
use File::Path;
use File::Temp qw(tempdir);
use File::Basename;
use Getopt::Long qw(GetOptionsFromArray);
use Pod::Usage;
use feature qw(switch);

my $CA_CRT = "CA/ca-crt.pem";
my $CA_KEY = "CA/private/ca-key.pem";
my $CA_DIR = "./var";

my %TEMPLATE = (
    ca  => "lib/templates/ca",
    req => "lib/templates/req",
);

my $TMP = tempdir("/tmp/$ENV{USER}.ca.XXXXXX", CLEANUP => 1);

my $opt_days    = undef;    # see the templates/ca for a default
my $opt_type    = undef;    # see the templates/ca for a default
my $opt_policy  = "de";     # see the templates/ca for a default
my $opt_outfile = undef;
my $opt_force   = undef;

sub init_ca();
sub ask_pass($);

MAIN: {
    my $csrfile;

    GetOptions(
        "d|days=i"    => \$opt_days,
        "t|type=s"    => \$opt_type,
        "p|policy=s"  => \$opt_policy,
        "o|outfile=s" => \$opt_outfile,
        "f|force"     => \$opt_force,
        "i|init"      => sub { eval { init_ca() }; if ($@) { warn $@; exit 1 }; exit 0 },
        "h|help"      => sub { pod2usage(-verbose => 1, -exit => 0) },
        "m|man"       => sub { pod2usage(-verbose => 2, -exit => 0) },
    ) or pod2usage;

    pod2usage if @ARGV > 1;
    $csrfile = $ARGV[0];    # don't shift, we'll need it later!

    my $cnf = new IO::File ">$TMP/cnf"  or die "Can't open >$TMP/cnf: $!\n";
    my $csr = new IO::File "+>$TMP/csr" or die "Can't open +>$TMP/csr: $!\n";
    my $crt = new IO::File "+>$TMP/crt" or die "Can't open +>$TMP/crt: $!\n";
    my $tt2 = new Template              or die $Template::ERROR;

    # get a private copy of the request
    print { IO::File->new("|openssl req -out $TMP/csr") } <>;
    open(STDIN, "</dev/tty") if not defined $csrfile;

    die "CSR is empty" if not -s $csr;

    $tt2->process(
        $TEMPLATE{ca},
        {
            type   => $opt_type,
            days   => $opt_days,
            policy => "policy_$opt_policy",
            cacrt  => $CA_CRT,
            cakey  => $CA_KEY,
            cadir  => $CA_DIR,
        } => "$TMP/cnf"
    ) or die $tt2->error, "\n";

    system( "openssl ca -config $TMP/cnf -in $TMP/csr -out $TMP/crt"
          . " -utf8 \${CA_PASS:+-passin env:CA_PASS}");

    die "ERR: Cert is zero size\n" if not -s $crt;

    # get the name of the output crt file
    my $outfile = $opt_outfile;
    if (not defined $outfile and defined($_ = $csrfile)) {
        if    (/(.*[\W_])(?:req|csr).pem$/) { $outfile = "$1crt.pem" }
        elsif (/(.*[\W_])req$/)             { $outfile = "$1crt" }
        else                                { $outfile .= ".crt.pem" }
    }

    # to be sure not to have an invalid/dangerous file name
    if (fork() == 0) {
	if (defined $outfile) {
	    open(STDOUT, ">$outfile")
              or die "Can't open >$outfile: $!\n";
	    }
        exec "openssl x509 -in $TMP/crt";
        die "Can't exec openssl x509: $!\n";
    }
    else { wait }

    # and now, since it's finally done, we'll copy the request
    # away (for later use (thing about re-issuing a certificate))
    my $subject = `openssl x509 -in $TMP/crt -noout -subject`;
    if (my ($cn) = $subject =~ /CN=(\S+?)[,\/\s\$]/) {
        if (fork() == 0) {
            open(STDOUT, ">$CA_DIR/requests/$cn-csr.pem")
              or die "Can't open >$CA_DIR/requests/$cn-csr.pem: $!\n";
            exec "openssl req -in $TMP/csr";
            die "Can't exec openssl req: $!\n";
        }
        else { wait }
    }
    else {
        die "Can't determine the CN from $subject, not saving the request\n";
    }

    exit;
}

sub ask_pass($) {
    my $prompt = shift;
    my @keys = ("x", "y");

    while (1) {
        print $prompt;
        my $stty = `stty -g`;
        system("stty -echo");
        chomp($keys[0] = IO::File->new("/dev/tty")->getline());
        print "\n";
        system("stty $stty");
        print "please again for verification: ";
        system("stty -echo");
        chomp($keys[1] = IO::File->new("/dev/tty")->getline());
        print "\n";
        system("stty $stty");
        return $keys[0] if $keys[0] eq $keys[1];
        print "keys mismatch, again\n";
    }
}

sub init_ca() {

    # initialize the CA directory structure. This should
    # correspond to the values found in templates/ca
    die "$CA_DIR already exists" if -d $CA_DIR and not $opt_force;
    mkpath(map { "$CA_DIR/$_" } qw(newcerts requests));
    mkpath(map { dirname $_ } $CA_CRT, $CA_KEY);
    (new IO::File ">$CA_DIR/index");
    (new IO::File ">$CA_DIR/serial")->print("01\n");

    # now
    my $tt2 = new Template or die $Template::ERROR;
    $tt2->process(
        $TEMPLATE{req},
        {

            # not used yet
        } => "$TMP/cnf"
    ) or die $tt2->error;

    $ENV{CA_PASS} = ask_pass("passphrase for CA key: ");
    system(
"openssl req -config $TMP/cnf -x509 -days 3650 -new -passout env:CA_PASS -keyout $TMP/ca-key.pem -out $TMP/ca-crt.pem"
    ) and exit;

    system("openssl x509 -in $TMP/ca-crt.pem -out $CA_CRT") and exit;
    $_ = umask(077);
    system(
"openssl rsa -in $TMP/ca-key.pem -des3 -passin env:CA_PASS -passout env:CA_PASS -out $CA_KEY"
    ) and exit;
    umask($_);

    return 0;

}

__END__

=head1 NAME

    ca - the ultimative CA tool

=head1 SYNOPSIS

    ca [--force] --init
    ca --type=TYPE --days=DAYS [request.pem]

    (not yet: request c=COUNTRY ST=STATE l=LOCATION o=ORGANIZATION OU=ORG-UNIT cn=COMMON-NAME)

=head1 DESCRIPTION

This B<ca> tool signs the request file. If no file is given, it
expects the request on STDIN

=head1 OPTIONS

=over 4

=item B<-d>|B<--days> I<days>

The number of days the certificate should be valid. (default: 365)

=item B<-h>|B<--help>

Print the reference help and exit. (default: off)

=item B<-i>|B<--init>

Initialize the CA (keys, directories). This may be enforce with
B<--force>. (default: off)

=item B<-m>|B<--man>

Open the reference manual and exit. (default: off)

=item B<-o>|B<--out> I<outfile>

The name of the output file. If not set (the default), the output goes
to I<stdout> if the CSR came from stdin and it goes to a file named
similar to the CSR, if the request came from a file.

=item B<-t>|B<--type> I<type>

The (NSCertType) type of the certificate. Should be client or server.
(default: none)

=back

=cut
## Please see file perltidy.ERR
