X-Git-Url: https://git.rapsys.eu/acme/blobdiff_plain/d187fb9a34393cc3591fb34c9db532ba7433f688..834ba74c4170b5fe54d148ba9f0a197c08460f5a:/acme.pm diff --git a/acme.pm b/acme.pm index f657c23..db1c6d4 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,60 +25,77 @@ 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 Digest::SHA qw(sha256_base64); use Email::Valid; use File::Path qw(make_path); +use File::Slurp qw(read_file write_file); use File::Temp; # qw( :seekable ); use IPC::System::Simple qw(capturex); -use JSON qw(encode_json decode_json); +use JSON qw(from_json to_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/ -#XXX: see http://www.rfc-editor.org/rfc/rfc7517.txt -#XXX: see ietf draft at https://ietf-wg-acme.github.io/acme/ +#XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/) +#XXX: see jwk rfc http://www.rfc-editor.org/rfc/rfc7517.txt #XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js # Set constants use constant { + # Directory separator DS => '/', + # Directory for certificates CERT_DIR => 'cert', + + # Directory for keys KEY_DIR => 'key', + # Directory for pending cache + PENDING_DIR => 'pending', + + # Request certificate file name + REQUEST_CSR => 'request.der', + + # Account key file name ACCOUNT_KEY => 'account.pem', - ACCOUNT_PUB => 'account.pub', + + # Server private key SERVER_KEY => 'server.pem', - REQUEST_CSR => 'request.der', + + # Server public certificate SERVER_CRT => 'server.crt', + # rsa KEY_TYPE => 'rsa', + # 2048|4096 KEY_SIZE => 4096, + # Acme infos + ACME_CERT => 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem', ACME_DIR => 'https://acme-staging.api.letsencrypt.org/directory', - #ACME_DIR => 'https://acme-v01.api.letsencrypt.org/directory', - ACME_TERMS => 'https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf', + ACME_PROD_DIR => 'https://acme-v01.api.letsencrypt.org/directory', + ACME_TERMS => 'https://letsencrypt.org/documents/LE-SA-v1.1.1-August-1-2016.pdf', - VERSION => 'v0.1' + # Version + VERSION => 'v0.6', + + # Config + CONFIG => '/etc/acmepl/config' }; # User agent object our $ua; -# Debug -our $_debug = 0; - # Strerr backup our $_stderr; @@ -90,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 = {}; @@ -98,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'; } @@ -148,12 +188,14 @@ sub new { # Prepare environement sub prepare { + my ($self) = @_; + # Create all paths - make_path(CERT_DIR, KEY_DIR, {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'; } @@ -221,7 +263,7 @@ sub genKeys { # Store thumbprint #XXX: convert base64 to base64 url - $self->{account}{thumbprint} = (sha256_base64(encode_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r; + $self->{account}{thumbprint} = (sha256_base64(to_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r; } # Generate certificate request @@ -255,22 +297,25 @@ sub directory { # Set time my $time = time; + # Set directory + my $dir = $self->{prod} ? ACME_PROD_DIR : ACME_DIR; + # Create a request - my $req = HTTP::Request->new(GET => ACME_DIR.'?'.$time); + my $req = HTTP::Request->new(GET => $dir.'?'.$time); # Get request my $res = $ua->request($req); # Handle error unless ($res->is_success) { - confess 'GET '.ACME_DIR.'?'.$time.' failed: '.$res->status_line; + confess 'GET '.$dir.'?'.$time.' failed: '.$res->status_line; } # Save nonce $self->{nonce} = $res->headers->{'replay-nonce'}; # Merge uris in self content - %$self = (%$self, %{decode_json($res->content)}); + %$self = (%$self, %{from_json($res->content)}); } # Post request @@ -278,10 +323,10 @@ sub _post { my ($self, $uri, $payload) = @_; # Protected field - my $protected = encode_base64url(encode_json({nonce => $self->{nonce}})); + my $protected = encode_base64url(to_json({nonce => $self->{nonce}})); # Payload field - $payload = encode_base64url(encode_json($payload)); + $payload = encode_base64url(to_json($payload)); # Sign temp file my $stf = File::Temp->new(); @@ -299,7 +344,7 @@ sub _post { my $req = HTTP::Request->new(POST => $uri); # Set new-reg request content - $req->content(encode_json({ + $req->content(to_json({ header => $self->{account}{jwk}, protected => $protected, payload => $payload, @@ -318,25 +363,72 @@ sub _post { return $res; } +# Resolve dns and check content +#XXX: see https://community.centminmod.com/threads/looks-like-letsencrypt-dns-01-is-ready.5845/#12 for example +sub _dnsCheck { + my ($self, $domain, $token) = @_; + + # Generate signature from content + my $signature = ((sha256_base64($token.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r; + + # Fix domain + $domain = '_acme-challenge.'.$domain.'.'; + + # Create resolver + my $res = new Net::DNS::Resolver(); + + # Check if we get dns answer + unless(my $rep = $res->search($domain, 'TXT')) { + 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 ($self->{debug}); + return; + } + } + + return 1; +} + # Get uri and check content sub _httpCheck { - my ($self, $uri, $content) = @_; + my ($self, $domain, $token) = @_; # Create a request - my $req = HTTP::Request->new(GET => $uri); + 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 from_json + defined eval { + # Check that file exists + -f CONFIG && + # Read it + ($config = read_file(CONFIG)) && + # Decode it + ($config = from_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 '.$uri.' 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 =~ /^$content\s*$/) { - carp 'GET '.$uri.' content match failed: /^'.$content.'\s*$/ !~ '.$res->content if ($_debug); + 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 ($self->{debug}); return; } @@ -375,7 +467,6 @@ sub register { } # Authorize domains -#TODO: implement combinations check one day sub authorize { my ($self) = @_; @@ -385,121 +476,173 @@ sub authorize { # Pending list my @pending = (); - # Create request for each domain + # Create or load auth request for each domain map { - # Post new-authz request - my $res = $self->_post($self->{'new-authz'}, {resource => 'new-authz', identifier => {type => 'dns', value => $_}, existing => 'accept'}); + # Init content + my $content = undef; + + # Init file + 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 ??? + if ( + #XXX: use eval to workaround a fatal in from_json + ! defined eval { + # Check that file exists + -f $file && + # Read it + ($content = read_file($file)) && + # Decode it + ($content = from_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'}); - # Handle error - unless ($res->is_success) { - confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line; - } + # Handle error + unless ($res->is_success) { + confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line; + } - # Decode content - my $content = decode_json($res->content); + # Decode content + $content = from_json($res->content); - # Check domain - unless (defined $content->{identifier}{value} && $content->{identifier}{value} eq $_) { - confess 'domain matching '.$content->{identifier}{value}.' for '.$_.' failed: '.$res->status_line; - } + # Check domain + unless (defined $content->{identifier}{value} && $content->{identifier}{value} eq $_) { + confess 'domain matching '.$content->{identifier}{value}.' for '.$_.' failed: '.$res->status_line; + } + + # Check status + unless ($content->{status} eq 'valid' or $content->{status} eq 'pending') { + confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line; + } - # Check status - unless ($content->{status} eq 'valid' or $content->{status} eq 'pending') { - confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line; + # Write to file + write_file($file, to_json($content)); } # Add challenge %{$self->{challenges}{$_}} = ( - status => undef, - expires => undef, - #dns_uri => undef, - #dns_token => undef, - http_uri => undef, - http_token => undef, - http_challenge => undef + status => $content->{status}, + expires => $content->{expires}, + polls => [] ); - # Save status - $self->{challenges}{$_}{status} = $content->{status}; - # Save pending data if ($content->{status} eq 'pending') { - # Exctract validation data + # Extract validation data foreach my $challenge (@{$content->{challenges}}) { - if ($challenge->{type} eq 'http-01') { - $self->{challenges}{$_}{http_uri} = $challenge->{uri}; - $self->{challenges}{$_}{http_token} = $challenge->{token}; - #} elsif ($challenge->{type} eq 'dns-01') { - # $self->{challenges}{$_}{dns_uri} = $challenge->{uri}; - # $self->{challenges}{$_}{dns_token} = $challenge->{token}; + # One test already validated this auth request + if ($self->{challenges}{$_}{status} eq 'valid') { + next; + } elsif ($challenge->{status} eq 'valid') { + $self->{challenges}{$_}{status} = $challenge->{status}; + next; + } elsif ($challenge->{status} eq 'pending') { + # Handle check + if ( + ($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}}); + + # Handle error + unless ($res->is_success) { + confess 'POST '.$challenge->{uri}.' failed: '.$res->status_line; + } + + # Extract content + my $content = from_json($res->content); + + # Save if valid + if ($content->{status} eq 'valid') { + $self->{challenges}{$_}{status} = $content->{status}; + # Check is still polling + } elsif ($content->{status} eq 'pending') { + # Add to poll list for later use + push(@{$self->{challenges}{$_}{polls}}, { + type => (split(/-/, $challenge->{type}))[0], + status => $content->{status}, + poll => $content->{uri} + }); + } + } } } - - # Check dns challenge - #XXX: disabled for now - #$self->_dnsCheck('_acme-challenge.'.$_.'.', $self->{challenges}{$_}{http_token}.'.'.$self->{account}{thumbprint}); - - # Check http challenge - if ($self->_httpCheck( - # Well known uri - 'http://'.$_.'/.well-known/acme-challenge/'.$self->{challenges}{$_}{http_token}, - # token.thumbprint - $self->{challenges}{$_}{http_token}.'.'.$self->{account}{thumbprint} - )) { - # Post challenge request - my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'challenge', keyAuthorization => $self->{challenges}{$_}{http_token}.'.'.$self->{account}{thumbprint}}); - - # Handle error - unless ($res->is_success) { - confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line; - } - - # Extract content - my $content = decode_json($res->content); - - # Save status - $self->{challenges}{$_}{status} = $content->{status}; - - # Add challenge uri to poll - #XXX: in case it is still pending - if ($content->{status} eq 'pending') { - $self->{challenges}{$_}{http_challenge} = $content->{uri}; + # 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"; + # 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"; + } } - } else { - # Set failed status - $self->{challenges}{$_}{status} = 'invalid'; - - # Display challenge to fix - print STDERR 'Makes http://'.$_.'/.well-known/acme-challenge/'.$self->{challenges}{$_}{http_token}.' return '.$self->{challenges}{$_}{http_token}.'.'.$self->{account}{thumbprint}."\n"; } } } @{$self->{domains}}; + # Init max run + my $remaining = 10; + # Poll pending - while (scalar map { $_->{status} eq 'pending' ? 1 : (); } values %{$self->{challenges}}) { + while (--$remaining >= 0 and scalar map { $_->{status} eq 'valid' ? 1 : (); } values %{$self->{challenges}}) { # Sleep sleep(1); # Poll remaining pending map { - # Create a request - my $req = HTTP::Request->new(GET => $self->{challenges}{$_}{http_challenge}); + # Init domain + my $domain = $_; - # Get request - my $res = $ua->request($req); + # Poll remaining polls + map { + # Create a request + my $req = HTTP::Request->new(GET => $_->{poll}); - # Handle error - unless ($res->is_success) { - carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($_debug); - } + # Get request + my $res = $ua->request($req); + + # Handle error + unless ($res->is_success) { + carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($self->{debug}); + } - # Extract content - my $content = decode_json($res->content); + # Extract content + my $content = from_json($res->content); - # Save status - $self->{challenges}{$_}{status} = $content->{status}; + # Save status + if ($content->{status} ne 'pending') { + $self->{challenges}{$domain}{status} = $content->{status}; + } + } @{$self->{challenges}{$_}{polls}}; } 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 from_json + defined eval { + # Check that file exists + -f CONFIG && + # Read it + ($config = read_file(CONFIG)) && + # Decode it + ($config = from_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 @@ -509,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; } @@ -541,58 +684,34 @@ sub issue { # Handle error unless ($res->is_success) { - print Dumper($res); confess 'POST '.$self->{'new-cert'}.' failed: '.$res->status_line; } # Open crt file open($fh, '>', CERT_DIR.DS.SERVER_CRT) or die $!; + # Convert to pem print $fh '-----BEGIN CERTIFICATE-----'."\n".encode_base64($res->content).'-----END CERTIFICATE-----'."\n"; - #TODO: merge https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem here - # Close file - close($fh) or die $!; - # Print success - carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($_debug); -} - -# Resolve dns and check content -#XXX: this can't work without a plugin in dns to generate signature from token.thumbprint and store it in zone -#XXX: each identifier authorisation generate a new token, it's not possible to do a yescard answer -#XXX: the digest can be bigger than 255 TXT record limit and well known dns server will randomize TXT record order -# -#XXX: conclusion disabled for now -sub _dnsCheck { - my ($self, $domain, $content) = @_; - - # Sign temp file - my $stf = File::Temp->new(); + # Create a request + my $req = HTTP::Request->new(GET => ACME_CERT); - # Append protect.payload to stf - print $stf $content; + # Get request + $res = $ua->request($req); - # Close stf - close($stf); + # Handle error + unless ($res->is_success) { + carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($self->{debug}); + } - # Generate digest of stf - my $signature = encode_base64url(join('', capturex('openssl', ('dgst', '-sha256', '-binary', '-sign', KEY_DIR.DS.ACCOUNT_KEY, $stf->filename)))); + # Append content + print $fh $res->content; - # Create resolver - my $res = new Net::DNS::Resolver(); - - # Check if we get dns answer - unless(my $rep = $res->search($domain, 'TXT')) { - carp 'search TXT record for '.$domain.' failed' if ($_debug); - return; - } else { - unless (scalar map { $_->type eq 'TXT' && $_->txtdata =~ /^$signature$/ ? 1 : (); } $rep->answer) { - carp 'search recursively TXT record for '.$_.' failed' if ($_debug); - return; - } - } + # Close file + close($fh) or die $!; - return 1; + # Print success + carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($self->{debug}); } 1;