]>
Raphaƫl G. Git Repositories - acme/blob - letscron
  13 use File
::stat qw(stat); 
  15 use File
::Slurp 
qw(read_file write_file); 
  16 use JSON 
qw(decode_json); 
  17 use IPC
::System
::Simple 
qw(capturex $EXITVAL); 
  18 use acme 
qw(CERT_DIR CONFIG DS KEY_DIR SERVER_CRT SERVER_KEY); 
  21 use POSIX 
qw(strftime EXIT_SUCCESS EXIT_FAILURE); 
  29 # Strip and enable debug 
  30 @ARGV = map { if ($_ eq '-d') { $debug = 1; (); } else { $_; } } @ARGV; 
  34         print 'Config file '.CONFIG
.' do not exists'."\n"; 
  40         #XXX: use eval to workaround a fatal in decode_json 
  43                 ($config = read_file
(CONFIG
)) && 
  45                 ($config = decode_json
($config)) && 
  47                 defined($config->{certificates
}) && 
  49                 scalar($config->{certificates
}) && 
  51                 defined($config->{thumbprint
}) && 
  52                 # Check certificates array 
  53                 ! scalar map {unless(defined($_->{cert
}) && defined($_->{key
}) && defined($_->{mail
}) && defined($_->{domain
}) && defined($_->{domains
})) {1;} else {();}} @{$config->{certificates
}} 
  56         print 'Config file '.CONFIG
.' is invalid'."\n"; 
  60 # Deal with certificates 
  61 foreach (@{$config->{certificates
}}) { 
  63         my ($mtime, $dt, $suffix) = undef; 
  65         # Skip certificate without 60 days 
  66         if (-f 
$_->{cert
} && ($mtime = stat($_->{cert
})->mtime) >= (time() - 60*24*3600)) { 
  70         # Extract cert directory and filename 
  71         my (undef, $certDir) = File
::Spec-
>splitpath($_->{cert
}); 
  73         # Check that certificate is writable 
  74         unless (-w 
$certDir || -w 
$_->{cert
}) { 
  75                 carp
('directory '.$certDir.' or file '.$_->{cert
}.' must be writable: '.$!); 
  79         # Unlink if is a symlink 
  80         if (-l KEY_DIR
.DS
.SERVER_KEY
) { 
  81                 unless(unlink(KEY_DIR
.DS
.SERVER_KEY
)) { 
  82                         carp
('unlink '.KEY_DIR
.DS
.SERVER_KEY
.' failed: '.$!); 
  88         unless(symlink($_->{key
}, KEY_DIR
.DS
.SERVER_KEY
)) { 
  89                 carp
('symlink '.$_->{key
}.' to '.KEY_DIR
.DS
.SERVER_KEY
.' failed: '.$!); 
  94         my @args = @{$_->{domains
}}; 
  96         # Prepend mail and domain to other args 
  97         unshift(@args, $_->{mail
}, $_->{domain
}); 
 100         if (defined $_->{prod
} && $_->{prod
}) { 
 101                 unshift(@args, '-p'); 
 106                 unshift(@args, '-d'); 
 109         # Run letscert with args 
 110         my @out = capturex
([0..1], './letscert', @args); 
 114                 print join("\n", @out) if ($debug); 
 115                 carp
('letscert '.join(', ', @args).' failed: '.$!); 
 121         unless($content = read_file
(CERT_DIR
.DS
.SERVER_CRT
)) { 
 122                 carp
('read_file '.CERT_DIR
.DS
.SERVER_CRT
.' failed: '.$!); 
 126         # Handle old certificate 
 127         if (-w 
$certDir && -f 
$_->{cert
}) { 
 128                 # Extract datetime suffix 
 129                 $suffix = ($dt = DateTime-
>from_epoch(epoch 
=> $mtime))->ymd('').$dt->hms(''); 
 131                 # Rename old certificate 
 132                 unless(rename($_->{cert
}, $_->{cert
}.'.'.$suffix)) { 
 133                         carp
('rename '.$_->{cert
}.' to '.$_->{cert
}.'.'.$suffix.' failed: '.$!); 
 139         unless(write_file
($_->{cert
}, $content)) { 
 140                 carp
('write_file '.$_->{cert
}.' failed: '.$!);