#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
use IO::File;
use JSON::MaybeXS;
use Crypt::LE ':errors';

sub info { print shift, "\n" }
sub bail { &info; exit 255 }

my $VERSION = '0.10';

my ($account_key, $csr, $csr_key, $domains, $challenge_path, $crt, $live, $generate_missing, $generate_only, 
    $handle_with, $handle_as, $handle_params, $complete_with, $complete_params, $revoke, $verified, $debug, $help);

GetOptions ("key=s" => \$account_key, "csr=s" => \$csr, "csr-key=s" => \$csr_key, "domains=s" => \$domains, "path=s" => \$challenge_path,
            "crt=s" => \$crt, "generate-missing" => \$generate_missing, "generate-only" => \$generate_only, "handle-with=s" => \$handle_with,
	    "handle-as=s" => \$handle_as, "handle-params=s" => \$handle_params, "complete-with=s" => \$complete_with, 
            "complete-params=s" => \$complete_params, "revoke" => \$revoke, "live" => \$live, "debug" => \$debug, "verified" => \$verified, 
            "help" => \$help);

my $usage = <<EOF;

===============
Usage examples: 
===============

a) To register (if needed) and issue a certificate:

   le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt --domains "www.domain.ext,domain.ext" --generate-missing

b) To use external modules to handle challenges and process completion while getting a certificate:

   le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt --domains "www.domain.ext,domain.ext" --generate-missing \\
         --handle-with Crypt::LE::Challenge::Simple --complete-with Crypt::LE::Complete::Simple

   - See provided Crypt::LE::Challenge::Simple for an example of a challenge-handling module.
   - See provided Crypt::LE::Complete::Simple for an example of a completion-handling module.

c) To pass parameters to external modules as JSON either directly or by specifying a file name:

   le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt --domains "www.domain.ext,domain.ext" --generate-missing \\
         --handle-with Crypt::LE::Challenge::Simple --complete-with Crypt::LE::Complete::Simple \\
         --handle-params '{"key1": 1, "key2": 2, "key3": "something"}' --complete-params complete.json

d) To just generate the keys and CSR:

   le.pl  --key account.key --csr domain.csr --csr-key domain.key --domains "www.domain.ext,domain.ext" --generate-missing --generate-only

e) To revoke a certificate:

   le.pl --key account.key --crt domain.crt --revoke


[!] NOTE: by default a staging server is used, which does not provide trusted certificates. This is to aviod hitting a 
          rate limits on Let's Encrypt live server. To generate an actual certificate, always add --live option.

Available parameters:

 key <file>                       - Your account key file.
 csr <file>                       - Your CSR file.
 csr-key <file>                   - Key for your CSR (only mandatory if CSR is missing and to be generated).
 domains <list>                   - Domains as comma-separated list (only mandatory if CSR is missing).
 path <absolute path>             - Path to local .well-known/acme-challenge/ to drop required challenge files into (optional).
 handle-with <Some::Module>       - Module name to handle challenges with (optional).
 handle-as <http|dns|tls|...>     - Type of challenge to request, by default 'http' (optional).
 handle-params <{json}|file>      - JSON (or name of the file containing it) with parameters to be passed to the challenge-handling module (optional).
 complete-with <Another::Module>  - Module name to handle process completion with (optional).
 complete-params <{json}|file>    - JSON (or name of the file containing it) with parameters to be passed to the completion-handling module (optional).
 generate-missing                 - Generate missing files (key, csr and csr-key).
 generate-only                    - Generate a new key and/or CSR if they are missing and then exit.
 crt <file>                       - Name for the domain certificate file.
 verified                         - Skip challenge verification steps (request/accept/verify). Use only if domains have been already verified recently.
 revoke                           - Revoke a certificate.
 live                             - Connect to a live server instead of staging.
 debug                            - Print out debug messages.
 help                             - This screen.

EOF

info "\nCrypt::LE client v$VERSION started.\n";

bail $usage if $help;
my ($handler, $complete_handler);
binmode(STDOUT, ":utf8");

unless ($account_key and (-r $account_key or $generate_missing)) {
    info "Incorrect parameters - need an account key loaded or generated.";
    bail $usage;
}

unless ($crt or $generate_only) {
    bail "Please specify a file name for the certificate.";
}

if ($revoke) {
    bail "Need a certificate file for revoke to work." unless (-r $crt);
    bail "Need an account key - revoke assumes you had a registered account when got the certificate." unless (-r $account_key);
} else {
    unless ($csr and (-r $csr or ($csr_key and $generate_missing)))  {
        bail "Incorrect parameters - need CSR loaded or generated.";
    }

    if (!$generate_missing and ! -r $csr and (!$domains or $domains=~/^\s*$/)) {
        bail "Domain list should be provided to generate a CSR.";
    }

    if ($challenge_path) {
        bail "Path to save challenge files into should be a writable directory" unless (-d $challenge_path and -w _);
    }

    $handle_as = $handle_as ? lc($handle_as) : 'http';

    if ($handle_with) {
        eval "use $handle_with;";
        bail "Cannot use the module to handle challenges with." if $@;
        $handler = new $handle_with;
        my $method = 'handle_challenge_' . $handle_as;
        bail "Module to handle challenges does not seem to support the challenge type of '$handle_as'." unless $handler->can($method);
        $handle_params = _load_params($handle_params, 'handle-params');
    } else {
        undef $handle_params;
    }

    if ($complete_with) {
        eval "use $complete_with;";
        bail "Cannot use the module to complete processing with." if $@;
        $complete_handler = new $complete_with;
        bail "Module to complete processing with does not seem to support the required 'complete' method." unless $complete_handler->can('complete');
        $complete_params = _load_params($complete_params, 'complete-params');
    } else {
        undef $complete_params;
    }
}

# Begin work

my $le = Crypt::LE->new(debug => $debug, live => $live);

if (-r $account_key) {
    info "Loading an account key from $account_key";
    $le->load_account_key($account_key) == OK or bail "Could not load an account key: " . $le->error_details;
} else {
    info "Generating a new account key";
    $le->generate_account_key == OK or bail "Could not generate an account key: " . $le->error_details;
    info "Saving generated account key into $account_key";
    bail "Failed to save an account key file" if _write($account_key, $le->account_key);
}

if ($revoke) {
    my $rv = $le->revoke_certificate($crt);
    if ($rv == OK) {
        info "Certificate has been revoked.";
    } elsif ($rv == ALREADY_DONE) {
        info "Certificate has been ALREADY revoked.";
    } else {
        bail "Problem with revoking certificate: " . $le->error_details;
    }
    exit 0;
}

if (-r $csr) {
    info "Loading a CSR from $csr";
    $le->load_csr($csr, $domains) == OK or bail "Could not load a CSR: " . $le->error_details;
} else {
    info "Generating a new CSR for domains '$domains'";
    $le->generate_csr($domains) == OK or bail "Could not generate a CSR: " . $le->error_details;
    info "Saving a new CSR into $csr";
    bail "Failed to save a CSR" if _write($csr, $le->csr);
    info "Saving a new CSR key into $csr_key";
    bail "Failed to save a CSR key" if _write($csr_key, $le->csr_key);
}

exit if $generate_only;

bail $le->error_details if $le->register;
$le->accept_tos(); # No need to check explicitly for tos_changed() - Crypt::LE will handle that for you.
unless ($verified) {
    bail $le->error_details if $le->request_challenge();
    bail $le->error_details if $le->accept_challenge($handler ? $handler : \&process_challenge, $handle_params, $handle_as);
    bail $le->error_details if $le->verify_challenge($handler ? $handler : \&process_verification, $handle_params, $handle_as);
}
info "Requesting domain certificate";
bail $le->error_details if $le->request_certificate();
info "Requesting issuer's certificate";
if ($le->request_issuer_certificate()) {
    info "Could not download an issuer's certificate, try to download manually from " . $le->issuer_url;
    info "Will be saving the domain certificate alone, not the full chain (Qualys SSL test score will be capped to 'B' at best)";
    bail "Failed to save the domain certificate file" if _write($crt, $le->certificate);
} else {
    info "Saving the full certificate chain (With the proper server configuration and HSTS you can get an 'A+' on Qualys SSL test)";
    bail "Failed to save the domain certificate file" if _write($crt, $le->certificate . "\n" . $le->issuer);
}
if ($complete_handler) {
    my $data = {
        # Note, certificate here is just a domain certificate, issuer is passed separately - so handler 
        # could merge those or use them separately as well.
        certificate => $le->certificate, certificate_file => $crt, key_file => $csr_key, issuer => $le->issuer,
    };
    my $rv;
    eval {
	$rv = $complete_handler->complete($data, $complete_params);
    };
    if ($@ or !$rv) {
        bail "Completion handler " . ($@ ? "thrown an error: $@" : "did not return a true value");
    }
}

info "\nThe job is done, enjoy your certificate! For feedback and bug reports contact me at [ https://do-know.com ]\n";

sub _load_params {
    my ($src, $type) = @_;
    return undef unless $src;
    # To avoid adding more and more parameters, treat this as JSON if any of {}[] 
    # are present or as a file otherwise.
    if ($src!~/[\{\[\}\]]/) {
        $src = _read($src);
        bail "Could not read the file with '$type'." unless $src;
    }
    my $j = JSON->new->canonical()->allow_nonref();
    eval {
        $src = $j->decode($src);
    };
    bail "Could not decode '$type'. Please make sure you are providing a valid JSON document and {} are in place." . ($debug ? $@ : '') if ($@ or (ref $src ne 'HASH'));
    return $src;
}

sub _read {
    my $file = shift;
    return unless (-e $file and -r _);
    my $fh = IO::File->new();
    $fh->open($file, '<:encoding(UTF-8)') or return;
    local $/;
    my $src = <$fh>;
    $fh->close;
    return $src;
}

sub _write {
    my ($file, $content) = @_;
    return 1 unless ($file and $content);
    my $fh = IO::File->new($file, 'w');
    return 1 unless defined $fh;
    $fh->binmode;
    print $fh $content;
    $fh->close;
    return 0;
}

sub process_challenge {
    my $challenge = shift;
    my $text = "$challenge->{token}.$challenge->{fingerprint}";
    if ($challenge_path) {
        my $file = "$challenge_path/$challenge->{token}";
	if (_write($file, $text)) {
	   info "Failed to save a challenge file '$file' for domain '$challenge->{domain}'";
           return 0;
	} else {
           info "Successfully saved a challenge file '$file' for domain '$challenge->{domain}'";
           return 1;
        }
    }
    print <<EOF;
Challenge for $challenge->{domain} requires:
A file '$challenge->{token}' in '/.well-known/acme-challenge/' with the text: $text
When done, press <Enter>
EOF
 	<STDIN>;
	return 1;
};

sub process_verification {
    my $results = shift;
    info  "Domain verification results for '$results->{domain}': " . ($results->{valid} ? "success." : "error.");
    my $file = $challenge_path ? "$challenge_path/$results->{token}" : $results->{token};
    # NB: We don't delete challenge files automatically, this option might be added later.
    info "You can now delete the '$file' file.";
    1;
}
