]>
Raphaël G. Git Repositories - acme/blob - letscron
   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 not readable or 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: '.$!);