#! /usr/bin/perl -w
#
# dctcs-cli.pl     - DigiCert TCS server certificate generator CLI
#                    see below at end for documentation and arguments
#
# @(#)$Id$
# David Groep, Nikhef, 2015 - www.nikhef.nl/grid
#
# As per doc https://www.digicert.com/services/v2/documentation
#
use strict;
use LWP::UserAgent;
use LWP::Protocol::https;
use IO::Socket::SSL;
use JSON;
use Data::Dumper;
use Getopt::Long;
$Getopt::Long::ignorecase = 0;

# ###########################################################################
# basic configuration - you SHOULD probably change apikeyfile and orgid!
# where apikeyfile may be the empty string (will then ask key from STDIN)
#
my $resturl    = "https://www.digicert.com/services/v2";
my $thishost   = `hostname -f`; chomp($thishost);
my $dirprefix  = "tcs-";
my $apikeylen  = 82; # length in characters of API key, seems to be 47 or 82
#
# CONFIGURE these values or override with args each time
my $orgid      = "Nikhef"; # CONFIG: Org ID from DigiCert, see also GUI
my $apikeyfile = ""; # CONFIG: provide your own filename here

my $hostname;
my $dir;          # target directory (default to tcs-<hostname>)
my $subdir="";    # target subdirecty (defaults to empty)
my $userelease=0; # use NDPF vlaai release mechanism
my $mode_req=0;
my $mode_retr=0;
my $mode_appr=0;
my $basedir="";
my $product = "grid_host_ssl_multi_domain";
my $validity = 1;
my $approve = "";
my $help = 0;

&GetOptions(
  'd|destdir=s' => \$dir,
  's|subsir=s' => \$subdir,
  'R|release' => \$userelease,
  'K|keyfile=s' => \$apikeyfile,
  'prefix=s' => \$dirprefix,
  'P|product=s' => \$product,
  'A|approve=s' => \$approve,
  'O|orgid=s' => \$orgid,
  'V|val|validity=i' => \$validity,
  'r|request' => \$mode_req,
  'a|postapprove' => \$mode_appr,
  'i|install|retrieve' => \$mode_retr,
  'h|help' => \$help
) or exit 1;

if ( $help ) { &help; exit 0 }

# ###########################################################################
#
# validate options and input
die "Requires a mode (-r or -i or -a) for running\n"
 if ! $mode_req and ! $mode_retr and ! $mode_appr;

$hostname = $ARGV[0] or die "No argument hostname";
$hostname =~ s/^$dirprefix//; # if you used the dirname instead ...
die "Invalid hostname $hostname\n" 
  if ( $hostname !~ /^[a-z][-0-9a-z]+\.[a-z][-0-9a-z\.]+$/ );

$dir = "$dirprefix$hostname" unless $dir;
$basedir=$dir;
if ( $subdir ne "" ) { $dir .= "/$subdir"; }

die "Invalid subdir (not a SUBdir) in $subdir\n" if $subdir =~ /^\//;
die "Cannot retrieve cert for $hostname if not requested this way,\n".
    "and directory $dir does not exist\n" if ( $mode_retr and ! -d $dir );
die "Cannot re-use existing $dir for request\n"
  if $mode_req and -d $dir;
die "TCS directory $dir has no orderID\n" 
  if $mode_retr and ! -e "$dir/orderid.txt";
die "Invalid validity (not a number or too long): $validity\n"
  if $validity !~ /^\d+$/ or $validity > 3;
die "Cannot approve on installation (but on request or explicit only)\n"
  if $mode_retr && $approve;
die "Cannot approve without an approval comment\n"
  if $mode_appr && ( $approve eq "" );

die "Expected argument FQDN\n" if ( $#ARGV < 0 );

# ###########################################################################
#
# read password if needed from file or use env var DIGICERTAPIKEY or STDIN
my $apikey;
if ( $apikeyfile ne "none" && $apikeyfile ne "" && -e $apikeyfile ) {
  open FH,"<$apikeyfile";
  $apikey = <FH>; chomp($apikey);
  close FH;
} elsif (defined($ENV{DIGICERTAPIKEY})) {
  $apikey = $ENV{DIGICERTAPIKEY};
} else {
  print "Provide API key: ";
  system("stty -echo");
  $apikey = <STDIN>; chomp($apikey);
  system("stty echo"); print "***\n";
}
#die "Invalid API key length\n" if length($apikey) != $apikeylen;

# ###########################################################################
# setup defaults and LWP
#
# initialise UA
my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 });
$ua->agent("dctcs/0.2 (libwww-perl/$]; TERENA-TCS; $^O)");
$ua->default_header('X-DC-DEVKEY' => $apikey);
$ua->default_header('Content-Type' => "application/json");
$ua->default_header('Accept' => "application/json");

# ###########################################################################
# Actions: request or install
#
if ( $mode_req ) {
  # #########################################################################
  #
  print "Creating request and order for $hostname\n";

  if ( ! -d $basedir && $subdir ne "" ) { 
    mkdir $basedir or 
      die "Cannot create new basedir $basedir for $hostname: $!\n";
  }
  mkdir $dir or die "Cannot create new subdir $dir for $hostname: $!\n";

  # generate request using OpenSSL
  my $rc = system("openssl req -new -nodes -keyout $dir/key-$hostname.pem ".
	        "-out $dir/req-$hostname.pem -newkey rsa:2048 ".
		"-subj '/C=NL/O=Nikhef/CN=$hostname'");
  die "Generation of CSR in $dir failed: $rc\n" if $rc;

  # construct request for DigiCert API v2 
  open CSR,"<$dir/req-$hostname.pem" or die "Cannot open CSR: $!\n";
  my $csr = ""; while (<CSR>)  { $csr .= $_; }; close CSR;

  # if the org is named, we need to resolve it to an ID in the 
  # user's current container
  if ( $orgid !~ /^\d+$/ ) { # it is a named org, so resolve
    my $containerid = &getContainerId($ua);
    print "Resolving org $orgid in container $containerid\n";

    my $oanswer = &getDump($ua,"GET", 
	                "container/$containerid/order/organization" );
  
    foreach my $iorg ( @{$oanswer->{"organizations"}} ) {
      if ( lc($iorg->{"name"}) eq lc($orgid) ) {
        $orgid = $iorg->{"id"}; last;
      }
    }
    die "Cannot resolve org $orgid via API\n" if ( $orgid !~ /^\d+$/ );
    print "Processing order for org #$orgid in container #$containerid\n";
  }

  my %request = (	
	"certificate" => {
		"common_name", "$hostname",
		"dns_names" , [ ],
		"csr", "$csr",
		"signature_hash", "sha256"
		},
	"organization" => { "id", "$orgid" },
	"validity_years", $validity,
	"comments", "Requested on $thishost for NDPF host $hostname ".
	            "by ".getpwuid( $< ),
	);

  # populate subjectAltName, with at least the primary FQDN
  $request{"certificate"}{"dns_names"} = [];
  foreach my $hn ( @ARGV ) {
	push @{$request{"certificate"}{"dns_names"}},$hn;
  }

  my $answer = &getDump($ua,"POST", 
	                "order/certificate/$product",to_json(\%request) );

  # store the OrderID, used by the installed, in a special file
  if ( defined $answer->{"id"} ) {
    open FH,">$dir/orderid.txt" and do {
	  print FH $answer->{"id"}."\n";
	  close FH;
    };
  };

  # save the full JSON answer, including requestID, for later perusal
  open FH,">$dir/response.json" and do {
	print FH to_json($answer);
	close FH;
  };

  # approval: needs a comment, and can only be done by Admins of CertCentral
  if ( $approve ne "" ) {
    my $requestid = $answer->{"requests"}[0]{"id"};
    if ( $requestid =~ /^\d+$/ ) {
      print "Approving request (attempt) for Request ID $requestid\n";
      my %approval = ( 
        "status" => "approved",
	"processor_comment" => "By ".getpwuid( $< ).": $approve"
	);
      my $approvalresult = &getDump($ua,"PUTDUMP","request/$requestid/status",
        to_json(\%approval));
      print "Approved: $approvalresult\n";
    } else {
      warn "Invalid request ID found ($requestid), sorry!\n";
    }
  }
  #
  # #########################################################################

} elsif ( $mode_retr ) {

  # #########################################################################
  #
  
  # works based on stored order number in dirctory
  print "Retrieving order for $hostname\n";

  open ORDERID,"<$dir/orderid.txt" or die "Cannot open OrderID $!\n";
  my $orderid = <ORDERID>; chomp($orderid);
  die "Invalid order ID $orderid\n" unless $orderid =~ /^\d+$/;

  my $answer = &getDump($ua,"GET","order/certificate/$orderid");

  die "No certificate for order $orderid (yet)\n" 
    unless defined $answer->{"certificate"}{"id"} and 
           $answer->{"certificate"}{"id"} =~ /^\d+$/;
  my $certid = $answer->{"certificate"}{"id"};

  print "Retrieving order $orderid certificate ID $certid\n";

  my $certdata = 
    &getDump($ua,"GETDUMP","/certificate/$certid/download/format/pem_all");

  # this splits the full PEM file of all into per-cert chunks with good naming
  my $i = 0; my $str = ""; my $processing = 0; my $eecname=""; my $l;

  my @certlist = split /[\r\n]+/, $certdata; # irrespective of EOLN in input
  foreach $l ( @certlist ) {
    if ( $l eq "-----BEGIN CERTIFICATE-----" ) {
	  $str = ""; $processing = 1;
    }
    if ( $l eq "-----END CERTIFICATE-----" ) {
          my ($subj,$olstr,$cn,$fname);

	  $str .= "$l\n"; $processing = 0;
	  ( $olstr = $str ) =~ s/\n/\\n/gm;

	  $subj = `echo -ne "$olstr" | openssl x509 -noout -subject`;
	  chomp($subj); $subj =~ s/^[^=]+= *//;

	  ( $cn = $subj ) =~ s/^.*\/CN=//;
	  ( $fname = $cn ) =~ s/\s+//g;
	  open CF,">$dir/cert-$fname.pem" and do {
		print CF $str;
		close CF;
		if ( $i == 0 and $cn eq $hostname ) { 
		  $eecname = "$dir/cert-$fname.pem"; 
	        }
	  };
	  # informational output follows
	  print "Certificate $i (cert-$cn):\n";
	  print " Subject: $subj\n";
	  $i++;
    }
    if ( $processing ) { $str .= "$l\n"; }
  }
  
  # cater for subdir and release to usercert/userkey.pem
  if ( $userelease and $eecname ) {
    if ( $eecname ne "$dir/cert-$hostname.pem") {
      die "Naming inconsistency for $eecname, oops! ".
          "It is not $basedir/$subdir/cert-$hostname.pem\n";
    }
    if (  ( -e "$basedir/usercert.pem" && ! -l "$basedir/usercert.pem" )
       || ( -e "$basedir/userkey.pem" && ! -l "$basedir/userkey.pem" ) ) {
      warn "One of $basedir/user{key,cert}.pem not a symlink, release skipped"
    } else {
      unlink "$basedir/usercert.pem";
      unlink "$basedir/userkey.pem";
      $subdir = "." unless $subdir;
      symlink "$subdir/key-$hostname.pem","$basedir/userkey.pem";
      symlink "$subdir/cert-$hostname.pem","$basedir/usercert.pem";
      open FH,">$basedir/release.state" and close FH;
    }
  }

  #
  # #########################################################################

} elsif ( $mode_appr ) {

  # #########################################################################
  #
  
  # works based on stored order number in dirctory
  print "Approving first request for order for $hostname\n";

  open ORDERID,"<$dir/orderid.txt" or die "Cannot open OrderID $!\n";
  my $orderid = <ORDERID>; chomp($orderid);
  die "Invalid order ID $orderid\n" unless $orderid =~ /^\d+$/;

  my $answer = &getDump($ua,"GET","order/certificate/$orderid");

  die "No request for order $orderid (yet)\n" 
    unless defined $answer->{"requests"}[0]{"id"} and 
           $answer->{"requests"}[0]{"id"} =~ /^\d+$/;
  my $requestid = $answer->{"requests"}[0]{"id"};

  if ( $answer->{"status"} ne "needs_approval" ) {
    print "Order $orderid (request $requestid) already approved, skipping\n";
    exit 0;
  }

  print "Retrieving order $orderid request ID $requestid\n";

  # approval: needs a comment, and can only be done by Admins of CertCentral
  print "Approving request (attempt) for Request ID $requestid\n";
  my %approval = ( 
    "status" => "approved",
    "processor_comment" => "By ".getpwuid( $< ).": $approve"
  );
  my $approvalresult = &getDump($ua,"PUTDUMP","request/$requestid/status",
      to_json(\%approval));
  print "Approved: $approvalresult\n";

  # save the full JSON answer, including requestID, for later perusal
  open FH,">$dir/response-approval.json" and do {
    print FH $approvalresult;
    close FH;
  };
}

exit 0;

# ###########################################################################
#

# getDump($ua,"(GET|PUT|GETDUMP|PUTDUMP|POST|POSTDUMP)",$url,[$content])
#   where the "DUMP" modes will return plain text from the answer, but
#   the default modes will return a perl object created from the JSON
#
sub getDump($$$$) {
  my ($ua,$type,$request,$content) = @_;
  my $data;
  $type = "GET" unless (defined $type and $type ne "");
  die "Invalid call with GET and contents\n" 
    if ( $type eq "GET" and defined $content and $content ne "");

  my $outtype = $type; 
  $type =~ s/DUMP$//;

  my $req = HTTP::Request->new($type => "$resturl/$request");
  if ( ( $type eq "POST" || $type eq "PUT" ) 
       and defined $content and $content ne "" ) {
    $req->content($content);
  }

  my $res = $ua->request($req);

  if ($res->is_success) {
    if ( $outtype =~ /DUMP/ ) { $data = $res->content; }
    else { $data = from_json($res->content); }
  } else {
    die "Invalid API call: ", $res->status_line, "\n";
  }
  return $data;
}

# example of a specific API wrapper 
sub getContainerId($) {
  my ($ua) = @_;
  my $data;

  my $req = HTTP::Request->new(GET => "$resturl/user/me");
  my $res = $ua->request($req);

  if ($res->is_success) {
    $data = from_json($res->content);
  } else {
    die "Invalid API call: ", $res->status_line, "\n";
  }
  return $data->{container}{id};
}

# ###########################################################################
# Valid products
#
# 'name_id' => 'client_digital_signature_plus',
# 'name_id' => 'client_email_security_plus',
# 'name_id' => 'client_grid_premium',
# 'name_id' => 'client_grid_robot_email',
# 'name_id' => 'client_grid_robot_fqdn',
# 'name_id' => 'client_grid_robot_name',
# 'name_id' => 'client_premium',
# 'name_id' => 'code_signing',
# 'name_id' => 'code_signing_ev',
# 'name_id' => 'document_signing_org_1',
# 'name_id' => 'document_signing_org_2',
# 'name_id' => 'grid_host_ssl',
# 'name_id' => 'grid_host_ssl_multi_domain',
# 'name_id' => 'ssl_ev_multi_domain',
# 'name_id' => 'ssl_ev_plus',
# 'name_id' => 'ssl_multi_domain',
# 'name_id' => 'ssl_plus',
# 'name_id' => 'ssl_wildcard',
# 

# ###########################################################################
# HELP

sub help() {

  ( my $base = $0 ) =~ s/^.*\///;
  print <<EOF;
Request and retrieve certificates from the TCS DigiCert service via the API

 $base [-P product] [-R] [-s path] [-d basedir] [-A comment] [-K keyfile]
             [-O orgid]
             [-r|-i] hostname [altname ...]

  -r            enter REQUEST mode       + either -r, -i, or -a required
  -i            enter INSTALLATION mode  +
  -a            enter APPROVE mode (admins only)

  -P <product>  order <product>, with "grid_host_ssl_multi_domain" the default
                but "ssl_multi_domain" also useful. See below
  -V validity   validity request period in years (default: 1)
  -K keyfile    file with the API key for the user as a single line
  -O orgid      Organisation name or ID
  -s subdir     use <subdir> for key, cert, and orderid storage (no default)
  -R            use the NDPF vlaai symlink & release.state mechanism
                which works best with subdir usage (will touch release.state)
  -A comment    Approve request as well, with "comment" (admins only)
  --prefix=dir  dir prefix (defaults to "tcs-")

All certs are requested with SHA256 digest. Other products that might
work with this script are:
  grid_host_ssl, grid_host_ssl_multi_domain
  ssl_ev_multi_domain, ssl_ev_plus
  ssl_multi_domain, ssl_plus
But note that EV requires an extra approval step by the EV admin, and
that wildcard certs will mess up the directory naming. 
EOF
  return 0;
}