1#!/usr/bin/env perl
2use strict;
3use warnings;
4use Getopt::Long;
5use IO::File;
6use JSON::MaybeXS;
7use Log::Log4perl;
8use Log::Log4perl::Level;
9use Module::Load;
10use Encode 'decode';
11use Digest::SHA 'sha256';
12use MIME::Base64 'encode_base64url';
13use Crypt::LE ':errors', ':keys';
14use utf8;
15
16my $VERSION = '0.38';
17
18exit main();
19
20sub main {
21    Log::Log4perl->easy_init({ utf8  => 1 });
22    my $opt = { logger => Log::Log4perl->get_logger(), e => encode_args(), error => parse_config() };
23    binmode(STDOUT, ":encoding(UTF-8)");
24    if (my $rv = work($opt)) {
25        $opt->{logger}->error($rv->{'msg'}) if $rv->{'msg'};
26        return defined $rv->{'code'} ? $rv->{'code'} : 255;
27    }
28    return 0;
29}
30
31sub work {
32    my $opt = shift;
33    my $rv = parse_options($opt);
34    return $rv if $rv;
35    # Set the default protocol version to 2 unless it is set explicitly or custom server/directory is set (in which case auto-sense is used).
36    $opt->{'api'} = 2 unless (defined $opt->{'api'} or $opt->{'server'} or $opt->{'directory'});
37    my $le = Crypt::LE->new(
38	autodir => 0,
39	dir => $opt->{'directory'},
40	server => $opt->{'server'},
41	live => $opt->{'live'},
42	version => $opt->{'api'}||0,
43	debug => $opt->{'debug'},
44	logger => $opt->{'logger'},
45    );
46
47    if (-r $opt->{'key'}) {
48        $opt->{'logger'}->info("Loading an account key from $opt->{'key'}");
49        $le->load_account_key($opt->{'key'}) == OK or return $opt->{'error'}->("Could not load an account key: " . $le->error_details, 'ACCOUNT_KEY_LOAD');
50    } else {
51        $opt->{'logger'}->info("Generating a new account key");
52        $le->generate_account_key == OK or return $opt->{'error'}->("Could not generate an account key: " . $le->error_details, 'ACCOUNT_KEY_GENERATE');
53        $opt->{'logger'}->info("Saving generated account key into $opt->{'key'}");
54        return $opt->{'error'}->("Failed to save an account key file", 'ACCOUNT_KEY_SAVE') if _write($opt->{'key'}, $le->account_key);
55    }
56
57    if ($opt->{'update-contacts'}) {
58        # Register.
59        my $reg = _register($le, $opt);
60        return $reg if $reg;
61        my @contacts = (lc($opt->{'update-contacts'}) eq 'none') ? () : grep { $_ } split /\s*\,\s*/, $opt->{'update-contacts'};
62        my @rejected = ();
63        foreach (@contacts) {
64            /^(\w+:)?(.+)$/;
65            # NB: tel is not supported by LE at the moment.
66            my ($prefix, $data) = (lc($1||''), $2);
67            push @rejected, $_ unless ($data=~/^[^\@]+\@[^\.]+\.[^\.]+/ and (!$prefix or ($prefix eq 'mailto:')));
68        }
69        return $opt->{'error'}->("Unknown format for the contacts: " . join(", ", @rejected), 'CONTACTS_FORMAT') if @rejected;
70        return $opt->{'error'}->("Could not update contact details: " . $le->error_details, 'CONTACTS_UPDATE') if $le->update_contacts(\@contacts);
71        $opt->{'logger'}->info("Contact details have been updated.");
72        return;
73    }
74
75    if ($opt->{'revoke'}) {
76        my $crt = _read($opt->{'crt'});
77        return $opt->{'error'}->("Could not read the certificate file.", 'CERTIFICATE_FILE_READ') unless $crt;
78        # Take the first certificate in file, disregard the issuer's one.
79        $crt=~s/^(.*?-+\s*END CERTIFICATE\s*-+).*/$1/s;
80
81        # Register.
82        my $reg = _register($le, $opt);
83        return $reg if $reg;
84        my $rv = $le->revoke_certificate(\$crt);
85        if ($rv == OK) {
86            $opt->{'logger'}->info("Certificate has been revoked.");
87        } elsif ($rv == ALREADY_DONE) {
88            $opt->{'logger'}->info("Certificate has been ALREADY revoked.");
89        } else {
90            return $opt->{'error'}->("Problem with revoking certificate: " . $le->error_details, 'CERTIFICATE_REVOKE');
91        }
92        return;
93    }
94
95    if ($opt->{'domains'}) {
96        if ($opt->{'e'}) {
97            $opt->{'logger'}->warn("Could not encode arguments, support for internationalized domain names may not be available.");
98        } else {
99            my @domains = grep { $_ } split /\s*\,\s*/, $opt->{'domains'};
100            $opt->{'domains'} = join ",", map { _puny($_) } @domains;
101        }
102    }
103    if (-r $opt->{'csr'}) {
104        $opt->{'logger'}->info("Loading a CSR from $opt->{'csr'}");
105        $le->load_csr($opt->{'csr'}, $opt->{'domains'}) == OK or return $opt->{'error'}->("Could not load a CSR: " . $le->error_details, 'CSR_LOAD');
106        return $opt->{'error'}->("For multi-webroot path usage, the amount of paths given should match the amount of domain names listed.", 'WEBROOT_MISMATCH') if _path_mismatch($le, $opt);
107        # Load existing CSR key if specified, even if we have CSR (for example for PFX export).
108        if ($opt->{'csr-key'} and -e $opt->{'csr-key'}) {
109            return $opt->{'error'}->("Could not load existing CSR key from $opt->{'csr-key'} - " . $le->error_details, 'CSR_KEY_LOAD') if $le->load_csr_key($opt->{'csr-key'});
110        }
111    } else {
112        $opt->{'logger'}->info("Generating a new CSR for domains $opt->{'domains'}");
113        if (-e $opt->{'csr-key'}) {
114             # Allow using pre-existing key when generating CSR
115             return $opt->{'error'}->("Could not load existing CSR key from $opt->{'csr-key'} - " . $le->error_details, 'CSR_KEY_LOAD') if $le->load_csr_key($opt->{'csr-key'});
116             $opt->{'logger'}->info("New CSR will be based on '$opt->{'csr-key'}' key");
117        } else {
118             $opt->{'logger'}->info("New CSR will be based on a generated key");
119        }
120        my ($type, $attr) = $opt->{'curve'} ? (KEY_ECC, $opt->{'curve'}) : (KEY_RSA, $opt->{'legacy'} ? 2048 : 4096);
121        $le->generate_csr($opt->{'domains'}, $type, $attr) == OK or return $opt->{'error'}->("Could not generate a CSR: " . $le->error_details, 'CSR_GENERATE');
122        $opt->{'logger'}->info("Saving a new CSR into $opt->{'csr'}");
123        return "Failed to save a CSR" if _write($opt->{'csr'}, $le->csr);
124        unless (-e $opt->{'csr-key'}) {
125            $opt->{'logger'}->info("Saving a new CSR key into $opt->{'csr-key'}");
126            return $opt->{'error'}->("Failed to save a CSR key", 'CSR_SAVE') if _write($opt->{'csr-key'}, $le->csr_key);
127        }
128        return $opt->{'error'}->("For multi-webroot path usage, the amount of paths given should match the amount of domain names listed.", 'WEBROOT_MISMATCH') if _path_mismatch($le, $opt);
129    }
130
131    return if $opt->{'generate-only'};
132
133    if ($opt->{'renew'}) {
134        if ($opt->{'crt'} and -r $opt->{'crt'}) {
135            $opt->{'logger'}->info("Checking certificate for expiration (local file).");
136            $opt->{'expires'} = $le->check_expiration($opt->{'crt'});
137            $opt->{'logger'}->warn("Problem checking existing certificate file.") unless (defined $opt->{'expires'});
138        }
139        unless (defined $opt->{'expires'}) {
140            $opt->{'logger'}->info("Checking certificate for expiration (website connection).");
141            if ($opt->{'renew-check'}) {
142                $opt->{'logger'}->info("Checking $opt->{'renew-check'}");
143                $opt->{'expires'} = $le->check_expiration("https://$opt->{'renew-check'}/");
144            } else {
145                my %seen;
146                # Check wildcards last, try www for those unless already seen.
147                foreach my $e (sort { $b cmp $a } @{$le->domains}) {
148                   my $domain = $e=~/^\*\.(.+)$/ ? "www.$1" : $e;
149                   next if $seen{$domain}++;
150                   $opt->{'logger'}->info("Checking $domain");
151                   $opt->{'expires'} = $le->check_expiration("https://$domain/");
152                   last if (defined $opt->{'expires'});
153               }
154            }
155        }
156        return $opt->{'error'}->("Could not get the certificate expiration value, cannot renew.", 'EXPIRATION_GET') unless (defined $opt->{'expires'});
157        if ($opt->{'expires'} > $opt->{'renew'}) {
158            # A bit specific case - this is not an error technically but some might want an error code.
159            # So the message is displayed on "info" level to prevent getting through "quiet" mode, but an error can still be set.
160            $opt->{'logger'}->info("Too early for renewal, certificate expires in $opt->{'expires'} days.");
161            return $opt->{'error'}->("", 'EXPIRATION_EARLY');
162        }
163        $opt->{'logger'}->info("Expiration threshold set at $opt->{'renew'} days, the certificate " . ($opt->{'expires'} < 0 ? "has already expired" : "expires in $opt->{'expires'} days") . " - will be renewing.");
164    }
165
166    if ($opt->{'email'}) {
167        return $opt->{'error'}->($le->error_details, 'EMAIL_SET') if $le->set_account_email($opt->{'email'});
168    }
169
170    # Register.
171    my $reg = _register($le, $opt);
172    return $reg if $reg;
173
174    # Build a copy of the parameters from the command line and added during the runtime, reduced to plain vars and hashrefs.
175    my %callback_data = map { $_ => $opt->{$_} } grep { ! ref $opt->{$_} or ref $opt->{$_} eq 'HASH' } keys %{$opt};
176
177    # We might not need to re-verify, verification holds for a while. NB: Only do that for the standard LE servers.
178    my $new_crt_status = ($opt->{'server'} or $opt->{'directory'}) ? AUTH_ERROR : $le->request_certificate();
179    unless ($new_crt_status) {
180        $opt->{'logger'}->info("Received domain certificate, no validation required at this time.");
181    } else {
182        # If it's not an auth problem, but blacklisted domains for example - stop.
183        return $opt->{'error'}->("Error requesting certificate: " . $le->error_details, 'CERTIFICATE_GET') if $new_crt_status != AUTH_ERROR;
184        # Handle DNS internally along with HTTP
185        my ($challenge_handler, $verification_handler) = ($opt->{'handler'}, $opt->{'handler'});
186        if (!$opt->{'handler'}) {
187            if ($opt->{'handle-as'}) {
188                return $opt->{'error'}->("Only 'http' and 'dns' can be handled internally, use external modules for other verification types.", 'VERIFICATION_METHOD') unless $opt->{'handle-as'}=~/^(http|dns)$/i;
189                if (lc($1) eq 'dns') {
190                    ($challenge_handler, $verification_handler) = (\&process_challenge_dns, \&process_verification_dns);
191                }
192            }
193        }
194
195        return $opt->{'error'}->($le->error_details, 'CHALLENGE_REQUEST') if $le->request_challenge();
196        return $opt->{'error'}->($le->error_details, 'CHALLENGE_ACCEPT') if $le->accept_challenge($challenge_handler || \&process_challenge, \%callback_data, $opt->{'handle-as'});
197
198        # If delayed mode is requested, exit early with the same code as for the issuance.
199        return { code => $opt->{'issue-code'}||0 } if $opt->{'delayed'};
200
201        # Refresh nonce in case of a long delay between the challenge and the verification step.
202        return $opt->{'error'}->($le->error_details, 'NONCE_REFRESH') unless $le->new_nonce();
203        return $opt->{'error'}->($le->error_details, 'CHALLENGE_VERIFY') if $le->verify_challenge($verification_handler || \&process_verification, \%callback_data, $opt->{'handle-as'});
204    }
205    unless ($le->certificate) {
206        $opt->{'logger'}->info("Requesting domain certificate.");
207        return $opt->{'error'}->($le->error_details, 'CERTIFICATE_REQUEST') if $le->request_certificate();
208    }
209
210    my ($certificate, $issuer, $saved);
211
212    if ($opt->{'alternative'}) {
213        $opt->{'logger'}->info("Requesting alternative certificates.");
214        return $opt->{'logger'}->error($le->error_details, 'CERTIFICATE_REQUEST') if $le->request_alternatives();
215        if (my $alternative = $le->alternative_certificate($opt->{'alternative'} - 1)) {
216            ($certificate, $issuer) = @{$alternative};
217        } else {
218            return $opt->{'error'}->("There is no alternative certificate #$opt->{'alternative'}.", 'CERTIFICATE_REQUEST');
219        }
220    } else {
221        $opt->{'logger'}->info("Requesting issuer's certificate.");
222        $certificate = $le->certificate;
223        if ($le->request_issuer_certificate()) {
224            $opt->{'logger'}->error("Could not download an issuer's certificate, " . ($le->issuer_url ? "try to download manually from " . $le->issuer_url : "the URL has not been provided."));
225            $opt->{'logger'}->warn("Will be saving the domain certificate alone, not the full chain.");
226            return $opt->{'error'}->("Failed to save the domain certificate file", 'CERTIFICATE_SAVE') if _write($opt->{'crt'}, $certificate);
227            $saved = 1;
228        } else {
229            $issuer = $le->issuer;
230        }
231    }
232
233    unless ($saved) {
234        unless ($opt->{'legacy'}) {
235            $opt->{'logger'}->info("Saving the full certificate chain to $opt->{'crt'}.");
236            return $opt->{'error'}->("Failed to save the domain certificate file", 'CERTIFICATE_SAVE') if _write($opt->{'crt'}, $certificate . "\n" . $issuer . "\n");
237        } else {
238            $opt->{'logger'}->info("Saving the domain certificate to $opt->{'crt'}.");
239            return $opt->{'error'}->("Failed to save the domain certificate file", 'CERTIFICATE_SAVE') if _write($opt->{'crt'}, $certificate);
240            $opt->{'crt'}=~s/\.[^\.]+$//;
241            $opt->{'crt'}.='.ca';
242            $opt->{'logger'}->info("Saving the issuer's certificate to $opt->{'crt'}.");
243            $opt->{'logger'}->error("Failed to save the issuer's certificate", 'CERTIFICATE_SAVE') if _write($opt->{'crt'}, $issuer);
244        }
245    }
246    if ($opt->{'export-pfx'}) {
247        # Note: At this point the certificate is already issued, but with pfx export option active we will return an error if export has failed, to avoid triggering
248        # the 'success' batch processing IIS users might have set up on issuance and export.
249        if ($issuer) {
250            my $target_pfx = $opt->{'crt'};
251            $target_pfx=~s/\.[^\.]*$//;
252            $opt->{'logger'}->info("Exporting certificate to $target_pfx.pfx.");
253            return $opt->{'error'}->("Error exporting pfx: " . $le->error_details, 'CERTIFICATE_EXPORT') if $le->export_pfx("$target_pfx.pfx", $opt->{'export-pfx'}, $certificate, $le->csr_key, $issuer, $opt->{'tag-pfx'});
254        } else {
255            return $opt->{'error'}->("Issuer's certificate is not available, skipping pfx export to avoid creating an invalid pfx.", 'CERTIFICATE_EXPORT_ISSUER');
256        }
257    }
258    if ($opt->{'complete-handler'}) {
259        my $data = {
260            # Note, certificate here is just a domain certificate, issuer is passed separately - so handler could merge those or use them separately as well.
261            certificate => $le->certificate, certificate_file => $opt->{'crt'}, key_file => $opt->{'csr-key'}, issuer => $le->issuer, alternatives => $le->alternative_certificates(),
262            domains => $le->domains, logger => $opt->{'logger'},
263        };
264        my $rv;
265        eval {
266            $rv = $opt->{'complete-handler'}->complete($data, \%callback_data);
267        };
268        if ($@ or !$rv) {
269            return $opt->{'error'}->("Completion handler " . ($@ ? "thrown an error: $@" : "did not return a true value"), 'COMPLETION_HANDLER');
270        }
271    }
272    $opt->{'logger'}->info("===> NOTE: You have been using the test server for this certificate. To issue a valid trusted certificate add --live option.") unless $opt->{'live'};
273    $opt->{'logger'}->info("The job is done, enjoy your certificate!\n");
274    return { code => $opt->{'issue-code'}||0 };
275}
276
277sub parse_options {
278    my $opt = shift;
279    my $args = @ARGV;
280
281    GetOptions ($opt, 'key=s', 'csr=s', 'csr-key=s', 'domains=s', 'path=s', 'crt=s', 'email=s', 'curve=s', 'server=s', 'directory=s', 'api=i', 'config=s', 'renew=i', 'renew-check=s','issue-code=i',
282        'handle-with=s', 'handle-as=s', 'handle-params=s', 'complete-with=s', 'complete-params=s', 'log-config=s', 'update-contacts=s', 'export-pfx=s', 'tag-pfx=s',
283        'alternative=i', 'generate-missing', 'generate-only', 'revoke', 'legacy', 'unlink', 'delayed', 'live', 'quiet', 'debug+', 'help') ||
284        return $opt->{'error'}->("Use --help to see the usage examples.", 'PARAMETERS_PARSE');
285
286    if ($opt->{'config'}) {
287        return $opt->{'error'}->("Configuration file '$opt->{'config'}' is not readable", 'PARAMETERS_PARSE') unless -r $opt->{'config'};
288        my $rv = parse_config($opt);
289        return $opt->{'error'}->("Configuration file error: $rv" , 'PARAMETERS_PARSE') if $rv;
290    }
291
292    usage_and_exit($opt) unless ($args and !$opt->{'help'});
293    my $rv = reconfigure_log($opt);
294    return $rv if $rv;
295
296    $opt->{'logger'}->info("[ Crypt::LE client v$VERSION started. ]");
297    my $custom_server;
298
299    foreach my $url_type (qw<server directory>) {
300        if ($opt->{$url_type}) {
301            return $opt->{'error'}->("Unsupported protocol for the custom $url_type URL: $1.", 'CUSTOM_' . uc($url_type) . '_URL') if ($opt->{$url_type}=~s~^(.*?)://~~ and uc($1) ne 'HTTPS');
302            my $server = $opt->{$url_type}; # For logging.
303            $opt->{'logger'}->warn("Remember to URL-escape special characters if you are using $url_type URL with basic auth credentials.") if $server=~s~[^@/]*@~~;
304            $opt->{'logger'}->info("Custom $url_type URL 'https://$server' is used.");
305            $opt->{'logger'}->warn("Note: '$url_type' setting takes over the 'server' one.") if $custom_server;
306            $custom_server = 1;
307        }
308    }
309    $opt->{'logger'}->warn("Note: 'live' option is ignored.") if ($opt->{'live'} and $custom_server);
310
311    if ($opt->{'renew-check'}) {
312        $opt->{'error'}->("Unsupported protocol for the renew check URL: $1.", 'RENEW_CHECK_URL') if ($opt->{'renew-check'}=~s~^(.*?)://~~ and uc($1) ne 'HTTPS');
313    }
314
315    return $opt->{'error'}->("Incorrect parameters - need account key file name specified.", 'ACCOUNT_KEY_FILENAME_REQUIRED') unless $opt->{'key'};
316    if (-e $opt->{'key'}) {
317        return $opt->{'error'}->("Account key file is not readable.", 'ACCOUNT_KEY_NOT_READABLE') unless (-r $opt->{'key'});
318    } else {
319        return $opt->{'error'}->("Account key file is missing and the option to generate missing files is not used.", 'ACCOUNT_KEY_MISSING') unless $opt->{'generate-missing'};
320    }
321
322    unless ($opt->{'crt'} or $opt->{'generate-only'} or $opt->{'update-contacts'}) {
323        return $opt->{'error'}->("Please specify a file name for the certificate.", 'CERTIFICATE_FILENAME_REQUIRED');
324    }
325
326    if ($opt->{'export-pfx'}) {
327        if ($opt->{'crt'} and $opt->{'crt'}=~/\.pfx$/i) {
328            return $opt->{'error'}->("Please ensure that the extension of the certificate filename is different from '.pfx' to be able to additionally export the certificate in pfx form.", 'CERTIFICATE_BAD_FILENAME_EXTENSION');
329        }
330        unless ($opt->{'csr-key'} and (-r $opt->{'csr-key'} or ($opt->{'generate-missing'} and ! -e $opt->{'csr'}))) {
331            return $opt->{'error'}->("Need either existing csr-key specified or having CSR file generated (via 'generate-missing') for PFX export to work", 'NEED_CSR_KEY_FOR_EXPORT');
332        }
333    } elsif ($opt->{'tag-pfx'}) {
334        $opt->{'logger'}->warn("Option 'tag-pfx' makes no sense without 'export-pfx' - ignoring.");
335    }
336
337    if ($opt->{'revoke'}) {
338        return $opt->{'error'}->("Need a certificate file for revoke to work.", 'NEED_CERTIFICATE_FOR_REVOKE') unless ($opt->{'crt'} and -r $opt->{'crt'});
339        return $opt->{'error'}->("Need an account key - revoke assumes you had a registered account when got the certificate.", 'NEED_ACCOUNT_KEY_FOR_REVOKE') unless (-r $opt->{'key'});
340    } elsif (!$opt->{'update-contacts'}) {
341        return $opt->{'error'}->("Incorrect parameters - need CSR file name specified.", 'CSR_FILENAME_REQUIRED') unless $opt->{'csr'};
342        if (-e $opt->{'csr'}) {
343            return $opt->{'error'}->("CSR file is not readable.", 'CSR_NOT_READABLE') unless (-r $opt->{'csr'});
344        } else {
345            return $opt->{'error'}->("CSR file is missing and the option to generate missing files is not used.", 'CSR_MISSING') unless $opt->{'generate-missing'};
346            return $opt->{'error'}->("CSR file is missing and CSR-key file name is not specified.", 'CSR_MISSING') unless $opt->{'csr-key'};
347            return $opt->{'error'}->("Domain list should be provided to generate a CSR.", 'DOMAINS_REQUIRED') unless ($opt->{'domains'} and $opt->{'domains'}!~/^[\s\,]*$/);
348        }
349
350        if ($opt->{'path'}) {
351            my @non_writable = ();
352            foreach my $path (grep { $_ } split /\s*,\s*/, $opt->{'path'}) {
353                push @non_writable, $path unless (-d $path and -w _);
354            }
355            return $opt->{'error'}->("Path to save challenge files into should be a writable directory for: " . join(', ', @non_writable), 'CHALLENGE_DIRECTORY_NOT_WRITABLE') if @non_writable;
356        } elsif ($opt->{'unlink'}) {
357            return $opt->{'error'}->("Unlink option will have no effect without --path.", 'UNLINK_WITHOUT_PATH');
358        }
359
360        $opt->{'handle-as'} = $opt->{'handle-as'} ? lc($opt->{'handle-as'}) : 'http';
361
362        if ($opt->{'handle-with'}) {
363            my $error = _load_mod($opt, 'handle-with', 'handler');
364            return $opt->{'error'}->("Cannot use the module to handle challenges with - $error", 'CHALLENGE_MODULE_UNAVAILABLE') if $error;
365            my $method = 'handle_challenge_' . $opt->{'handle-as'};
366            return $opt->{'error'}->("Module to handle challenges does not seem to support the challenge type of $opt->{'handle-as'}.", 'CHALLENGE_MODULE_UNSUPPORTED') unless $opt->{'handler'}->can($method);
367            my $rv = _load_params($opt, 'handle-params');
368            return $rv if $rv;
369        }
370
371        if ($opt->{'complete-with'}) {
372            my $error = _load_mod($opt, 'complete-with', 'complete-handler');
373            return $opt->{'error'}->("Cannot use the module to complete processing with - $error.", 'COMPLETION_MODULE_UNAVAILABLE') if $error;
374            return $opt->{'error'}->("Module to complete processing with does not seem to support the required 'complete' method.", 'COMPLETION_MODULE_UNSUPPORTED') unless $opt->{'complete-handler'}->can('complete');
375            my $rv = _load_params($opt, 'complete-params');
376            return $rv if $rv;
377        }
378    }
379    return;
380}
381
382sub encode_args {
383    my @ARGVmod = ();
384    my @vals = ();
385    # Account for cmd-shell parameters splitting.
386    foreach my $param (@ARGV) {
387        if ($param=~/^-/) {
388            if (@vals) {
389                push @ARGVmod, join(" ", @vals);
390                @vals = ();
391            }
392            if ($param=~/^(.+?)\s*=\s*(.*)$/) {
393                push @ARGVmod, $1;
394                push @vals, $2 if $2;
395            } else {
396                push @ARGVmod, $param;
397            }
398        } else {
399            push @vals, $param;
400        }
401    }
402    push @ARGVmod, join(" ", @vals) if @vals;
403    @ARGV = @ARGVmod;
404    eval {
405        my $from;
406        if ($^O eq 'MSWin32') {
407            load 'Win32';
408            if (defined &Win32::GetACP) {
409                $from = "cp" . Win32::GetACP();
410            } else {
411                load 'Win32::API';
412                Win32::API->Import('kernel32', 'int GetACP()');
413                $from = "cp" . GetACP() if (defined &GetACP);
414            }
415            $from ||= 'cp1252';
416        } else {
417            load 'I18N::Langinfo';
418            $from = I18N::Langinfo::langinfo(&I18N::Langinfo::CODESET) || 'UTF-8';
419        }
420        @ARGV = map { decode $from, $_ } @ARGV;
421        autoload 'URI::_punycode';
422    };
423    return $@;
424}
425
426sub parse_config {
427    my ($opt) = @_;
428    unless ($opt) {
429        return sub {
430            return { code => 1, msg => shift }
431        }
432    }
433    if (my $config = _read($opt->{'config'})) {
434        # INI-like, simplified.
435        my ($cl, $section) = (0, '');
436        my $sections = {
437            errors => {
438                # NB: Early renewal stop is not considered an error by default.
439                EXPIRATION_EARLY => 0,
440            },
441        };
442        for (split /\r?\n/, $config) {
443            $cl++;
444            next if /^\s*(?:;|#)/;
445            if (/^\[\s*(\w*)\s*\]$/) {
446                $section = $1;
447                return "Invalid section at line $cl." unless ($section and $sections->{$section});
448            } else {
449                return "Invalid line $cl - outside of section." unless $section;
450                return "Invalid line $cl - not a key/value." unless /^\s*(\w+)\s*=\s*([^"'\;\#].*)$/;
451                my ($key, $val) = ($1, $2);
452                $val=~s/\s*(?:;|#).*$//;
453                $sections->{$section}->{$key} = $val;
454            }
455        }
456        # Process errors section.
457        my $debug = $opt->{'debug'};
458        my $errors = delete $sections->{'errors'};
459        $opt->{'error'} = sub {
460            my ($msg, $code) = @_;
461            if ($code and $code!~/^\d+$/) {
462                # Unless associated with 0 exit value, in debug mode
463                # prefix the message with a passed down code.
464                unless (!$debug or (defined $errors->{$code} and !$errors->{$code})) {
465                    $msg = "[ $code ] " . ($msg || '');
466                }
467                $code = $errors->{$code};
468            }
469            return { msg => $msg, code => $code };
470        };
471        return;
472    } else {
473        return "Could not read config file.";
474    }
475}
476
477sub reconfigure_log {
478    my $opt = shift;
479    if ($opt->{'log-config'}) {
480        eval {
481            Log::Log4perl::init($opt->{'log-config'});
482        };
483        if ($@ or !%{Log::Log4perl::appenders()}) {
484            Log::Log4perl->easy_init({ utf8  => 1 });
485            return $opt->{'error'}->("Could not init logging with '$opt->{'log-config'}' file", 'LOGGER_INIT');
486        }
487        $opt->{logger} = Log::Log4perl->get_logger();
488    }
489    $opt->{logger}->level($ERROR) if $opt->{'quiet'};
490    return;
491}
492
493sub _register {
494    my ($le, $opt) = @_;
495    return $opt->{'error'}->("Could not load the resource directory: " . $le->error_details, 'RESOURCE_DIRECTORY_LOAD') if $le->directory;
496    $opt->{'logger'}->info("Registering the account key");
497    return $opt->{'error'}->($le->error_details, 'REGISTRATION') if $le->register;
498    my $current_account_id = $le->registration_id || 'unknown';
499    $opt->{'logger'}->info($le->new_registration ? "The key has been successfully registered. ID: $current_account_id" : "The key is already registered. ID: $current_account_id");
500    $opt->{'logger'}->info("Make sure to check TOS at " . $le->tos) if ($le->tos_changed and $le->tos);
501    $le->accept_tos();
502    if (my $contacts = $le->contact_details) {
503        $opt->{'logger'}->info("Current contact details: " . join(", ", map { s/^\w+://; $_ } (ref $contacts eq 'ARRAY' ? @{$contacts} : ($contacts))));
504    }
505    return 0;
506}
507
508sub _puny {
509    my $domain = shift;
510    my @rv = ();
511    for (split /\./, $domain) {
512        my $enc = encode_punycode($_);
513        push @rv, ($_ eq $enc) ? $_ : 'xn--' . $enc;
514    }
515    return join '.', @rv;
516}
517
518sub _path_mismatch {
519    my ($le, $opt) = @_;
520    if ($opt->{'path'} and my $domains = $le->domains) {
521        my @paths = grep {$_} split /\s*,\s*/, $opt->{'path'};
522        if (@paths > 1) {
523            return 1 unless @{$domains} == @paths;
524            for (my $i = 0; $i <= $#paths; $i++) {
525                $opt->{'multiroot'}->{$domains->[$i]} = $paths[$i];
526            }
527        }
528    }
529    return 0;
530}
531
532sub _load_mod {
533    my ($opt, $type, $handler) = @_;
534    return unless ($opt and $opt->{$type});
535    eval {
536        my $mod = $opt->{$type};
537        if ($mod=~/(\w+)\.pm$/i) {
538            $mod = $1;
539            $opt->{$type} = "./$opt->{$type}" unless $opt->{$type}=~/^(\w+:|\.*[\/\\])/;
540        }
541        load $opt->{$type};
542        $opt->{$handler} = $mod->new();
543    };
544    if (my $rv = $@) {
545        $rv=~s/(?: in) \@INC .*$//s; $rv=~s/Compilation failed[^\n]+$//s;
546        return $rv || 'error';
547    }
548    return undef;
549}
550
551sub _load_params {
552    my ($opt, $type) = @_;
553    return unless ($opt and $opt->{$type});
554    if ($opt->{$type}!~/[\{\[\}\]]/) {
555        $opt->{$type} = _read($opt->{$type});
556        return $opt->{'error'}->("Could not read the file with '$type'.", 'FILE_READ') unless $opt->{$type};
557    }
558    my $j = JSON->new->canonical()->allow_nonref();
559    eval {
560        $opt->{$type} = $j->decode($opt->{$type});
561    };
562    return ($@ or (ref $opt->{$type} ne 'HASH')) ?
563        $opt->{'error'}->("Could not decode '$type'. Please make sure you are providing a valid JSON document and {} are in place." . ($opt->{'debug'} ? $@ : ''), 'JSON_DECODE') : 0;
564}
565
566sub _read {
567    my $file = shift;
568    return unless (-e $file and -r _);
569    my $fh = IO::File->new();
570    $fh->open($file, '<:encoding(UTF-8)') or return;
571    local $/;
572    my $src = <$fh>;
573    $fh->close;
574    return $src;
575}
576
577sub _write {
578    my ($file, $content) = @_;
579    return 1 unless ($file and $content);
580    my $fh = IO::File->new($file, 'w');
581    return 1 unless defined $fh;
582    $fh->binmode;
583    print $fh $content;
584    $fh->close;
585    return 0;
586}
587
588sub process_challenge {
589    my ($challenge, $params) = @_;
590    my $text = "$challenge->{token}.$challenge->{fingerprint}";
591    if ($params->{'path'}) {
592        my $path = $params->{'multiroot'} ? $params->{'multiroot'}->{$challenge->{domain}} : $params->{'path'};
593        unless ($path) {
594            $challenge->{'logger'}->error("Could not find the path for domain '$challenge->{domain}' to save the challenge file into.");
595            return 0;
596        }
597        my $file = "$path/$challenge->{token}";
598        if (-e $file) {
599           $challenge->{'logger'}->warn("File already exists - might happen if previous validations failed and -unlink option was not used.");
600        }
601        if (_write($file, $text)) {
602           $challenge->{'logger'}->error("Failed to save a challenge file '$file' for domain '$challenge->{domain}'");
603           return 0;
604        } else {
605           $challenge->{'logger'}->info("Successfully saved a challenge file '$file' for domain '$challenge->{domain}'");
606           return 1;
607        }
608    }
609    $challenge->{'logger'}->info("Challenge for $challenge->{domain} requires:\nA file '$challenge->{token}' in '/.well-known/acme-challenge/' with the text: $text\n");
610    unless ($params->{'delayed'}) {
611        print "When done, press <Enter>\n";
612        <STDIN>;
613    }
614    return 1;
615};
616
617sub process_verification {
618    my ($results, $params) = @_;
619    if ($results->{valid}) {
620        $results->{'logger'}->info("Domain verification results for '$results->{domain}': success.");
621    } else {
622        $results->{'logger'}->error("Domain verification results for '$results->{domain}': error. " . $results->{'error'});
623    }
624    my $path = $params->{'multiroot'} ? $params->{'multiroot'}->{$results->{domain}} : $params->{'path'};
625    my $file = $path ? "$path/$results->{token}" : $results->{token};
626    if ($params->{'unlink'}) {
627        unless ($path) {
628            $results->{'logger'}->error("Could not find the path for domain '$results->{domain}' - you may need to find and remove file named '$results->{token}' manually.");
629        } else {
630            if (-e $file) {
631                if (unlink $file) {
632                    $results->{'logger'}->info("Challenge file '$file' has been deleted.");
633                } else {
634                    $results->{'logger'}->error("Could not delete the challenge file '$file', you may need to do it manually.");
635                }
636            } else {
637                $results->{'logger'}->error("Could not find the challenge file '$file' to delete, it might have been already removed.");
638            }
639        }
640    } else {
641        $results->{'logger'}->info("You can now delete the '$file' file.");
642    }
643    1;
644}
645
646sub process_challenge_dns {
647    my ($challenge, $params) = @_;
648    my $value = encode_base64url(sha256("$challenge->{token}.$challenge->{fingerprint}"));
649    my (undef, $host) = $challenge->{domain}=~/^(\*\.)?(.+)$/;
650    $challenge->{'logger'}->info("Challenge for '$challenge->{domain}' requires the following DNS record to be created:\nHost: _acme-challenge.$host, type: TXT, value: $value\n");
651    unless ($params->{'delayed'}) {
652        print "Wait for DNS to update by checking it with the command: nslookup -q=TXT _acme-challenge.$host\nWhen you see a text record returned, press <Enter>\n";
653        <STDIN>;
654    }
655    return 1;
656}
657
658sub process_verification_dns {
659    my ($results, $params) = @_;
660    my (undef, $host) = $results->{domain}=~/^(\*\.)?(.+)$/;
661    $results->{logger}->info("Processing the 'dns' verification for '$results->{domain}'");
662    if ($results->{valid}) {
663        $results->{'logger'}->info("Domain verification results for '$results->{domain}': success.");
664    } else {
665        $results->{'logger'}->error("Domain verification results for '$results->{domain}': error. " . $results->{'error'});
666    }
667    $results->{'logger'}->info("You can now delete '_acme-challenge.$host' DNS record");
668    1;
669}
670
671sub usage_and_exit {
672    my $opt = shift;
673    print "\n Crypt::LE client v$VERSION\n\n";
674    if ($opt->{'help'}) {
675        print << 'EOF';
676 ===============
677 USAGE EXAMPLES:
678 ===============
679
680a) To register (if needed) and issue a certificate:
681
682 le.pl --key account.key --email "my@email.address" --csr domain.csr
683       --csr-key domain.key --crt domain.crt --generate-missing
684       --domains "www.domain.ext,domain.ext"
685
686If you want to additionally export the certificate into PFX format (for
687example to use it with IIS), add --export-pfx <password> as an option,
688where password is what will be used to secure your PFX. This option is
689currently only available for Windows binaries.
690
691Please note that --email parameter is only used for the initial registration.
692To update it later you can use --update-contacts option. Even though it is
693optional, you may want to have your email registered to receive certificate
694expiration notifications.
695
696b) To have challenge files automatically placed into your web directory
697   before the verification and then removed after the verification:
698
699 le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt
700       --domains "www.domain.ext,domain.ext" --generate-missing --unlink
701       --path /some/path/.well-known/acme-challenge
702
703If www.domain.ext and domain.ext use different "webroots", you can specify
704those in --path parameter, as a comma-separated list as follows:
705
706 le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt
707       --domains "www.domain.ext,domain.ext" --generate-missing --unlink
708       --path /a/.well-known/acme-challenge,/b/.well-known/acme-challenge
709
710Please note that with multiple webroots specified, the amount of those should
711match the amount of domains listed. They will be used in the same order as
712the domains given and all of those folders should be writable.
713
714c) To use external modules to handle challenges and process completion
715   while getting a certificate:
716
717 le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt
718       --domains "www.domain.ext,domain.ext" --generate-missing
719       --handle-with Crypt::LE::Challenge::Simple
720       --complete-with Crypt::LE::Complete::Simple
721
722   - See Crypt::LE::Challenge::Simple for an example of a challenge module.
723   - See Crypt::LE::Complete::Simple for an example of a completion module.
724
725d) To pass parameters to external modules as JSON either directly or by
726   specifying a file name:
727
728 le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt
729       --domains "www.domain.ext,domain.ext" --generate-missing
730       --handle-with Crypt::LE::Challenge::Simple
731       --complete-with Crypt::LE::Complete::Simple
732       --handle-params '{"key1": 1, "key2": 2, "key3": "something"}'
733       --complete-params complete.json
734
735e) To use basic DNS verification:
736
737 le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt
738       --domains "www.domain.ext,domain.ext" --generate-missing --handle-as dns
739
740f) To issue a wildcard certificate, which requires DNS verification:
741
742 le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt
743       --domains "*.domain.ext" --generate-missing --handle-as dns
744
745To include a "bare domain", add it too, since it is NOT covered by the wildcard:
746
747 le.pl --key account.key --csr domain.csr --csr-key domain.key --crt domain.crt
748        --domains "*.domain.ext,domain.ext" --generate-missing
749        --handle-as dns
750
751g) To just generate the keys and CSR:
752
753 le.pl --key account.key --csr domain.csr --csr-key domain.key
754       --domains "www.domain.ext,domain.ext" --generate-missing
755       --generate-only
756
757h) To revoke a certificate:
758
759 le.pl --key account.key --crt domain.crt --revoke
760
761i) To update your contact details:
762
763 le.pl --key account.key --update-contacts "one@example.com, two@example.com" --live
764
765j) To reset your contact details:
766
767 le.pl --key account.key --update-contacts "none" --live
768
769 ===============
770 RENEWAL PROCESS
771 ===============
772
773To RENEW your existing certificate: use the same command line as you used
774for issuing the certificate, with one additional parameter:
775
776 --renew XX, where XX is the number of days left until certificate expiration.
777
778If le.pl detects that it is XX or fewer days left until certificate expiration,
779then (and only then) the renewal process will be run, so the script can be
780safely put into crontab to run on a daily basis if needed. The amount of days
781left is checked by either of two methods:
782
783 1) If the certificate (which name is used with --crt parameter) is available
784    locally, then it will be loaded and checked.
785
786 2) If the certificate is not available locally (for example if you moved it
787    to another server), then an attempt to connect to the domains listed in
788    --domains or CSR will be made until the first successful response is
789    received. The peer certificate will be then checked for expiration.
790
791You can also use --renew-check option to specify an URL, against which a
792certificate will be checked for expirarion in case if it is not available
793locally.
794
795 ==========================
796 ISSUANCE AND RENEWAL NOTES
797 ==========================
798
799By default a staging server is used, which does not provide trusted
800certificates. This is to avoid exceeding a rate limits on Let's Encrypt
801live server. To generate an actual certificate, always add --live option.
802
803If you want to run the process in two steps (accept a challenge and then
804continue after running some other process), you can use --delayed flag.
805That flag interrupts the process once the challenge is received and
806appropriate information about what is required is printed or logged.
807
808Once you have fulfilled the requirements (by either creating a verification
809file or a DNS record), you can re-run the process without --delayed
810option.
811
812 ==================================
813 LOGGING CONFIGURATION FILE EXAMPLE
814 ==================================
815
816 log4perl.rootLogger=DEBUG, File, Screen
817 log4perl.appender.File = Log::Log4perl::Appender::File
818 log4perl.appender.File.filename = le.log
819 log4perl.appender.File.mode = append
820 log4perl.appender.File.layout = PatternLayout
821 log4perl.appender.File.layout.ConversionPattern = %d [%p] %m%n
822 log4perl.appender.File.utf8 = 1
823 log4perl.appender.Screen = Log::Log4perl::Appender::Screen
824 log4perl.appender.Screen.layout = PatternLayout
825 log4perl.appender.Screen.layout.ConversionPattern = %d [%p] %m%n
826 log4perl.appender.Screen.utf8 = 1
827
828EOF
829    }
830    print <<'EOF';
831 =====================
832 AVAILABLE PARAMETERS:
833 =====================
834
835-key <file>                  : Account key file.
836-csr <file>                  : CSR file.
837-csr-key <file>              : Key for CSR (optional if CSR exists).
838-crt <file>                  : Name for the domain certificate file.
839-domains <list>              : Domains list (optional if CSR exists).
840-renew <XX>                  : Renew if XX or fewer days are left.
841-renew-check <URL>           : Check expiration against a specific URL.
842-curve <name|default>        : ECC curve name (optional).
843-path <absolute path>        : Path to .well-known/acme-challenge/ (optional).
844-handle-with <module>        : Module to handle challenges with (optional).
845-handle-as <http|dns|tls>    : Type of challenge, by default 'http' (optional).
846-handle-params <json|file>   : JSON for the challenge module (optional).
847-complete-with <module>      : Module to handle completion with (optional).
848-complete-params <json|file> : JSON for the completion module (optional).
849-issue-code XXX              : Exit code to use on issuance/renewal (optional).
850-email <some@mail.address>   : Email for expiration notifications (optional).
851-server <url|host>           : Custom server URL for API root (optional).
852-directory <url>             : Custom server URL for API directory (optional).
853-api <version>               : API version to use (optional).
854-update-contacts <emails>    : Update contact details.
855-export-pfx <password>       : Export PFX (Windows binaries only).
856-tag-pfx <tag>               : Tag PFX with a specific name.
857-alternative <num>           : Save an alternative ceritifcate (if available).
858-config <file>               : Configuration file for the client.
859-log-config <file>           : Configuration file for logging.
860-generate-missing            : Generate missing files (key, csr and csr-key).
861-generate-only               : Exit after generating the missing files.
862-unlink                      : Remove challenge files automatically.
863-revoke                      : Revoke a certificate.
864-legacy                      : Legacy mode (shorter keys, separate CA file).
865-delayed                     : Exit after requesting the challenge.
866-live                        : Use the live server instead of the test one.
867-debug                       : Print out debug messages.
868-quiet                       : Suppress all messages but errors.
869-help                        : Detailed help.
870
871EOF
872    exit(1);
873}
874