]>
Raphaël G. Git Repositories - acme/blob - letscron
e315a420f8e0610a9b154fce8c198cc3f20a77e4
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.
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.
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/>.
16 # Copyright (C) 2016 - 2017 Raphaël Gertz <acmepl@rapsys.eu>
23 use filetest
'access';
26 use Carp
qw(carp confess);
28 use File
::Path
qw(make_path);
29 use File
::stat qw(stat);
31 use File
::Slurp
qw(read_file write_file);
32 use JSON
qw(decode_json);
33 use IPC
::System
::Simple
qw(capturex $EXITVAL);
34 use acme
qw(CERT_DIR CONFIG DS KEY_DIR SERVER_CRT SERVER_KEY);
37 use POSIX
qw(strftime EXIT_SUCCESS EXIT_FAILURE);
45 # Strip and enable debug
46 @ARGV = map { if ($_ eq '-d') { $debug = 1; (); } else { $_; } } @ARGV;
50 print 'Config file '.CONFIG
.' do not exists'."\n";
56 #XXX: use eval to workaround a fatal in decode_json
59 ($config = read_file
(CONFIG
)) &&
61 ($config = decode_json
($config)) &&
63 defined($config->{certificates
}) &&
65 scalar($config->{certificates
}) &&
67 defined($config->{thumbprint
}) &&
68 # Check certificates array
69 ! scalar map {unless(defined($_->{cert
}) && defined($_->{key
}) && defined($_->{mail
}) && defined($_->{domain
}) && defined($_->{domains
})) {1;} else {();}} @{$config->{certificates
}}
72 print 'Config file '.CONFIG
.' is invalid'."\n";
76 # Deal with certificates
77 foreach (@{$config->{certificates
}}) {
79 my ($mtime, $dt, $suffix) = undef;
81 # Skip certificate without 60 days
82 if (-f
$_->{cert
} && ($mtime = stat($_->{cert
})->mtime) >= (time() - 60*24*3600)) {
86 # Extract cert directory and filename
87 my (undef, $certDir) = File
::Spec-
>splitpath($_->{cert
});
89 # Check that certificate is writable
90 unless (-w
$certDir || -w
$_->{cert
}) {
91 carp
('directory '.$certDir.' or file '.$_->{cert
}.' must be writable: '.$!);
95 # Check that key directory exists
98 make_path
(KEY_DIR
, {error
=> \
my $err});
101 my ($file, $msg) = %$_;
102 carp
($file eq '' ? '' : $file.': ').$msg if ($debug);
104 confess
'make_path failed';
108 # Unlink if is a symlink
109 if (-l KEY_DIR
.DS
.SERVER_KEY
) {
110 unless(unlink(KEY_DIR
.DS
.SERVER_KEY
)) {
111 carp
('unlink '.KEY_DIR
.DS
.SERVER_KEY
.' failed: '.$!);
117 unless(symlink($_->{key
}, KEY_DIR
.DS
.SERVER_KEY
)) {
118 carp
('symlink '.$_->{key
}.' to '.KEY_DIR
.DS
.SERVER_KEY
.' failed: '.$!);
123 my @args = @{$_->{domains
}};
125 # Prepend mail and domain to other args
126 unshift(@args, $_->{mail
}, $_->{domain
});
129 if (defined $_->{prod
} && $_->{prod
}) {
130 unshift(@args, '-p');
135 unshift(@args, '-d');
138 # Run letscert with args
139 my @out = capturex
([0..1], 'letscert', @args);
143 print join("\n", @out) if ($debug);
144 carp
('letscert '.join(', ', @args).' failed: '.$!);
150 unless($content = read_file
(CERT_DIR
.DS
.SERVER_CRT
)) {
151 carp
('read_file '.CERT_DIR
.DS
.SERVER_CRT
.' failed: '.$!);
155 # Handle old certificate
156 if (-w
$certDir && -f
$_->{cert
}) {
157 # Extract datetime suffix
158 $suffix = ($dt = DateTime-
>from_epoch(epoch
=> $mtime))->ymd('').$dt->hms('');
160 # Rename old certificate
161 unless(rename($_->{cert
}, $_->{cert
}.'.'.$suffix)) {
162 carp
('rename '.$_->{cert
}.' to '.$_->{cert
}.'.'.$suffix.' failed: '.$!);
168 unless(write_file
($_->{cert
}, $content)) {
169 carp
('write_file '.$_->{cert
}.' failed: '.$!);