#!/usr/bin/perl -w
# vsd-ca - VSD CA manipulation.
#
# provides functionality for:
#  vsd-mkca   - Create a VSD CA.
#  vsd-rmca   - Remove a VSD CA.
#  vsd-mkcrt  - Create VSD cert/key pair.
#  vsd-rmcrt  - Remove VSD cert/key pair.
#  vsd-lncrt  - Link a hash reference to a certificate.
#  vsd-lncrl  - Link a hash reference to a crl.
#

#
# VSD - Virtual Server Daemon
# Copyright (c) 2000 - 2001 Idaya Ltd.
#
# VSD is free software; you can redistribute it and/or 
# modify it under the terms of the GNU General Public License 
# as published by the Free Software Foundation; either 
# version 2 of the license, or (at your option) any later version.
#
# VSD is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU 
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with VSD - see the COPYING file;  if not, write to the 
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#

#
# See the AUTHORS file for a list of contributors to VSD
# See the ChangeLog files for a list of changes
#

use strict;
use File::Copy;
use File::Path;
use Getopt::Long;
use VSD;

# Establish paths.
my $vsdsbindir = $path{vsdsbindir};
my $vsdconfdir = $path{vsdconfdir};

# Establish name.
my $APPNAM = ($0 =~ m/\/([0-9A-Za-z_.-]+)$/g)[-1];

# Supported Usage.
my %USAGES = ("vsd-ca",    "\nVSD CA manipulation\n",
              "vsd-mkca",  "[CA]\nCreate a VSD CA\n",
              "vsd-rmca",  "[CA]\nRemove a VSD CA\n",
              "vsd-mkcrt", "CA CN\nCreate VSD cert/key pair\n",
              "vsd-rmcrt", "CA CN\nRemove VSD cert/key pair\n",
              "vsd-lncrt", "CA CRT\nLink hash reference to a certificate\n",
              "vsd-lncrl", "CA CRL\nLink hash reference to a crl\n");
my $USAGE = "$APPNAM [OPTION]... $USAGES{$APPNAM}";

#Establish options.
my $req_distinguished_name;
GetOptions ("req_distinguished_name=s" => \$req_distinguished_name);  

# Establish arguments.
my $ca = shift @ARGV;
my $cn = shift @ARGV;
if ((!defined ($ca)) && (!defined ($cn)) 
    && (($APPNAM eq "vsd-mkcrt") || ($APPNAM eq "vsd-rmcrt")
	|| ($APPNAM eq "vsd-lncrt") || ($APPNAM eq "vsd-lncrl"))) {
    print "Usage: $USAGE\n";
  exit;
}

if (defined ($ca) && (($ca eq "default_ca") || ($ca eq "template_ca")
    || ($ca eq "CA_default" ) || ($ca eq "CA_template")
    || ($ca =~ m/.*-ca$/))) {
    die "$APPNAM: [$ca] invalid VSD CA specified\n";
}

if (defined ($cn) && ($cn =~ m/.*-ca$/)) {
    die "$APPNAM: [$cn] invalid CN specified\n";
}

my $conf;
if (defined ($ENV{VSD_OPENSSL_CONF})) {
    $conf = $ENV{VSD_OPENSSL_CONF};
} 
elsif (defined ($ENV{OPENSSL_CONF})) {
    $conf = $ENV{OPENSSL_CONF};
}
elsif (defined ($ENV{SSLEAY_CONF})) {
    $conf = $ENV{SSLEAY_CONF};
}
elsif (-f "$vsdconfdir/openssl.cnf") {
    $conf = "$vsdconfdir/openssl.cnf";
}
elsif (-f "/etc/ssl/openssl.cnf") {
    $conf = "/etc/ssl/openssl.cnf";
}
elsif (-f "/usr/local/etc/ssl/openssl.cnf") {
    $conf = "/usr/local/etc/ssl/openssl.cnf";
}

# Establish hostname.
my $host = `hostname --fqdn`;
chomp ($host);      # remove newlines.
$host =~ s/^\s+//;  # remove leading white space.
$host =~ s/\s+$//;  # remove trailing white space.

if (($APPNAM ne "vsd-lncrl") && ($APPNAM ne "vsd-lncrt")) {
    if (!defined ($ca) || $ca eq "$host") {
	$ca = "default_ca";
    }
    else {
	$host = $ca;
    }
}

# default constants from OpenSSL configuration file.
my ($default_ca_dir, $default_ca_certificate, $default_ca_serial, 
    $default_ca_database, $default_ca_crl, $default_ca_certs, 
    $default_ca_crls, $default_ca_keys, $default_ca_cacerts, 
    $default_ca_new_certs_dir, $default_ca_private_key);
my $default_ca_const;
my %default_ca_consts = ("dir",           \$default_ca_dir, 
			 "certificate",   \$default_ca_certificate,
			 "serial",        \$default_ca_serial,
			 "database",      \$default_ca_database,
			 "crl",           \$default_ca_crl,
			 "certs",         \$default_ca_certs,
			 "keys",          \$default_ca_keys,
			 "crls",          \$default_ca_crls,
			 "cacerts",       \$default_ca_cacerts,
			 "new_certs_dir", \$default_ca_new_certs_dir,
			 "private_key",   \$default_ca_private_key);
conf_parse ("default_ca", \%default_ca_consts);

# specific constants from OpenSSL configuration file.
my ($dir, $certificate, $serial, $database, $crl, $certs, $crls, $keys, 
    $cacerts, $new_certs_dir, $private_key);
my $const;
my %consts = ( "dir",           \$dir, 
	       "certificate",   \$certificate,
	       "serial",        \$serial,
	       "database",      \$database,
               "crl",           \$crl,
	       "certs",         \$certs,
	       "keys",          \$keys,
	       "crls",          \$crls,
	       "cacerts",       \$cacerts,
	       "new_certs_dir", \$new_certs_dir,
	       "private_key",   \$private_key);

# Perform request
if ($APPNAM eq "vsd-mkca") {

    if ($ca ne "default_ca" ) {
	conf_add ($ca);
    }
    conf_parse ($ca, \%consts);
    mkcadirs ($ca);
    mkcacrt ($ca, $host);
    mkcrt ($ca, $host);    
    mkcrl ($ca, "00");
    ca_verify ();
}
elsif ($APPNAM eq "vsd-rmca") {
    conf_parse ($ca, \%consts);
    conf_del ();
    rmcadirs ();
}
elsif ($APPNAM eq "vsd-mkcrt") {
    conf_parse ($ca, \%consts);
    ca_verify ();
    mkcrt ($ca, $cn);
}
elsif ($APPNAM eq "vsd-rmcrt") {
    conf_parse ($ca, \%consts);
    ca_verify ();
    rmcrt ($ca, $cn);
}
elsif ($APPNAM eq "vsd-lncrt") {
    lncrt ($ca, $cn, "$vsdconfdir/ssl.crt");
}
elsif ($APPNAM eq "vsd-lncrl") {
    lncrl ($ca, $cn, "$vsdconfdir/ssl.crl");
}
exit;

###############################################################################
# Description: Parse openssl.cnf for VSD CA constants
###############################################################################
sub conf_parse {
    my $ca = shift @_;
    my $constsref = shift @_;

# Parse OpenSSL configuration file and set globals by reference.
    my ($ca_sect, $const);
    open (CONF, "< $conf") or die "$APPNAM: $conf: $!";
    while (<CONF>) {
	if ($_ =~ m/^\[\s*ca\s*\].*/g) {
	    while (<CONF>) {
		if ((!defined ($ca_sect)) 
		    && ($ca_sect = 
			($_ =~ m/^$ca\s*=\s*([0-9A-Za-z_.-]+).*/g)[0])) {
		    last;
		}
	    }		   
	 
	    while (<CONF>) {
		if ($_ =~ m/^\[\s*$ca_sect\s*\].*/g) {
		    while (<CONF>) {
			foreach $const (keys %$constsref) {
			    if ((!defined (${$constsref->{$const}}))
				&& (${$constsref->{$const}} 
			            = ($_ =~ m/^$const\s*=\s*([0-9A-Za-z_.\/\$\\]+).*/g)[0])) {
			        ${$constsref->{$const}} =~ s/^\/\//\//;  
		                last;
		            }
		        }
	            }
                }
            }
        }
    }
    close (CONF);
    
    if (!defined ($ca_sect)) {
	die "$APPNAM: [$ca] VSD CA does not exist\n";
    }
    
# Substitutions.
    my $subst;
    foreach $const (keys %$constsref) {
	if (${$constsref->{$const}} =~ m/.*\$.*/) {
	    $subst = (${$constsref->{$const}} =~ m/([0-9A-Za-z\$]+)/g)[0];  
            $subst =~ s/\$//;         
            if (!exists ($constsref->{$subst})) {
	        die "$APPNAM: $conf: no matching substition for '$subst'";
            }
            ${$constsref->{$const}} =~ s/\$$subst/${$constsref->{$subst}}/;
        }
    }

# Check configuration.
    foreach $const (keys %$constsref) {
	if (!defined (${$constsref->{$const}})) {
	    die "$APPNAM: $conf: definition for '$const' not found";
        }
    }
}

###############################################################################
# Description: Add VSD CA entry to openssl.cnf
###############################################################################
sub conf_add {
    my $ca = shift @_;
    
# Parse OpenSSL configuration file.
    open (CONF, "< $conf") or die "$APPNAM: $conf: $!";
    while (<CONF>) {
	if ($_ =~ m/^\[\s*CA_$ca\s*\].*/g) {
	    die "$APPNAM: [$ca] VSD CA already exists\n";
	}
    }
    close (CONF);
    
# Modify configuration file.
    my ($src, $dst, $ca_sect);
    my $template = "template_ca";
    my @template;
    $src = $conf;
    $dst = "/tmp/vsd-ca-$$-openssl.cnf";
    open (SRC, "< $src") or die "$APPNAM: $src: $!";
    open (DST, "> $dst") or die "$APPNAM: $dst: $!"; 
    
    while (<SRC>) {
	if ($_ =~ m/^\[\s*ca\s*\].*/g) {
	    print (DST $_);
	    
	    while (<SRC>) {
		print (DST $_);
		if ((!defined ($ca_sect)) 
		    && ($ca_sect = ($_ =~ m/^$template\s*=\s*([0-9A-Za-z_.-]+).*/g)[0])) {
		    print (DST "$ca = CA_$ca\n");
		}
		last if ($_ =~ m/^\[.*/g);
	    }		
	    
	    while (<SRC>) {
		print (DST $_);
		last if ($_ =~ m/^\[\s*$ca_sect\s*\].*/g);
	    }
	    
	    while (<SRC>) {
		if ($_ =~ m/^\[.*/g) {
		    last;
		}
		else {
		    print (DST $_);
		    push @template, $_;
		}
	    }
	    
	    print (DST "[ CA_$ca ]\n");
	    foreach (@template) {
		chomp;               # remove newlines.
		s/^\s+//;            # remove leading white space.
		s/\s+$//;            # remove trailing white space.
		s/\.*(\/ca)\s+/\/ca\/virtual\/$ca  /;
		print (DST "$_\n");
	    }
	}
	print (DST $_); 
    }
    close (SRC);
    close (DST);
    
    if ( -f "$src.old" && (!unlink ("$src.old"))) {
	die "$APPNAM: error deleting $src.old: $!";
    }
    
    if (-f "$src" && (!rename ($src, "$src.old"))) {
	die "$APPNAM: error renaming $src to $src.old: $!";
    }
    
    if (-f "$dst" && (!move ("$dst", "$src"))) {
	die "$APPNAM: error creating $src.new: $!";
    }
}

###############################################################################
# Description: Delete VSD CA entry from openssl.cnf
###############################################################################
sub conf_del
{
    my ($src, $dst, $ca_sect);
    my ($default_ca_sect, $template_sect);
    $src = $conf;
    $dst = "/tmp/vsd-ca-$$-openssl.cnf";
    open (SRC, "< $src") or die "$APPNAM: $src: $!";
    open (DST, "> $dst") or die "$APPNAM: $dst: $!"; 
	
    if ($ca eq "default_ca") {
	while (<SRC>) {
	    if ($_ =~ m/^\[\s*ca\s*\].*/g) {
		print (DST $_);
		
		while (<SRC>) {
		    if ((!defined ($default_ca_sect)) 
			&& ($default_ca_sect = ($_ =~ m/^default_ca\s*=\s*([0-9A-Za-z_.-]+).*/g)[0])) {
			print (DST $_);
		    }
		    if ((!defined ($template_sect)) 
			&& ($template_sect = ($_ =~ m/^template_ca\s*=\s*([0-9A-Za-z_.-]+).*/g)[0])) {
			print (DST $_);
		    }
		    last if ($_ =~ m/^\[.*/g);
		}		
		print (DST "\n");

		print (DST "$_");
		while (<SRC>) {
		    if ($_ =~ m/^\[.*/g) {
			last;
		    }
		    else {
			print (DST $_);
		    }
		}

		print (DST "$_");
		while (<SRC>) {
		    if ($_ =~ m/^\[.*/g) {
			last;
		    }
		    else {
			print (DST $_);
		    }
		}
		
		if ($_ !~ m/^\[\s*policy_match\s*\].*/) {
		    while (<SRC>) {
			last if ($_ =~ m/^\[\s*policy_match\s*\].*/g);
		    }
		}
	    }
	    print (DST $_);
	}
	close (SRC);
	close (DST);
    }
    else
    {
	while (<SRC>) {
	    if ($_ =~ m/^\[\s*ca\s*\].*/g) {
		print (DST $_);
		
		while (<SRC>) {
		    if ((!defined ($ca_sect)) 
			&& ($ca_sect = ($_ =~ m/^$ca\s*=\s*([0-9A-Za-z_.-]+).*/g)[0])) {
			# Do nothing
		    }
		    else {
			print (DST $_);
		    }
		    last if ($_ =~ m/^\[.*/g);
		}		
		
		while (<SRC>) {
		    if ($_ =~ m/^\[\s*$ca_sect\s*\].*/g) {
			last;
		    }
		    else {
			print (DST $_);
		    }
		}
		
		while (<SRC>) {
		    last if ($_ =~ m/^\[.*/g);
		}
	    }
	    print (DST $_); 
	}
	close (SRC);
	close (DST);
    }
    
    if ( -f "$src.old" && (!unlink ("$src.old"))) {
	die "$APPNAM: error deleting $src.old: $!";
    }
    
    if (-f "$src" && (!rename ($src, "$src.old"))) {
	die "$APPNAM: error renaming $src to $src.old: $!";
    }
    
    if (-f "$dst" && (!move ("$dst", "$src"))) {
	die "$APPNAM: error creating $src.new: $!";
    }
}

###############################################################################
# Description: Generate VSD CA directory structure.
###############################################################################
sub mkcadirs {

    my (@paths, @files, $file);
    
    if ( -d "$dir") {
	die "$APPNAM: VSD Root CA already exists.\n";
    }
    
    @paths = ($dir, $certs, $keys, $crls, $cacerts, $new_certs_dir, 
	     "$certs/virtual", "$keys/virtual");
        
    @files = ($certificate, $serial, $database, $crl, $private_key);
    foreach $file (@files) {
	$file =~ s/\/[0-9A-Za-z_.-]+$/\//;      # strip filename.
	push @paths, $file;
    }
    
    if (!mkpath (\@paths, "FALSE", 0600)) {
	die "$APPNAM: error creating directories: $!";
    }
    
# Establish serial file.
    open (OUT, ">$serial") or die "$APPNAM: $serial: $!";
    print OUT "01\n";
    close (OUT);
    chmod (0600, $serial);
    
# Establish database file.
    open (OUT, ">$database") or die "$APPNAM: $database: $!"; 
    close (OUT);
    chmod (0600, $database);
    
# Establish crl file.
    open (OUT, ">$crl") or die "$APPNAM: $crl: $!"; 
    close (OUT);
    chmod (0600, $crl);
}

###############################################################################
# Description: Remove VSD CA directory structure.
###############################################################################
sub rmcadirs {
    my ($path, @paths);

# Useful constants.
    my $vsdcertificate = "$cacerts/$host-ca.crt";
    my $vsdcrl = "$crls/$host.crl";
    
# Issued CA certiifcate.
    if (-f "$vsdcertificate" ) {
# Determine hash reference of revoked certificate.
	my $vsdcertificate_hash = get_crt_hash ($vsdcertificate, $cacerts);
	$vsdcertificate_hash =~ s/(.[0-9]+)$//;
	my $subject = get_crt_subject ("$vsdcertificate");

	my $r = 0;
	while (1) {
	    if (-r "$vsdcertificate_hash.$r") {
		my $sub = get_crt_subject ("$vsdcertificate_hash.$r");
		if ("$sub" eq "$subject") {
		    if (!unlink ("$vsdcertificate_hash.$r")) {
			die "$APPNAM: error deleting $vsdcertificate_hash.$r: $!";        
		    }
		    last;
		}
	    }
	    $r++;
	}
    }
    if (-f "$vsdcertificate" && (!unlink( $vsdcertificate))) {
	die "$APPNAM: error deleting $vsdcertificate: $!";
    }

# Issued Certificates
    if ($ca ne "default_ca") {
	my $file;
	opendir (DIR, "$certs/virtual/$host") or die "$APPNAM: error opening $certs/virtual/$host: $!";
	while (defined($file = readdir (DIR))) {
	    if ($file ne "." && $file ne "..") {
		my $vsdcrt = "$certs/virtual/$host/$file";
		my $vsdcrt_hash = get_crt_hash ($vsdcrt, "$certs");
		$vsdcrt_hash =~ s/(.[0-9]+)$//;
		my $subject = get_crt_subject ("$vsdcrt");
		my $r = 0;
		while (1) {
		    if (-r "$vsdcrt_hash.$r") {
			my $sub = get_crt_subject ("$vsdcrt_hash.$r");
			if ("$sub" eq "$subject") {
			    if (!unlink ("$vsdcrt_hash.$r")) {
				die "$APPNAM: error deleting $vsdcrt_hash.$r: $!";    
			    }
			    last;
			}
		    }
		    $r++;
         	}
	    }
	}
	closedir (DIR);
    }

# Issued CRL
    my $vsdcrl_hash = get_crl_hash ($vsdcrl, $crls);
    if (defined ($vsdcrl_hash) && -f "$vsdcrl_hash" 
	&& (!unlink ("$vsdcrl_hash"))) {
	die "$APPNAM: error deleting $vsdcrl_hash : $!";
    }
    if (-f "$vsdcrl" && (!unlink( $vsdcrl))) {
	die "$APPNAM: error deleting $vsdcrl: $!";
    }

# Directories
    @paths = ($dir, "$certs/virtual/$ca", "$keys/virtual/$ca");
    if ($ca eq "default_ca" ) {
	push @paths, $certs;
	push @paths, $crls;
	push @paths, $keys;
	push @paths, $cacerts;
    } else {
	push @paths, "$certs/virtual/$ca";
	push @paths, "$keys/virtual/$ca"; 
    }
    
    foreach $path (@paths) {
	if (-d "$path" && (!rmtree ("$path"))) {
	    die "$APPNAM: error removing $path: $!";
	}
    }
}

###############################################################################
# Description: Generate VSD CA certificate.
###############################################################################
sub mkcacrt {
    my $ca = shift @_;
    my $host = shift @_;

    my (@attributes, $cacert);
    my ($src, $dst, $tmpconf);
    my $vsdcertificate;

# Useful constants.
    if ($ca eq "default_ca" ) {
	$vsdcertificate = "$cacerts/$host-ca.crt";

# Determine attributes
	if (defined($req_distinguished_name)) {
	    push @attributes, split (',', $req_distinguished_name); 
	}
	
# Generate temporary configuration file.
	$src = $conf;
	$dst = $tmpconf = "/tmp/vsd-ca-$$-openssl-ca.cnf";
	open (SRC, "< $src") or die "$APPNAM: $src: $!";
	open (DST, "> $dst") or die "$APPNAM: $dst: $!"; 

	while (<SRC>) {
	    
	    if (defined($req_distinguished_name)) {

		# Disable prompts.
		if ($_ =~ m/^\[\s*req\s*\].*/g) {
		    print (DST $_);
		    print (DST "prompt=no\n");
		    next;
		}

		# Set attributes.
		if ($_ =~m/^\[\s*req_distinguished_name\s*\].*/g) {
		    print (DST $_);
		    foreach (@attributes) {
			chomp;               # remove newlines.
			s/^\s+//;            # remove leading white space.
			s/\s+$//;            # remove trailing white space.
			print (DST "$_\n");
		    }		    
		    while (<SRC>) {
			last if (m/^\[.*\].*/);
		    }
		}
		print (DST "$_");
		next;
	    }
	    else {
		if ($_ =~ m/^commonName_default\s+=\s+.*/g) {
		    print (DST "commonName_default = $host\n");
		    next;
		}
	    }
	    
	    print (DST $_);
	}
	close (SRC);
	close (DST);
	
    } else {
	$vsdcertificate = "$cacerts/$ca-ca.crt";

# Determine default attributes from ca certificate.
	$cacert = openssl_output (
	        "x509",                               # X509 procesing.
	        "-text",                              #  text output.
	        "-in",   "$default_ca_certificate");  #  input certificate.
	my $subject = ($cacert =~ m/\s*Subject:\s(.*)/g)[0];
	push @attributes, split (',', $subject); 
	
# Generate temporary configuration file.
	$src = $conf;
	$dst = $tmpconf = "/tmp/vsd-ca-$$-openssl-ca.cnf";
	open (SRC, "< $src") or die "$APPNAM: $src: $!";
	open (DST, "> $dst") or die "$APPNAM: $dst: $!"; 
	
	while (<SRC>) {
	    # Only use relevant CA configuration
	    if ($_ =~ m/^\[\s*ca\s*\].*/g) {
		print (DST $_);
		
		my $ca_sect;
		while (<SRC>) {
		    if ($ca_sect = 
			($_ =~ m/^$ca\s*=\s*([0-9A-Za-z_.-]+).*/g)[0]) {
			print (DST "default_ca = $ca_sect\n");
			last;
		    }
		}		
		
		while (<SRC>) {
		    last if ($_ =~ m/^\[\s*$ca_sect\s*\].*/g);
		}
		
		print (DST $_);
		while (<SRC>) {
		    last if ($_ !~ m/^\[.*/g);
		    print (DST $_); 
		}
	    }
	    
	    # Disable prompts.
	    if ($_ =~ m/^\[\s*req\s*\].*/g) {
		print (DST $_);
		print (DST "prompt=no\n");
		next;
	    }
	    
	    # Set attributes.
	    if ($_ =~m/^\[\s*req_distinguished_name\s*\].*/g) {
		print (DST $_);
		while (<SRC>) {
		    last if (m/^\[.*\].*/);
		}
		foreach (@attributes) {
		    chomp;               # remove newlines.
		    s/^\s+//;            # remove leading white space.
		    s/\s+$//;            # remove trailing white space.
		    print (DST "$_\n") unless (m/^\s*CN\s*=.*/);
		}
		print (DST "CN=$ca\n\n");
		print (DST $_);
		next;
	    }
	    
	    print (DST $_);
	}
	close (SRC);
	close (DST);
    }

# Create self signed X509 certificate.
    if (openssl (
	    "req",                      # Make a certificate request.
	    "-new",                     #  generate new RSA private key.
	    "-x509",                    #  produce self-signed certificate.
	    "-out", "$certificate",     #  self signed Root CA certificate.
	    "-days", "9125",            #  validate for 25 years.
	    "-keyout", "$private_key",  #  private key file.
	    "-passout", "pass:pass",    #  password.
	    "-config", "$tmpconf")) {   #  configuration file.
	chmod (0600, $certificate);
	chmod (0600, $private_key);
    }    

# Remove temporary configuration file.
#    unlink ($tmpconf);
    
# Strip passphrase from private key.
    rename ($private_key, "$private_key.passphrase");
    if (openssl ( 
	    "rsa",                             # RSA key processing.
	    "-passin", "pass:pass",            #  password.
	    "-in", "$private_key.passphrase",  #  passphrase protected key.
	    "-out", "$private_key")) {         #  key without passphrase.
	chmod (0600, $private_key);
    }

# Establish CA certificate for authorisation.
    if (-f "$certificate" && (!copy ("$certificate", "$vsdcertificate"))) {
	die "$APPNAM: error: system call failed";
    }

# Set hash reference.
    my $vsdcertificate_hash = get_crt_hash ($vsdcertificate, $cacerts);
    if (-f "$vsdcertificate" 
	&& (!symlink ("$vsdcertificate", "$vsdcertificate_hash"))) {
	die "$APPNAM: error creating $vsdcertificate_hash";
    }
    chmod (0600, "$vsdcertificate_hash");
}

###############################################################################
# Description: Verify VSD CA directory structure.
###############################################################################
sub ca_verify {
# Test for directories.
    my @dirs = ($certs, $keys, $crls, $cacerts, $new_certs_dir,
		"$certs/virtual", "$keys/virtual");
    foreach (@dirs) {
	die "$APPNAM: $_: No such file or directory\n" if (! -d "$_");
    }
    
# Test for files.
    my @files = ($certificate, $serial, $database, $crl, $private_key);
    foreach (@files) {
	die "$APPNAM: $_: No such file or directory\n" if (! -f "$_");
    }
}

###############################################################################
# Description: Add VSD cert/key pair to VSD CA.
###############################################################################
sub mkcrt {
    my $ca = shift @_;
    my $cn = shift @_;
    
# Determine current serial number.
    my $serialnum = get_serial_current ();
    
# Useful constants.
    my $private;                                         # private directory.
    ($private = $private_key) =~ s/\/[0-9A-Za-z_.]+$//;  # strip filename.

    my $vsdcrt;
    my $vsdkey;
    if ($ca eq "default_ca") {
	$vsdcrt = "$certs/$cn.crt";                       # issued cert.
	$vsdkey = "$keys/$cn.key";                        # issued key.
    } else {
	$vsdcrt = "$certs/virtual/$ca/$cn.crt";           # issued cert.
        $vsdkey = "$keys/virtual/$ca/$cn.key";            # issued key.

	my $path;
	foreach $path ("$certs/virtual/$ca", "$keys/virtual/$ca") {
	    if(! -d $path) {
		if (!mkpath ("$path", "FALSE", 0600)) {
		    die "$APPNAM: error creating $path: $!";
		}
	    }
	}

    }

    my $key = "$private/$serialnum.pem";                 # key.
    my $crt = "$new_certs_dir/$serialnum.pem";           # cert.
    my $csr = "$new_certs_dir/$serialnum.csr";           # signed cert request.
    
# Determine default attributes from ca certificate.
    my @attributes;
    my $subject = get_crt_subject ($certificate);
    push @attributes, split (',', $subject); 

# Generate temporary configuration file.
    my ($src, $dst, $tmpconf);
    $src = $conf;
    $dst = $tmpconf = "/tmp/vsd-ca-$$-openssl.cnf";
    open (SRC, "< $src") or die "$APPNAM: $src: $!";
    open (DST, "> $dst") or die "$APPNAM: $dst: $!"; 
    
    while (<SRC>) {
	# Only use relevant CA configuration
	if ($_ =~ m/^\[\s*ca\s*\].*/g) {
	    print (DST $_);

	    my $ca_sect;
	    while (<SRC>) {
		if ($ca_sect = ($_ =~ m/^$ca\s*=\s*([0-9A-Za-z_.-]+).*/g)[0]) {
		    print (DST "default_ca = $ca_sect\n");
		    last;
		}
	    }		
	    
	    while (<SRC>) {
		last if ($_ =~ m/^\[\s*$ca_sect\s*\].*/g);
	    }
	    
	    print (DST $_);
	    while (<SRC>) {
		last if ($_ !~ m/^\[.*/g);
		print (DST $_); 
	    }
	}
	
	# Disable prompts.
	if ($_ =~ m/^\[\s*req\s*\].*/g) {
	    print (DST $_);
	    print (DST "prompt=no\n");
	    next;
	}

	# Set attributes.
	if ($_ =~m/^\[\s*req_distinguished_name\s*\].*/g) {
	    print (DST $_);
	    while (<SRC>) {
		last if (m/^\[.*\].*/);
	    }
	    foreach (@attributes) {
		chomp;               # remove newlines.
		s/^\s+//;            # remove leading white space.
		s/\s+$//;            # remove trailing white space.
		print (DST "$_\n") unless (m/^\s*CN\s*=.*/);
	    }
	    print (DST "CN=$cn\n\n");
	    print (DST $_);
	    next;
	}
	
	print (DST $_);
    }
    close (SRC);
    close (DST);

# Create an x509 certificate and private key.
    if (openssl ( 
	    "req",                     # Make a certificate request.
	    "-new",                    #  generate new RSA private key.
	    "-x509",                   #  produce a self-signed certificate.
	    "-nodes",                  #  private key not encrypted.
	    "-out",    "$key",         #  self signed certificate.
	    "-keyout", "$key",         #  private key.
	    "-config", "$tmpconf")) {  #  configuration file.
	chmod (0600, $key);
    } 
    
# Convert x509 certificate into signed certificate request.
    if (openssl ( 
	    "x509",                 # X509 manipulation.
	    "-x509toreq",           #  convert cert to cert request.
	    "-in",      "$key",     #  certficate.
	    "-signkey", "$key",     #  private key. 
	    "-out",     "$csr")) {  #  signed certificate request.
	chmod (0600, $csr);
    }
    
# Sign the certificate request with the VSD CA.
    if (openssl ( 
	    "ca",                    # CA manipulation. 
	    "-batch",                #  suppress prompts.
	    "-notext",               #  suppress text.
	    "-out",    "/dev/null",  #  redirect stdout.
	    "-config",  "$tmpconf",  #  configuration file.
	    "-infiles", "$csr")) {   #  signed certificate request.
	chmod (0600, $crt);
	chmod (0600, $serial);
	chmod (0600, $database);	
    }
    
# Remove temporary configuration file.
    unlink ($tmpconf);
    
# Establish certificate and key for authorisation.
    if (-f "$crt" && (!copy ("$crt", "$vsdcrt"))) {
	die "$APPNAM: error: system call failed";
    }
    if (-f "$key" && (!copy ("$key", "$vsdkey"))) {
	die "$APPNAM: error: system call failed";
    }

# Set hash reference.
    my $vsdcrt_hash = get_crt_hash ($vsdcrt, $certs);
    if (-f "$vsdcrt" 
	&& (!symlink ("$vsdcrt", "$vsdcrt_hash"))) {
	die "$APPNAM: error creating $vsdcrt_hash: $!";
    }
    chmod (0600, "$vsdcrt_hash");
}

###############################################################################
# Description: Delete VSD cert/key pair from VSD CA.
###############################################################################
sub rmcrt {
    my $ca = shift @_;
    my $cn = shift @_;
    
# Useful constants.
    my $vsdcrt;
    my $vsdkey;
    if ($ca eq "default_ca") {
	$vsdcrt = "$certs/$cn.crt";                       # issued cert.
	$vsdkey = "$keys/$cn.key";                        # issued key.
    } else {
	$vsdcrt = "$certs/virtual/$ca/$cn.crt";           # issued cert.
	$vsdkey = "$keys/virtual/$ca/$cn.key";            # issued key.
    }
    
# Determine serial number of revoked certificate.
    my $serialnum = get_serial_from_crt ($vsdcrt);

# Determine issuer of revoked certificate.
    my $issuer = get_crt_issuer ($vsdcrt);

# Determine hash reference of revoked certificate.
    my $vsdcrt_hash = get_crt_hash ($vsdcrt, $certs);
    $vsdcrt_hash =~ s/(.[0-9]+)$//;

# Generate temporary configuration file.
    my ($src, $dst, $tmpconf);
    $src = $conf;
    $dst = $tmpconf = "/tmp/vsd-ca-$$-openssl.cnf";
    open (SRC, "< $src") or die "$APPNAM: $src: $!";
    open (DST, "> $dst") or die "$APPNAM: $dst: $!"; 
    
    while (<SRC>) {
	# Only use relevant CA configuration
	if ($_ =~ m/^\[\s*ca\s*\].*/g) {
	    print (DST $_);

	    my $ca_sect;
	    while (<SRC>) {
		if ($ca_sect = ($_ =~ m/^$ca\s*=\s*([0-9A-Za-z_.-]+).*/g)[0]) {
		    print (DST "default_ca = $ca_sect\n");
		    last;
		}
	    }		
	    
	    while (<SRC>) {
		last if ($_ =~ m/^\[\s*$ca_sect\s*\].*/g);
	    }
	    
	    print (DST $_);
	    while (<SRC>) {
		if ($_ =~ m/^\[.*/g) {
		    last;
		}
		else {
		    print (DST $_); 
		}
	    }

	    if ($_ !~ m/^\[\s*policy_match\s*\].*/) {
		while (<SRC>) {
		    last if ($_ =~ m/^\[\s*policy_match\s*\].*/g);
		}
	    }
	}
      	print (DST $_);
    }
    close (SRC);
    close (DST);
        
# Revoke certificate from VSD CA.
    if(openssl ( 
           "ca",                     # CA manipulation. 
	   "-config", "$tmpconf",    #  configuration file.
	   "-revoke", "$vsdcrt")) {  #  certificate to revoke.
	chmod (0600, $database);
    } 

# Delete revoked hash reference.
    if (-f "$vsdcrt" ) {
	my $r = 0;
	my $x;
	for ($x = 0; $x < 500; $x++) {
	    if (-r "$vsdcrt_hash.$r") {
		my $iss = get_crt_issuer ("$vsdcrt_hash.$r");
		if ("$iss" eq "$issuer") {
		    if (!unlink ("$vsdcrt_hash.$r")) {
			die "$APPNAM: error deleting $vsdcrt_hash.$r: $!";        
		    }
		    last;
		}
	    }
	    $r++;
	}
    }
    
# Delete revoked certificate.
    if (-f "$vsdcrt" && (!unlink ("$vsdcrt"))) {
	die "$APPNAM: error deleting $vsdcrt: $!";        
    }
    
# Delete revoked key.
    if (-f "$vsdkey" && (!unlink("$vsdkey"))) {
	die "$APPNAM: error deleting $vsdkey: $!";
    }

# Remove temporary configuration file.
    unlink ($tmpconf);

# Generate crl.
    mkcrl ($ca, $serialnum);
}

###############################################################################
# Description: Create a VSD CA certificate revocation list.
###############################################################################
sub mkcrl {
    my $ca = shift @_;
    my $serialnum = shift @_;

# Useful constants.
    my $vsdcrl;
    if ($ca eq "default_ca" ) {
	$vsdcrl = "$crls/$host.crl";   # issued crl.
    } else {
	$vsdcrl = "$crls/$ca.crl";   # issued crl.
    }

# Generate temporary configuration file.
    my ($src, $dst, $tmpconf);
    $src = $conf;
    $dst = $tmpconf = "/tmp/vsd-ca-$$-openssl.cnf";
    open (SRC, "< $src") or die "$APPNAM: $src: $!";
    open (DST, "> $dst") or die "$APPNAM: $dst: $!"; 
    
    while (<SRC>) {
	# Only use relevant CA configuration
	if ($_ =~ m/^\[\s*ca\s*\].*/g) {
	    print (DST $_);

	    my $ca_sect;
	    while (<SRC>) {
		if ($ca_sect = ($_ =~ m/^$ca\s*=\s*([0-9A-Za-z_.-]+).*/g)[0]) {
		    print (DST "default_ca = $ca_sect\n");
		    last;
		}
	    }		
	    
	    while (<SRC>) {
		last if ($_ =~ m/^\[\s*$ca_sect\s*\].*/g);
	    }
	    
	    print (DST $_);
	    while (<SRC>) {
		if ($_ =~ m/^\[.*/g) {
		    last;
		}
		else {
		    print (DST $_); 
		}
	    }

	    if ($_ !~ m/^\[\s*policy_match\s*\].*/) {
		while (<SRC>) {
		    last if ($_ =~ m/^\[\s*policy_match\s*\].*/g);
		}
	    }
	}
      	print (DST $_);
    }
    close (SRC);
    close (DST);
        
# Backup existing crl.
    if (-f "$crl" && (!copy("$crl", "$crl.old"))) {
	die "$APPNAM: error: system call failed";
    }
    
# Generate crl.
    if (openssl ( 
	    "ca",                   # CA manipulation. 
	    "-gencrl",              #  generate crl.
	    "-config", "$tmpconf",  #  configuration file.
	    "-out",    "$crl")) {   #  certificate revocation list.
	chmod (0600, $crl);
    }
    
# Store crl.
    if (-f "$crl" && (!copy("$crl", "$new_certs_dir/$serialnum.crl"))) {
	die "$APPNAM: error: system call failed";        
    }
        
# Issue crl.
    if (-f "$crl" && (!copy ("$crl", "$vsdcrl"))) {
	die "$APPNAM: error: system call failed";        	
    }

# Set hash reference.
    my $vsdcrl_hash = get_crl_hash ($vsdcrl, $crls);
    if (-f "$vsdcrl_hash"
	&& (!unlink ("$vsdcrl_hash"))) {
	die "$APPNAM: error deleting $vsdcrl_hash: $!";
    }
    if (-f "$vsdcrl" 
	&& (!symlink ("$vsdcrl", "$vsdcrl_hash"))) {
	die "$APPNAM: error creating $vsdcrl_hash: $!";
    }
    chmod (0600, "$vsdcrl_hash");
}

###############################################################################
# Description: Link hash reference to a certificate.
###############################################################################
sub lncrt {
    my $ca = shift @_;
    my $vsdcrt = shift @_;
    my $lndir = shift @_;

# Determine issuer of cert.
    my $issuer = get_crt_issuer ($vsdcrt);
    
# Determine hash reference of cert.
    my $vsdcrt_hash = get_crt_hash ($vsdcrt, $lndir);
    $vsdcrt_hash =~ s/(.[0-9]+)$//;
    
# Delete any existing hash reference.
    if (-f "$vsdcrt" ) {
	my $r = 0;
	my $x;
	for ($x = 0; $x < 500; $x++) {
	    if (-r "$vsdcrt_hash.$r") {
		my $iss = get_crt_issuer ("$vsdcrt_hash.$r");
		if ("$iss" eq "$issuer") {
		    if (!unlink ("$vsdcrt_hash.$r")) {
			die "$APPNAM: error deleting $vsdcrt_hash.$r: $!";   
		    }
		    last;
		}
	    }
	    $r++;
	}
    }

# Set hash reference.
    $vsdcrt_hash = get_crt_hash ($vsdcrt, $lndir);
    if (-f "$vsdcrt" 
	&& (!symlink ("$vsdcrt", "$vsdcrt_hash"))) {
	die "$APPNAM: error creating $vsdcrt_hash: $!";
    }
    chmod (0600, "$vsdcrt_hash");
}

###############################################################################
# Description: Link hash reference to a crl.
###############################################################################
sub lncrl {
    my $ca = shift @_;
    my $vsdcrl = shift @_;
    my $lndir = shift @_;

# Determine issuer of crl.
    my $issuer = get_crl_issuer ($vsdcrl);

# Determine hash reference of crl.
    my $vsdcrl_hash = get_crl_hash ($vsdcrl, $lndir);
    $vsdcrl_hash =~ s/(.r[0-9]+)$//;

# Delete any existing hash reference.
    if (-f "$vsdcrl" ) {
	my $r = 0;
	my $x;
	for ($x = 0; $x < 500; $x++) {
	    if (-r "$vsdcrl_hash.r$r") {
		my $iss = get_crl_issuer ("$vsdcrl_hash.r$r");
		if ("$iss" eq "$issuer") {
		    if (!unlink ("$vsdcrl_hash.r$r")) {
			die "$APPNAM: error deleting $vsdcrl_hash.r$r: $!";   
		    }
		    last;
		}
	    }
	    $r++;
	}
    }
    
# Set hash reference.
    $vsdcrl_hash = get_crl_hash ($vsdcrl, $lndir);
    if (-f "$vsdcrl_hash"
	&& (!unlink ("$vsdcrl_hash"))) {
	die "$APPNAM: error deleting $vsdcrl_hash: $!";
    }
    if (-f "$vsdcrl" 
	&& (!symlink ("$vsdcrl", "$vsdcrl_hash"))) {
	die "$APPNAM: error creating $vsdcrl_hash: $!";
    }
    chmod (0600, "$vsdcrl_hash");    
}

###############################################################################
# Description: Get certificate hash.
###############################################################################
sub get_crt_hash {
    my $vsdcrt = shift @_;
    my $lndir = shift @_;
    
    my ($hash, $vsdcrt_hash);
    if ($hash = openssl_output (
	    "x509",                  # X509 certificate procesing.
	    "-hash",                 #  hash the subject
            "-noout",                #  suppress normal output
	    "-in",    "$vsdcrt")) {  #  input certificate
	
	chomp ($hash);      # remove newlines.
	$hash =~ s/^\s+//;  # remove leading white space.
	$hash =~ s/\s+$//;  # remove trailing white space.
	
	my $r = 0;
	while (1) {
	    if (-r "$lndir/$hash.$r") {
		$r++;
	    }
	    else {
		$vsdcrt_hash = "$lndir/$hash.$r";
		last;
	    }
	}
    }
    return $vsdcrt_hash;
}

###############################################################################
# Description: Get crl hash.
###############################################################################
sub get_crl_hash {
    my $vsdcrl = shift @_;
    my $lndir = shift @_;
    
    my ($hash, $vsdcrl_hash);
    if (-f $vsdcrl) {
	if ($hash = openssl_output (
			"crl",                   # CRL procesing.
			"-hash",                 #  hash the subject
			"-noout",                #  suppress normal output
			"-in",    "$vsdcrl")) {  #  input certificate
	    
	    chomp ($hash);      # remove newlines.
	    $hash =~ s/^\s+//;  # remove leading white space.
	    $hash =~ s/\s+$//;  # remove trailing white space.
	    
	    my $r = 0;
	    while (1) {
		if (-r "$lndir/$hash.r$r") {
		    $r++;
		}
		else {
		    $vsdcrl_hash = "$lndir/$hash.r$r";
		    last;
		}
	    }
	}
    }
    return $vsdcrl_hash;
}

###############################################################################
# Description: Get subject from certificate.
###############################################################################
sub get_crt_subject() {
    my $certificate = shift @_;
    my ($output, $subject);

    if ($output = openssl_output (
            "x509",                      # X509 procesing.
	    "-text",                     #  text output.
	    "-in",   "$certificate")) {  #  input certificate.
	
	$subject = ($output =~ m/\s*Subject:\s(.*)/g)[0];
    }

    return $subject;
}

###############################################################################
# Description: Get issuer from certificate.
###############################################################################
sub get_crt_issuer {
    my $certificate = shift @_;
    my ($output, $issuer);
    
    if ($output = openssl_output (
            "x509",                      # X509 procesing.
	    "-text",                     #  text output.
	    "-in",   "$certificate")) {  #  input certificate.
	
	$issuer = ($output =~ m/\s*Issuer:\s(.*)/g)[0];
    }

    return $issuer;
}

###############################################################################
# Description: Get issuer from crl.
###############################################################################
sub get_crl_issuer {
    my $crl = shift @_;
    my ($output, $issuer);
    
    if ($output = openssl_output (
            "crl",                  # crl procesing.
	    "-issuer",              #  obtain issuer.
	    "-noout",               # suppress normal output
	    "-in",   "$crl")) {     #  input crl.
	
	$issuer = ($output =~ m/\s*issuer=\s(.*)/g)[0];
    }

    return $issuer;
}

###############################################################################
# Description: Get current serial number.
###############################################################################
sub get_serial_current {
    my $serialnum;
    
    open (SERIAL, "< $serial") or die "$APPNAM: $serial: $!";
    while (<SERIAL>) {
	chomp;               # remove newlines.
	s/^\s+//;            # remove leading white space.
	s/\s+$//;            # remove trailing white space.
	next unless length;  # skip blank lines.
	$serialnum = $_;
    }
    close (SERIAL);
    
    return $serialnum;
}

###############################################################################
# Description: Get a serial number from certificate.
###############################################################################
sub get_serial_from_crt {
    my $vsdcrt = shift @_;

    my $cert = openssl_output (
	           "x509",
		   "-text",
		   "-in", "$vsdcrt");

    my $num = hex(($cert =~ m/\s*Serial Number:.*\(([0-9A-Za-z]+)\).*/g)[0]);

    my $serial = sprintf("%04X", $num) if ($num <= 0xFFFF);
    $serial = sprintf("%02X", $num) if ($num <= 0xFF);

    return $serial;
}

###############################################################################
# Description: Get a serial number from database.
###############################################################################
sub get_serial_from_database {
    my $cn = shift @_;

    my @entries = `grep $cn $default_ca_database`;

    my $serial;
    foreach (@entries) {
	if (m/V\s+.*/) {
	    $serial = ($_ =~ m/\w+\s+[0-9A-Za-z]+\s+([0-9A-F]+)\s+.*/g)[0];
	}
    }

    if (!defined ($serial)) {
	$serial = "00";
    }
    
    return $serial;
}

###############################################################################
# Description: Execute an OpenSSL command.
###############################################################################
sub openssl {
    my @cmd = @_;

    my $cmd = "/usr/bin/openssl";
    if(system ($cmd, @cmd)) {
	die "$APPNAM: [$cmd[0]] openssl call failed";
    }
}

###############################################################################
# Description: Execute an OpenSSL command and return output.
###############################################################################
sub openssl_output {
    my @cmd = @_;
    my ($output, @output);

    my $cmd = "/usr/bin/openssl";
    foreach (@cmd) {
	$cmd = (defined ($cmd) ? "$cmd $_" : $_);
    }

    if (@output = `$cmd`) {
	foreach (@output) {
	    if ($_ =~ m/error/) {
		die "$APPNAM: openssl: $_";
	    }
	    $output = (defined ($output) ? "$output $_" : $_);
	}
    }
    
    return $output; 
}