X-Git-Url: https://git.rapsys.eu/acme/blobdiff_plain/4ae894f1b340be86ea138f9dbaa9a80e901312dd..a2a0d9bf4597fbd23c69d4e2288b2efd639ceda3:/acme.pm?ds=inline
diff --git a/acme.pm b/acme.pm
index eabe155..ab1a55b 100644
--- a/acme.pm
+++ b/acme.pm
@@ -1,3 +1,20 @@
+# This file is part of Acmepl
+#
+# Acmepl is is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+#
+# Copyright (C) 2016 - 2017 Raphaël Gertz
+
# acme package
package acme;
@@ -8,11 +25,11 @@ use warnings;
# Symbol export
use Exporter;
our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(DS CERT_DIR KEY_DIR REQUEST_CSR ACCOUNT_KEY SERVER_KEY SERVER_CRT CONFIG);
# Load dependancies
use Carp qw(carp confess);
use Date::Parse qw(str2time);
-use DateTime;
use Digest::SHA qw(sha256_base64);
use Email::Valid;
use File::Path qw(make_path);
@@ -23,11 +40,8 @@ use JSON qw(encode_json decode_json);
use LWP;
use MIME::Base64 qw(encode_base64url encode_base64);
use Net::Domain::TLD;
-use Tie::IxHash;
use POSIX qw(EXIT_FAILURE);
-
-# Debug
-use Data::Dumper;
+use Tie::IxHash;
# Documentation links
#XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
@@ -73,15 +87,15 @@ use constant {
ACME_TERMS => 'https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf',
# Version
- VERSION => 'v0.2'
+ VERSION => 'v0.4',
+
+ # Config
+ CONFIG => '/etc/acmepl/config'
};
# User agent object
our $ua;
-# Debug
-our $_debug = 0;
-
# Strerr backup
our $_stderr;
@@ -110,7 +124,7 @@ tie(%{$jwk{jwk}{jwk}}, 'Tie::IxHash', e => undef, kty => uc(KEY_TYPE), n => unde
# Constructor
sub new {
# Extract params
- my ($class, $mail, @domains) = @_;
+ my ($class, $mail, $debug, $prod, @domains) = @_;
# Create self hash
my $self = {};
@@ -118,13 +132,19 @@ sub new {
# Link self to package
bless($self, $class);
+ # Save debug
+ $self->{debug} = $debug;
+
+ # Save prod
+ $self->{prod} = $prod;
+
# Add extra check to mail validity
#XXX: mxcheck fail if there is only a A record on the domain
my $ev = Email::Valid->new(-fqdn => 1, -tldcheck => 1, -mxcheck => 1);
# Show error if check fail
if (! defined $ev->address($mail)) {
- map { carp 'failed check: '.$_ if ($_debug) } $ev->details();
+ map { carp 'failed check: '.$_ if ($self->{debug}) } $ev->details();
confess 'Email::Valid->address failed';
}
@@ -168,14 +188,14 @@ sub new {
# Prepare environement
sub prepare {
- my ($self, $prod) = @_;
+ my ($self) = @_;
# Create all paths
- make_path(CERT_DIR, KEY_DIR, PENDING_DIR.'/'.$self->{mail}.'.'.($prod ? 'prod' : 'staging'), {error => \my $err});
+ make_path(CERT_DIR, KEY_DIR, PENDING_DIR.'/'.$self->{mail}.'.'.($self->{prod} ? 'prod' : 'staging'), {error => \my $err});
if (@$err) {
map {
my ($file, $msg) = %$_;
- carp ($file eq '' ? '' : $file.': ').$msg if ($_debug);
+ carp ($file eq '' ? '' : $file.': ').$msg if ($self->{debug});
} @$err;
confess 'make_path failed';
}
@@ -272,13 +292,13 @@ sub genCsr {
# Directory call
sub directory {
- my ($self, $prod) = @_;
+ my ($self) = @_;
# Set time
my $time = time;
# Set directory
- my $dir = $prod ? ACME_PROD_DIR : ACME_DIR;
+ my $dir = $self->{prod} ? ACME_PROD_DIR : ACME_DIR;
# Create a request
my $req = HTTP::Request->new(GET => $dir.'?'.$time);
@@ -359,11 +379,11 @@ sub _dnsCheck {
# Check if we get dns answer
unless(my $rep = $res->search($domain, 'TXT')) {
- carp 'TXT record search for '.$domain.' failed' if ($_debug);
+ carp 'TXT record search for '.$domain.' failed' if ($self->{debug});
return;
} else {
unless (scalar map { $_->type eq 'TXT' && $_->txtdata =~ /^$signature$/ ? 1 : (); } $rep->answer) {
- carp 'TXT record recursive search for '.$domain.' failed' if ($_debug);
+ carp 'TXT record recursive search for '.$domain.' failed' if ($self->{debug});
return;
}
}
@@ -378,18 +398,37 @@ sub _httpCheck {
# Create a request
my $req = HTTP::Request->new(GET => 'http://'.$domain.'/.well-known/acme-challenge/'.$token);
+ # Load config if available
+ my $config = undef;
+ if (
+ #XXX: use eval to workaround a fatal in decode_json
+ defined eval {
+ # Check that file exists
+ -f CONFIG &&
+ # Read it
+ ($config = read_file(CONFIG)) &&
+ # Decode it
+ ($config = decode_json($config)) &&
+ # Check defined
+ $config->{thumbprint}
+ }
+ ) {
+ # Try to write thumbprint
+ write_file($config->{thumbprint}, $self->{account}{thumbprint});
+ }
+
# Get request
my $res = $ua->request($req);
# Handle error
unless ($res->is_success) {
- carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($_debug);
+ carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($self->{debug});
return;
}
# Handle invalid content
unless($res->content =~ /^$token.$self->{account}{thumbprint}\s*$/) {
- carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' content match failed: /^'.$token.'.'.$self->{account}{thumbprint}.'\s*$/ !~ '.$res->content if ($_debug);
+ carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' content match failed: /^'.$token.'.'.$self->{account}{thumbprint}.'\s*$/ !~ '.$res->content if ($self->{debug});
return;
}
@@ -429,7 +468,7 @@ sub register {
# Authorize domains
sub authorize {
- my ($self, $prod) = @_;
+ my ($self) = @_;
# Create challenges hash
%{$self->{challenges}} = ();
@@ -443,7 +482,7 @@ sub authorize {
my $content = undef;
# Init file
- my $file = PENDING_DIR.'/'.$self->{mail}.'.'.($prod ? 'prod' : 'staging').'/'.$_;
+ my $file = PENDING_DIR.'/'.$self->{mail}.'.'.($self->{prod} ? 'prod' : 'staging').'/'.$_;
# Load auth request content or post a new one
#TODO: add more check on cache file ???
@@ -455,10 +494,9 @@ sub authorize {
# Read it
($content = read_file($file)) &&
# Decode it
- ($content = decode_json($content)) &&
- # Check expiration
- (DateTime->from_epoch(epoch => str2time($content->{expires})) >= DateTime->now()->add(hours => 1))
- }
+ ($content = decode_json($content))
+ # Check expiration
+ } || (str2time($content->{expires}) <= time()+3600)
) {
# Post new-authz request
my $res = $self->_post($self->{'new-authz'}, {resource => 'new-authz', identifier => {type => 'dns', value => $_}, existing => 'accept'});
@@ -505,8 +543,8 @@ sub authorize {
} elsif ($challenge->{status} eq 'pending') {
# Handle check
if (
- ($challenge->{type} =~ /^http-[0-9]+$/ and $self->_httpCheck($_, $challenge->{token})) or
- ($challenge->{type} =~ /^dns-[0-9]+$/ and $self->_dnsCheck($_, $challenge->{token}))
+ ($challenge->{type} =~ /^http-01$/ and $self->_httpCheck($_, $challenge->{token})) or
+ ($challenge->{type} =~ /^dns-01$/ and $self->_dnsCheck($_, $challenge->{token}))
) {
# Post challenge request
my $res = $self->_post($challenge->{uri}, {resource => 'challenge', keyAuthorization => $challenge->{token}.'.'.$self->{account}{thumbprint}});
@@ -531,11 +569,18 @@ sub authorize {
poll => $content->{uri}
});
}
- # Print http help
- } elsif ($challenge->{type} =~ /^http-[0-9]+$/) {
+ }
+ }
+ }
+ # Check if check is challenge still in pending and no polls
+ if ($self->{challenges}{$_}{status} eq 'pending' && scalar @{$self->{challenges}{$_}{polls}} == 0) {
+ # Loop on all remaining challenges
+ foreach my $challenge (@{$content->{challenges}}) {
+ # Display help for http-01 check
+ if ($challenge->{type} eq 'http-01') {
print STDERR 'Create URI http://'.$_.'/.well-known/acme-challenge/'.$challenge->{token}.' with content '.$challenge->{token}.'.'.$self->{account}{thumbprint}."\n";
- # Print dns help
- } elsif ($challenge->{type} =~ /^dns-[0-9]+$/) {
+ # Display help for dns-01 check
+ } elsif ($challenge->{type} eq 'dns-01') {
print STDERR 'Create TXT record _acme-challenge.'.$_.'. with value '.(((sha256_base64($challenge->{token}.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r)."\n";
}
}
@@ -565,7 +610,7 @@ sub authorize {
# Handle error
unless ($res->is_success) {
- carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($_debug);
+ carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($self->{debug});
}
# Extract content
@@ -579,6 +624,25 @@ sub authorize {
} map { $self->{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{challenges}};
}
+ # Load config if available
+ my $config = undef;
+ if (
+ #XXX: use eval to workaround a fatal in decode_json
+ defined eval {
+ # Check that file exists
+ -f CONFIG &&
+ # Read it
+ ($config = read_file(CONFIG)) &&
+ # Decode it
+ ($config = decode_json($config)) &&
+ # Check defined
+ $config->{thumbprint}
+ }
+ ) {
+ # Try to write thumbprint
+ write_file($config->{thumbprint}, '');
+ }
+
# Stop here with remaining chanllenge
if (scalar map { ! defined $_->{status} or $_->{status} ne 'valid' ? 1 : (); } values %{$self->{challenges}}) {
# Deactivate all activated domains
@@ -588,14 +652,14 @@ sub authorize {
# my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'authz', status => 'deactivated'});
# # Handle error
# unless ($res->is_success) {
- # print Dumper($res);
# confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line;
# }
#} map { $self->{challenges}{$_}{status} eq 'valid' ? $_ : () } keys %{$self->{challenges}};
# Stop here as a domain of csr list failed authorization
- if ($_debug) {
- confess 'Fix the challenges for domains: '.join(', ', map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}});
+ if ($self->{debug}) {
+ my @domains = map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}};
+ confess 'Fix the challenge'.(scalar @domains > 1?'s':'').' for domain'.(scalar @domains > 1?'s':'').': '.join(', ', @domains);
} else {
exit EXIT_FAILURE;
}
@@ -620,7 +684,6 @@ sub issue {
# Handle error
unless ($res->is_success) {
- print Dumper($res);
confess 'POST '.$self->{'new-cert'}.' failed: '.$res->status_line;
}
@@ -638,7 +701,7 @@ sub issue {
# Handle error
unless ($res->is_success) {
- carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($_debug);
+ carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($self->{debug});
}
# Append content
@@ -648,7 +711,7 @@ sub issue {
close($fh) or die $!;
# Print success
- carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($_debug);
+ carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($self->{debug});
}
1;