]> Raphaël G. Git Repositories - acme/blob - acme
Rapsys Git / acme / blob
? search:


553911e2b368a9ba5b7c77d911311638ca333c2e
[acme] / acme
1 #! /usr/bin/perl
2
3 # This program is free software: you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation, either version 3 of the License, or
6 # (at your option) any later version.
7 #
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
12 #
13 # You should have received a copy of the GNU General Public License
14 # along with this program. If not, see <http://www.gnu.org/licenses/>.
15 #
16 # Copyright (C) 2016 - 2020 Raphaël Gertz <acme@rapsys.eu>
17
18 # Best practice
19 use strict;
20 use warnings;
21
22 # Load debug
23 #BEGIN {
24 # # Allow use of print Dumper($this);
25 # use Data::Dumper;
26 # # Prepend current directory in include array
27 # # XXX: this will load ./Acme.pm instead of an other version from system tree
28 # unshift @INC, '.';
29 #}
30
31 # Add acl support to file tests
32 use filetest qw(access);
33
34 # Load dependancies
35 use Carp qw(carp confess);
36 use File::Copy qw(copy);
37 use File::stat qw(stat);
38 use File::Slurp qw(read_file write_file);
39 use File::Spec qw(splitpath curdir);
40 use JSON qw(decode_json);
41 use Net::DNS qw();
42 use Net::Domain::TLD qw(tld_exists);
43 use Tie::IxHash;
44 use Acme;
45
46 # Load POSIX
47 use POSIX qw(EXIT_SUCCESS EXIT_FAILURE);
48
49 # Init verbose
50 my $verbose = 0;
51
52 # Init debian
53 my $debian = undef;
54
55 # Init action
56 my $action = undef;
57
58 # Init config
59 my $config = undef;
60 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
61 tie(%{$config}, 'Tie::IxHash');
62
63 # Init content
64 my $content = undef;
65
66 # Init config file name
67 my $configFilename = Acme::CONFIG;
68
69 # Init domains
70 my @domains = ();
71
72 # Process verbose
73 @ARGV = map { if ($_ eq '-v' or $_ eq '--verbose') { $verbose = 1; (); } else { $_; } } @ARGV;
74
75 # Process debian
76 @ARGV = map { if ($_ eq '-d' or $_ eq '--debian') { $debian = 1; (); } else { $_; } } @ARGV;
77
78 # Process action
79 unless(defined $ARGV[0] and $ARGV[0] =~ /^(cert|cron|conf)$/) {
80 print "Usage: $0 (cert|cron|conf) [-(v|-verbose)] [-(c|-config)[=/etc/acme/config]] [example.com] [...]\n";
81 exit EXIT_FAILURE;
82 } else {
83 # Save action
84 $action = $ARGV[0];
85 # Remove it from args
86 splice(@ARGV, 0, 1);
87 }
88
89 # Process config and args
90 for (my $i = 0; $i <= $#ARGV; $i++) {
91 # Match config args
92 if ($ARGV[$i] =~ /^(?:(\-c|\-\-config)(?:=(.+))?)$/) {
93 # Extract -c=$2 or --config=$2 syntax
94 if (defined($2)) {
95 $configFilename = $2;
96 splice(@ARGV, $i, 1);
97 $i--;
98 # Extract -c $ARGV[$i+1] or --config $ARGV[$i+1] writable status
99 } elsif (defined($ARGV[$i+1])) {
100 $configFilename = $ARGV[$i+1];
101 splice(@ARGV, $i, 2);
102 $i--;
103 # Check if cert or cron action
104 } elsif ($action eq 'cert' or $action eq 'cron') {
105 print "Usage: $0 $action [-(c|-config)[=/etc/acme/config]] [example.com] [...]\n";
106 exit EXIT_FAILURE;
107 }
108
109 # Check if file don't exists
110 if (defined($configFilename) and ! -f $configFilename) {
111 # Extract config directory and filename
112 my ($vol, $dir, $file) = File::Spec->splitpath($configFilename);
113
114 # Check dir
115 unless ($dir) {
116 # Set as current dir if empty
117 $dir = File::Spec->curdir();
118 }
119
120 # Verify that directory exists
121 unless (-d $dir) {
122 confess('Config directory '.$dir.' must exists: '.$!);
123 }
124
125 # Check that directory is writable
126 unless (-w $dir) {
127 confess('Config directory '.$dir.' must be writable: '.$!);
128 }
129 }
130 }
131 }
132
133 # Check if conf action
134 if ($action eq 'conf') {
135 # Configure json
136 my $js = JSON->new->utf8->pretty(1)->space_before(0)->filter_json_object(
137 sub {
138 # Get source hash ref
139 my ($x) = @_;
140 # Init tied hash
141 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
142 my $r = tie(my %r, 'Tie::IxHash');
143 # Ordered loop
144 map {
145 # Insert key if present
146 $r{$_} = $x->{$_} if (defined($x->{$_}));
147 #XXX: Hash keys not present in this array will be dropped
148 #XXX: Hash keys will be inserted in tied hash in this order
149 #} sort keys %{$x};
150 } (
151 # Root key order
152 'thumbprint', 'term', 'pending', 'certificates',
153 # Domain key order
154 'cert', 'key', 'account', 'mail', 'domain', 'domains', 'prod'
155 );
156 # Return the ordered hash
157 return \%r;
158 }
159 );
160
161 # Check we have specified domains
162 unless (scalar(@ARGV) > 0) {
163 print "Usage: $0 $action [-(v|-verbose)] [-(d|-debian)] [-(c|-config)[=/etc/acme/config]] example.com[=www.example.com[,ftp.example.com]] [...]\n";
164 exit EXIT_FAILURE;
165 }
166
167 # Load config
168 unless(
169 #XXX: use eval to workaround a fatal in decode_json
170 eval {
171 # Check file
172 (-f $configFilename) and
173 # Read it
174 ($content = read_file($configFilename)) and
175 # Decode it
176 ($config = $js->decode($content))
177 }
178 ) {
179 # Warn with verbose
180 carp('Config file '.$configFilename.' not readable or invalid: '.$!) if ($verbose);
181
182 # Create a default config
183 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
184 tie(%{$config}, 'Tie::IxHash', 'thumbprint' => Acme::THUMBPRINT, 'term' => Acme::TERM, 'pending' => Acme::PENDING, 'certificates' => []);
185 } else {
186 # Fix root infos when missing
187 $config->{thumbprint} = Acme::THUMBPRINT unless(defined($config->{thumbprint}));
188 $config->{term} = Acme::TERM unless(defined($config->{term}));
189 $config->{pending} = Acme::PENDING unless(defined($config->{pending}));
190 $config->{certificates} = [] unless(defined($config->{certificates}) and ref($config->{certificates}) eq 'ARRAY');
191 }
192
193 # Iterate on each certificates entry
194 for (my $i = 0; $i <= $#{$config->{certificates}}; $i++) {
195 # Set certificate
196 my $certificate = ${$config->{certificates}}[$i];
197
198 # Drop the entry when missing domain key
199 unless (defined($certificate->{domain})) {
200 splice(@{$config->{certificates}}, $i, 1);
201 # Entry may be fixed
202 } else {
203 # Init replace
204 my $replace = undef;
205
206 # Tie replace
207 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
208 tie(%{$replace}, 'Tie::IxHash', cert => Acme::RH_CERTS.'/'.$certificate->{domain}.Acme::RH_SUFFIX, key => Acme::RH_PRIVATE.'/'.$certificate->{domain}.Acme::RH_SUFFIX, account => Acme::ACCOUNT, mail => Acme::MAIL.'@'.$certificate->{domain}, 'domain' => $certificate->{domain}, 'domains' => [], prod => 0);
209 # Use debian path
210 if ($debian) {
211 $replace->{cert} = Acme::DEB_CERTS.'/'.$certificate->{domain}.Acme::DEB_CERTS_SUFFIX;
212 $replace->{key} = Acme::DEB_PRIVATE.'/'.$certificate->{domain}.Acme::DEB_PRIVATE_SUFFIX;
213 }
214
215 # Fix cert entry
216 $replace->{cert} = $certificate->{cert} if (defined($certificate->{cert}));
217
218 # Fix key entry
219 $replace->{key} = $certificate->{key} if (defined($certificate->{key}));
220
221 # Fix account entry
222 $replace->{account} = $certificate->{account} if (defined($certificate->{account}));
223
224 # Fix mail entry
225 $replace->{mail} = $certificate->{mail} if (defined($certificate->{mail}));
226
227 # Fix domains entry
228 $replace->{domains} = $certificate->{domains} if (defined($certificate->{domains}) and ref($certificate->{domains}) eq 'ARRAY');
229
230 # Fix prod entry
231 $replace->{prod} = $certificate->{prod} if (defined($certificate->{prod}));
232
233 # Replace certificate
234 ${$config->{certificates}}[$i] = $replace;
235 }
236 }
237
238 # Check that domains are present in config
239 map {
240 # Extract domain and domains
241 my ($domain, $domains) = split(/=/, $_);
242
243 # Transform domains
244 my @domains = defined($domains) ? map { $_ ? $_ : (); } split(/,/, $domains) : ();
245
246 # Check that domain
247 map {
248 my $tld;
249
250 # Extract tld
251 unless (($tld) = $_ =~ m/\.(\w+)$/) {
252 confess('Extract '.$_.' tld failed');
253 }
254
255 # Check if tld exists
256 unless(Net::Domain::TLD::tld_exists($tld)) {
257 confess('Extracted '.$_.' tld '.$tld.' do not exists');
258 }
259
260 # Search a record
261 my $a = Net::DNS::Resolver->new->search($_, 'A', 'IN');
262
263 # Search aaaa record
264 my $aaaa = Net::DNS::Resolver->new->search($_, 'AAAA', 'IN');
265
266 # Trigger error for unresolvable domain
267 unless (
268 # Check if either has a A or AAAA record
269 scalar map {
270 ($_->type eq 'A' or $_->type eq 'AAAA') ? 1 : ();
271 }
272 # Merge both answer
273 (
274 (defined $a and defined $a->answer) ? $a->answer : (),
275 (defined $aaaa and defined $aaaa->answer) ? $aaaa->answer : ()
276 )
277 ) {
278 confess('Resolve '.$_.' to an A or AAAA record failed');
279 }
280 } ($domain, @domains);
281
282 # Insert domain when missing
283 unless (scalar map { $_->{domain} eq $domain ? 1 : (); } @{$config->{certificates}}) {
284 # Init certificate
285 my $certificate = undef;
286
287 # Tie certificate
288 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
289 tie(%{$certificate}, 'Tie::IxHash', cert => undef, key => undef, account => Acme::ACCOUNT, mail => Acme::MAIL.'@'.$domain, 'domain' => $domain, 'domains' => [], prod => 0);
290
291 # Use debian path
292 if ($debian) {
293 $certificate->{cert} = Acme::DEB_CERTS.'/'.$domain.Acme::DEB_CERTS_SUFFIX;
294 $certificate->{key} = Acme::DEB_PRIVATE.'/'.$domain.Acme::DEB_PRIVATE_SUFFIX;
295 # Use redhat path
296 } else {
297 $certificate->{cert} = Acme::RH_CERTS.'/'.$domain.Acme::RH_SUFFIX;
298 $certificate->{key} = Acme::RH_PRIVATE.'/'.$domain.Acme::RH_SUFFIX;
299 }
300
301 # Add domains
302 map {
303 # Set subdomain
304 my $subdomain = $_;
305
306 # Check if already present
307 unless (scalar map { $_ eq $subdomain ? 1 : (); } @{$certificate->{domains}}) {
308 # Add when not already present
309 ${$certificate->{domains}}[scalar @{$certificate->{domains}}] = $_;
310 }
311 } @domains;
312
313 # Append certificate
314 ${$config->{certificates}}[scalar @{$config->{certificates}}] = $certificate;
315 # Update domains when present
316 } else {
317 # Loop on all certificate
318 map {
319 # Check that we are on the right domain
320 if ($_->{domain} eq $domain) {
321 # Init certificate
322 my $certificate = $_;
323
324 # Reset domains
325 @{$certificate->{domains}} = ();
326
327 # Add domains
328 map {
329 # Set subdomain
330 my $subdomain = $_;
331
332 # Check if already present
333 unless (scalar map { $_ eq $subdomain ? 1 : (); } @{$certificate->{domains}}) {
334 # Add when not already present
335 ${$certificate->{domains}}[scalar @{$certificate->{domains}}] = $_;
336 }
337 } @domains;
338 }
339 } @{$config->{certificates}};
340 }
341 } @ARGV;
342
343 # Extract config directory and filename
344 my ($vol, $dir, $file) = File::Spec->splitpath($configFilename);
345
346 # Check dir
347 unless ($dir) {
348 # Set as current dir if empty
349 $dir = File::Spec->curdir();
350 }
351
352 # Backup old config if possible
353 if (-w $dir and -f $configFilename) {
354 my ($dt, $suffix) = undef;
355
356 # Extract datetime suffix
357 $suffix = ($dt = DateTime->from_epoch(epoch => stat($configFilename)->mtime))->ymd('').$dt->hms('');
358
359 # Rename old config
360 unless(copy($configFilename, $configFilename.'.'.$suffix)) {
361 carp('Copy '.$configFilename.' to '.$configFilename.'.'.$suffix.' failed: '.$!);
362 }
363 # Check that directory is writable
364 } elsif (! -w $dir and -f $configFilename) {
365 confess('Config directory '.$dir.' must be writable: '.$!);
366 }
367
368 # Encode config in json
369 #XXX: emulate a tab indent file by replacing 3 space indent with tab
370 ($content = $js->encode($config)) =~ s/(\G|^)\s{3}/\t/gm;
371
372 # Write to file
373 write_file($configFilename, $content);
374
375 # Exit with success
376 exit EXIT_FAILURE;
377 # Check if cert or cron action
378 } elsif ($action eq 'cert' or $action eq 'cron') {
379 # Validate config
380 unless (
381 #XXX: use eval to workaround a fatal in decode_json
382 eval {
383 # Check file
384 (-f $configFilename) and
385 # Read it
386 ($content = read_file($configFilename)) and
387 # Decode it
388 ($config = decode_json($content)) and
389 # Check certificates presence
390 defined($config->{certificates}) and
391 # Check certificates type
392 ref($config->{certificates}) eq 'ARRAY' and
393 # Check thumbprint presence
394 defined($config->{thumbprint}) and
395 # Check term presence
396 defined($config->{term}) and
397 # Check pending presence
398 defined($config->{pending}) and
399 # Check certificates array
400 ! scalar map {
401 unless(
402 defined($_->{cert}) and
403 defined($_->{key}) and
404 defined($_->{account}) and
405 defined($_->{mail}) and
406 defined($_->{domain}) and
407 defined($_->{domains}) and ref($_->{domains}) eq 'ARRAY' and
408 defined($_->{prod})
409 ) {
410 1;
411 } else {
412 ();
413 }
414 } @{$config->{certificates}}
415 }
416 ) {
417 confess('Config file '.$configFilename.' not readable or invalid: '.$!);
418 }
419 # Unknown action
420 } else {
421 #TODO: implement the new action
422 confess('Unknown '.$action.' action');
423 }
424
425 # Deal with specified domains
426 if (scalar(@ARGV) > 0) {
427 # Check that domains are present in config
428 foreach my $domain (@ARGV) {
429 my $found = undef;
430 foreach my $certificate (@{$config->{certificates}}) {
431 if ($certificate->{domain} eq $domain) {
432 push(@domains, $certificate);
433 $found = 1;
434 }
435 }
436 unless($found) {
437 print 'Domain '.$domain.' not found in config file '.$configFilename."\n";
438 exit EXIT_FAILURE;
439 }
440 }
441 # Without it
442 } else {
443 # Populate domains array with available ones
444 foreach my $certificate (@{$config->{certificates}}) {
445 push(@domains, $certificate);
446 }
447 }
448
449 # Show conf usage
450 if (scalar(@domains) < 1) {
451 print "Usage: $0 conf [-(v|-verbose)] [-(d|-debian)] [-(c|-config)[=/etc/acme/config]] example.com[=www.example.com[,ftp.example.com]] [...]\n";
452 exit EXIT_FAILURE;
453 }
454
455 # Deal with each domain
456 foreach my $domain (@domains) {
457 # Skip certificate, in cron action, issued within the last 60 days
458 if ($action eq 'cron' and -f $domain->{cert} and stat($domain->{cert})->mtime >= (time() - 60*24*3600)) {
459 carp('Domain '.$domain->{domain}.' certificate '.$domain->{cert}.' skipped') if ($verbose);
460 next;
461 }
462 # Create new object
463 my $acme = Acme->new($verbose, $domain, {thumbprint => $config->{thumbprint}, pending => $config->{pending}, term => $config->{term}});
464
465 # Prepare environement
466 $acme->prepare();
467
468 # Generate required keys
469 $acme->genKeys();
470
471 # Directory
472 $acme->directory();
473
474 # Nonce
475 $acme->nonce();
476
477 # Account
478 $acme->account();
479
480 # Order
481 $acme->order();
482
483 # Generate csr
484 $acme->genCsr();
485
486 # Issue
487 $acme->issue();
488 }
489
490 # Exit with success
491 exit EXIT_SUCCESS;
Letsencrypt perl client