]>
Raphaël G. Git Repositories - acme/blob - letscron
2a68110a0772a63152a9d9548cd0c4412e773b78
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';
28 use File
::stat qw(stat);
30 use File
::Slurp
qw(read_file write_file);
31 use JSON
qw(decode_json);
32 use IPC
::System
::Simple
qw(capturex $EXITVAL);
33 use acme
qw(CERT_DIR CONFIG DS KEY_DIR SERVER_CRT SERVER_KEY);
36 use POSIX
qw(strftime EXIT_SUCCESS EXIT_FAILURE);
44 # Strip and enable debug
45 @ARGV = map { if ($_ eq '-d') { $debug = 1; (); } else { $_; } } @ARGV;
49 print 'Config file '.CONFIG
.' do not exists'."\n";
55 #XXX: use eval to workaround a fatal in decode_json
58 ($config = read_file
(CONFIG
)) &&
60 ($config = decode_json
($config)) &&
62 defined($config->{certificates
}) &&
64 scalar($config->{certificates
}) &&
66 defined($config->{thumbprint
}) &&
67 # Check certificates array
68 ! scalar map {unless(defined($_->{cert
}) && defined($_->{key
}) && defined($_->{mail
}) && defined($_->{domain
}) && defined($_->{domains
})) {1;} else {();}} @{$config->{certificates
}}
71 print 'Config file '.CONFIG
.' is invalid'."\n";
75 # Deal with certificates
76 foreach (@{$config->{certificates
}}) {
78 my ($mtime, $dt, $suffix) = undef;
80 # Skip certificate without 60 days
81 if (-f
$_->{cert
} && ($mtime = stat($_->{cert
})->mtime) >= (time() - 60*24*3600)) {
85 # Extract cert directory and filename
86 my (undef, $certDir) = File
::Spec-
>splitpath($_->{cert
});
88 # Check that certificate is writable
89 unless (-w
$certDir || -w
$_->{cert
}) {
90 carp
('directory '.$certDir.' or file '.$_->{cert
}.' must be writable: '.$!);
94 # Unlink if is a symlink
95 if (-l KEY_DIR
.DS
.SERVER_KEY
) {
96 unless(unlink(KEY_DIR
.DS
.SERVER_KEY
)) {
97 carp
('unlink '.KEY_DIR
.DS
.SERVER_KEY
.' failed: '.$!);
103 unless(symlink($_->{key
}, KEY_DIR
.DS
.SERVER_KEY
)) {
104 carp
('symlink '.$_->{key
}.' to '.KEY_DIR
.DS
.SERVER_KEY
.' failed: '.$!);
109 my @args = @{$_->{domains
}};
111 # Prepend mail and domain to other args
112 unshift(@args, $_->{mail
}, $_->{domain
});
115 if (defined $_->{prod
} && $_->{prod
}) {
116 unshift(@args, '-p');
121 unshift(@args, '-d');
124 # Run letscert with args
125 my @out = capturex
([0..1], 'letscert', @args);
129 print join("\n", @out) if ($debug);
130 carp
('letscert '.join(', ', @args).' failed: '.$!);
136 unless($content = read_file
(CERT_DIR
.DS
.SERVER_CRT
)) {
137 carp
('read_file '.CERT_DIR
.DS
.SERVER_CRT
.' failed: '.$!);
141 # Handle old certificate
142 if (-w
$certDir && -f
$_->{cert
}) {
143 # Extract datetime suffix
144 $suffix = ($dt = DateTime-
>from_epoch(epoch
=> $mtime))->ymd('').$dt->hms('');
146 # Rename old certificate
147 unless(rename($_->{cert
}, $_->{cert
}.'.'.$suffix)) {
148 carp
('rename '.$_->{cert
}.' to '.$_->{cert
}.'.'.$suffix.' failed: '.$!);
154 unless(write_file
($_->{cert
}, $content)) {
155 carp
('write_file '.$_->{cert
}.' failed: '.$!);