X-Git-Url: https://git.rapsys.eu/acme/blobdiff_plain/e39489eceb9dada2e15861d357ce2966883bc243..72dc9007a422d5199847dbabba586d375f1ef39a:/Acme.pm?ds=sidebyside diff --git a/Acme.pm b/Acme.pm index 1f5675f..161fbc9 100644 --- a/Acme.pm +++ b/Acme.pm @@ -22,27 +22,38 @@ package Acme; use strict; use warnings; +# Add acl support to file tests +use filetest qw(access); + # 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); +our @EXPORT_OK = qw(ACCOUNT CONFIG MAIL PENDING TERM THUMBPRINT VERSION); # 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::Copy qw(copy); use File::Path qw(make_path); use File::Slurp qw(read_file write_file); +use File::Spec qw(splitpath); +use File::stat qw(stat); use File::Temp; # qw( :seekable ); use IPC::System::Simple qw(capturex); use JSON qw(from_json to_json); use LWP; use MIME::Base64 qw(encode_base64url encode_base64); -use Net::Domain::TLD; +use Net::DNS qw(); +use Net::Domain::TLD qw(tld_exists); use POSIX qw(EXIT_FAILURE); use Tie::IxHash; +# Load debug +#use Data::Dumper; + # Documentation links #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 @@ -50,47 +61,46 @@ use Tie::IxHash; # 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', - - # Server private key - SERVER_KEY => 'server.pem', - - # Server public certificate - SERVER_CRT => 'server.crt', - - # rsa + # Config infos + ACCOUNT => '/etc/acme/account.pem', + CONFIG => '/etc/acme/config', + PENDING => '/tmp/acme', + THUMBPRINT => '/etc/acme/thumbprint', + TERM => 'https://letsencrypt.org/documents/LE-SA-v1.2-November-15-2017.pdf', + MAIL => 'webmaster', + + # Certificate info + CSR_SUFFIX => '.der', + + # Redhat infos + RH_CERTS => '/etc/pki/tls/certs', + RH_PRIVATE => '/etc/pki/tls/private', + RH_SUFFIX => '.pem', + + # Debian infos + DEB_CERTS => '/etc/ssl/certs', + DEB_PRIVATE => '/etc/ssl/private', + DEB_CERTS_SUFFIX => '.crt', + DEB_PRIVATE_SUFFIX => '.key', + + # Dns infos + DNS_PREFIX => '_acme-challenge.', + DNS_SUFFIX => '.', + + # Key infos 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_PROD_DIR => 'https://acme-v01.api.letsencrypt.org/directory', - ACME_TERMS => 'https://letsencrypt.org/documents/LE-SA-v1.1.1-August-1-2016.pdf', + #ACME_CERT => 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem', + ACME_DIR => 'https://acme-staging-v02.api.letsencrypt.org/directory', + ACME_PROD_DIR => 'https://acme-v02.api.letsencrypt.org/directory', # Version - VERSION => 'v0.7', + VERSION => '2.0.0', - # Config - CONFIG => '/etc/acme/config' + # Timeout + TIMEOUT => 300 }; # User agent object @@ -124,7 +134,7 @@ tie(%{$jwk{jwk}{jwk}}, 'Tie::IxHash', e => undef, kty => uc(KEY_TYPE), n => unde # Constructor sub new { # Extract params - my ($class, $mail, $debug, $prod, @domains) = @_; + my ($class, $verbose, $domain, $config) = @_; # Create self hash my $self = {}; @@ -132,27 +142,40 @@ sub new { # Link self to package bless($self, $class); - # Save debug - $self->{debug} = $debug; + # Save verbose + $self->{verbose} = $verbose; - # Save prod - $self->{prod} = $prod; + # Save domain + $self->{domain} = $domain; - # 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); + # Save config + $self->{config} = $config; + + # Save domains + my @domains = ($domain->{domain}, @{$domain->{domains}}); # Show error if check fail - if (! defined $ev->address($mail)) { - map { carp 'failed check: '.$_ if ($self->{debug}) } $ev->details(); - confess 'Email::Valid->address failed'; + unless (defined $self->{domain}{mail}) { + confess('Missing mail'); } - # Save mail - $self->{mail} = $mail; + # Transform mail in an array + unless (ref($self->{domain}{mail}) eq 'ARRAY') { + $self->{domain}{mail} = [ $self->{domain}{mail} ]; + } - # Create resolver - my $res = new Net::DNS::Resolver(); + # 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); + + # Loop on each mail + map { + # Checke address + if (! defined $ev->address($_)) { + map { carp 'failed check: '.$_ if ($self->{verbose}) } $ev->details(); + confess('Validate '.$_.' mail address failed'); + } + } @{$self->{domain}{mail}}; # Check domains map { @@ -160,28 +183,36 @@ sub new { # Extract tld unless (($tld) = $_ =~ m/\.(\w+)$/) { - confess $_.'\'s tld extraction failed'; + confess('Extract '.$_.' tld failed'); } # Check if tld exists unless(Net::Domain::TLD::tld_exists($tld)) { - confess $tld.' tld from '.$_.' don\'t exists'; + confess('Extracted '.$_.' tld '.$tld.' do not exists'); } - # Check if we get dns answer - #XXX: only search A type because letsencrypt don't support ipv6 (AAAA) yet - unless(my $rep = $res->search($_, 'A')) { - confess 'search A record for '.$_.' failed'; - } else { - unless (scalar map { $_->type eq 'A' ? 1 : (); } $rep->answer) { - confess 'search recursively A record for '.$_.' failed'; + # Search a record + my $a = Net::DNS::Resolver->new->search($_, 'A', 'IN'); + + # Search aaaa record + my $aaaa = Net::DNS::Resolver->new->search($_, 'AAAA', 'IN'); + + # Trigger error for unresolvable domain + unless ( + # Check if either has a A or AAAA record + scalar map { + ($_->type eq 'A' or $_->type eq 'AAAA') ? 1 : (); } + # Merge both answer + ( + (defined $a and defined $a->answer) ? $a->answer : (), + (defined $aaaa and defined $aaaa->answer) ? $aaaa->answer : () + ) + ) { + confess('Resolve '.$_.' to an A or AAAA record failed'); } } @domains; - # Save domains - @{$self->{domains}} = @domains; - # Return class reference return $self; } @@ -190,19 +221,58 @@ sub new { sub prepare { my ($self) = @_; + # Extract cert directory and filename + my ($certFile, $certDir) = File::Spec->splitpath($self->{domain}{cert}); + + # Extract key directory and filename + my ($keyFile, $keyDir) = File::Spec->splitpath($self->{domain}{key}); + + # Extract account directory and filename + my ($accountFile, $accountDir) = File::Spec->splitpath($self->{domain}{account}); + # Create all paths - 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 ($self->{debug}); - } @$err; - confess 'make_path failed'; + { + make_path($certDir, $keyDir, $accountDir, $self->{config}{pending}, {error => \my $err}); + if (@$err) { + map { + my ($file, $msg) = %{$_}; + carp 'Mkdir '.($file ? $file.' ' : '').'failed: '.$msg if ($self->{verbose}); + } @$err; + confess('Make path failed'); + } } # Create user agent $ua = LWP::UserAgent->new; - $ua->agent(__PACKAGE__.'/'.VERSION) + $ua->agent(__PACKAGE__.'/'.VERSION); + + # Check that certificate is writable + unless (-w $certDir || -w $self->{domain}{cert}) { + confess('Directory '.$certDir.' or file '.$self->{domain}{cert}.' must be writable: '.$!); + } + + # Check that key is readable or parent directory is writable + unless (-r $self->{domain}{key} || -w $keyDir) { + confess('File '.$self->{domain}{key}.' must be readable or directory '.$keyDir.' must be writable: '.$!); + } + + # Check that account key is readable or parent directory is writable + unless (-r $self->{domain}{account} || -w $accountDir) { + confess('File '.$self->{domain}{account}.' must be readable or directory '.$accountDir.' must be writable: '.$!); + } + + # Backup old certificate if possible + if (-w $certDir && -f $self->{domain}{cert}) { + my ($dt, $suffix) = undef; + + # Extract datetime suffix + $suffix = ($dt = DateTime->from_epoch(epoch => stat($self->{domain}{cert})->mtime))->ymd('').$dt->hms(''); + + # Rename old certificate + unless(copy($self->{domain}{cert}, $self->{domain}{cert}.'.'.$suffix)) { + carp('Copy '.$self->{domain}{cert}.' to '.$self->{domain}{cert}.'.'.$suffix.' failed: '.$!); + } + } } # Drop stderr @@ -239,10 +309,10 @@ sub genKeys { # Restore stderr _restoreStdErr(); } - } (KEY_DIR.DS.ACCOUNT_KEY, KEY_DIR.DS.SERVER_KEY); + } ($self->{domain}{account}, $self->{domain}{key}); # Extract modulus and publicExponent jwk - #XXX: same here we tie to keep ordering + #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys tie(%{$self->{account}}, 'Tie::IxHash', %jwk); map { if (/^Modulus=([0-9A-F]+)$/) { @@ -252,12 +322,12 @@ sub genKeys { # Extract to binary from int, trim leading zeros and convert to base64 url chomp ($self->{account}{jwk}{jwk}{e} = encode_base64url(pack("N", $1) =~ s/^\0+//r)); } - } capturex('openssl', ('rsa', '-text', '-in', KEY_DIR.DS.ACCOUNT_KEY, '-noout', '-modulus')); + } capturex('openssl', ('rsa', '-text', '-in', $self->{domain}{account}, '-noout', '-modulus')); # Drop stderr _dropStdErr(); # Extract account public key - $self->{account}{pubkey} = join('', map { chomp; $_; } capturex('openssl', ('rsa', '-in', KEY_DIR.DS.ACCOUNT_KEY, '-pubout'))); + $self->{account}{pubkey} = join('', map { chomp; $_; } capturex('openssl', ('rsa', '-in', $self->{domain}{account}, '-pubout'))); # Restore stderr _restoreStdErr(); @@ -266,67 +336,92 @@ sub genKeys { $self->{account}{thumbprint} = (sha256_base64(to_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r; } -# Generate certificate request -sub genCsr { +# Directory call +sub directory { my ($self) = @_; - # Openssl config template - my $oct = File::Temp->new(); + # Set time + my $time = time; - # Load template from data - map { s/__EMAIL_ADDRESS__/$self->{mail}/; s/__COMMON_NAME__/$self->{domains}[0]/; print $oct $_; } ; + # Set directory + my $dir = $self->{domain}{prod} ? ACME_PROD_DIR : ACME_DIR; - # Close data - close(DATA); + # Create a request + my $req = HTTP::Request->new(GET => $dir.'?'.$time); - # Append domain names - my $i = 1; - map { print $oct 'DNS.'.$i++.' = '.$_."\n"; } @{$self->{domains}}; + # Get request + my $res = $ua->request($req); + + # Handle error + unless ($res->is_success) { + confess('GET '.$dir.'?'.$time.' failed: '.$res->status_line); + } + + # Init content + my %content; - # Generate csr - capturex('openssl', ('req', '-new', '-outform', 'DER', '-key', KEY_DIR.DS.SERVER_KEY, '-config', $oct->filename, '-out', CERT_DIR.DS.REQUEST_CSR)); + # Extract content + unless (%content = %{from_json($res->content)}) { + confess('GET '.$dir.'?'.$time.' from_json failed: '.$res->status_line); + } - # Close oct - close($oct); + # Merge uris in self content + $self->{req}{dir} = $dir; + $self->{req}{keyChange} = $content{keyChange}; + $self->{req}{newNonce} = $content{newNonce}; + $self->{req}{newAccount} = $content{newAccount}; + $self->{req}{revokeCert} = $content{revokeCert}; + $self->{req}{newOrder} = $content{newOrder}; + + # Check term + unless ($self->{config}{term} eq $content{meta}{termsOfService}) { + confess('GET '.$dir.'?'.$time.' term: '.$content{meta}{termsOfService}.' differ from config: '.$self->{config}{term}); + } } -# Directory call -sub directory { +# Nonce call +sub nonce { my ($self) = @_; # 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 => $dir.'?'.$time); + my $req = HTTP::Request->new(HEAD => $self->{req}{newNonce}.'?'.$time); # Get request my $res = $ua->request($req); # Handle error unless ($res->is_success) { - confess 'GET '.$dir.'?'.$time.' failed: '.$res->status_line; + confess('HEAD '.$self->{req}{newNonce}.'?'.$time.' failed: '.$res->status_line); } # Save nonce - $self->{nonce} = $res->headers->{'replay-nonce'}; - - # Merge uris in self content - %$self = (%$self, %{from_json($res->content)}); + $self->{req}{nonce} = $res->headers->{'replay-nonce'}; } # Post request sub _post { my ($self, $uri, $payload) = @_; - # Protected field - my $protected = encode_base64url(to_json({nonce => $self->{nonce}})); + # Init protected + #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys + #XXX: strict ordering only really needed here for thumbprint sha256 digest + tie(my %protected, 'Tie::IxHash', alg => $self->{account}{jwk}{alg}, jwk => $self->{account}{jwk}{jwk}, nonce => $self->{req}{nonce}, url => $uri); - # Payload field - $payload = encode_base64url(to_json($payload)); + # We have a kid + if (defined($self->{req}{kid})) { + # Replace jwk entry with it + #XXX: when kid is available all request with jwk are rejected by the api + %protected = (alg => $self->{account}{jwk}{alg}, kid => $self->{req}{kid}, nonce => $self->{req}{nonce}, url => $uri); + } + + # Encode protected + my $protected = encode_base64url(to_json(\%protected)); + + # Encode payload + $payload = encode_base64url(to_json($payload)) unless ($payload eq ''); # Sign temp file my $stf = File::Temp->new(); @@ -338,14 +433,16 @@ sub _post { close($stf); # Generate digest of stf - my $signature = encode_base64url(join('', capturex('openssl', ('dgst', '-sha256', '-binary', '-sign', KEY_DIR.DS.ACCOUNT_KEY, $stf->filename))) =~ s/^\0+//r); + my $signature = encode_base64url(join('', capturex('openssl', ('dgst', '-sha256', '-binary', '-sign', $self->{domain}{account}, $stf->filename))) =~ s/^\0+//r); # Create a request my $req = HTTP::Request->new(POST => $uri); - + + # Set request header + $req->header('Content-Type' => 'application/jose+json'); + # Set new-reg request content $req->content(to_json({ - header => $self->{account}{jwk}, protected => $protected, payload => $payload, signature => $signature @@ -356,7 +453,7 @@ sub _post { # Save nonce if (defined $res->headers->{'replay-nonce'}) { - $self->{nonce} = $res->headers->{'replay-nonce'}; + $self->{req}{nonce} = $res->headers->{'replay-nonce'}; } # Return res object @@ -371,23 +468,31 @@ sub _dnsCheck { # 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(); + # Search txt record + my $txt = Net::DNS::Resolver->new->search(DNS_PREFIX.$domain.DNS_SUFFIX, 'TXT', 'IN'); - # Check if we get dns answer - unless(my $rep = $res->search($domain, 'TXT')) { - carp 'TXT record search for '.$domain.' failed' if ($self->{debug}); + # Check that we have a txt record + unless (defined $txt and defined $txt->answer and scalar map { $_->type eq 'TXT' ? 1 : (); } $txt->answer) { + carp 'Resolve '.DNS_PREFIX.$domain.DNS_SUFFIX.' to a TXT record failed' if ($self->{verbose}); 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; + } + + # Check that txt record data match signature + unless (scalar map { ($_->type eq 'TXT' and $_->txtdata eq $signature) ? 1 : (); } $txt->answer) { + # Check verbose + if ($self->{verbose}) { + # Loop on each answer + map { + # Check if we have a TXT record with different value + if ($_->type eq 'TXT' and $_->txtdata ne $signature) { + carp 'Resolved '.DNS_PREFIX.$domain.DNS_SUFFIX.' with "'.$_->txtdata.'" instead of "'.$signature.'"'; + } + } $txt->answer; } + return; } + # Return success return 1; } @@ -398,23 +503,10 @@ 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 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} - } - ) { + # Check if thumbprint is writeable + if (-w $self->{config}{thumbprint}) { # Try to write thumbprint - write_file($config->{thumbprint}, $self->{account}{thumbprint}); + write_file($self->{config}{thumbprint}, $self->{account}{thumbprint}); } # Get request @@ -422,13 +514,13 @@ sub _httpCheck { # Handle error unless ($res->is_success) { - carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($self->{debug}); + carp 'Fetch http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($self->{verbose}); 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 ($self->{debug}); + carp 'Fetched http://'.$domain.'/.well-known/acme-challenge/'.$token.' with "'.$res->content.'" instead of "'.$token.'.'.$self->{account}{thumbprint}.'"' if ($self->{verbose}); return; } @@ -438,51 +530,160 @@ sub _httpCheck { # Register account #XXX: see doc at https://ietf-wg-acme.github.io/acme/#rfc.section.6.3 -sub register { +sub account { my ($self) = @_; - # Post new-reg request - #XXX: contact array may contain a tel:+33612345678 for example - my $res = $self->_post($self->{'new-reg'}, {resource => 'new-reg', contact => ['mailto:'.$self->{mail}], agreement => ACME_TERMS}); + # Init pending directory + $self->{req}{pending} = $self->{config}{pending}.'/'.encode_base64url($self->{req}{dir}).'/'.encode_base64url(join(',', @{$self->{domain}{mail}})); - # Handle error - unless ($res->is_success || $res->code eq 409) { - confess 'POST '.$self->{'new-reg'}.' failed: '.$res->status_line; + # Create pending directory + { + make_path($self->{req}{pending}, {error => \my $err}); + if (@$err) { + map { + my ($file, $msg) = %{$_}; + carp 'Mkdir '.($file ? $file.' ' : '').'failed: '.$msg if ($self->{verbose}); + } @$err; + confess('Make path failed'); + } } - # Update mail informations - if ($res->code eq 409) { - # Save registration uri - $self->{'reg'} = $res->headers->{location}; + # Init file + #XXX: we use this file to store the fetched account + my $file = $self->{req}{pending}.'/'.(((sha256_base64(join(',', @{$self->{domain}{mail}}))) =~ s/=+\z//r) =~ tr[+/][-_]r); + + # Init content + my $content = undef; - # Post reg request - #XXX: contact array may contain a tel:+33612345678 for example - $res = $self->_post($self->{'reg'}, {resource => 'reg', contact => ['mailto:'.$self->{mail}]}); + # Load account content or post a new one + 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)) + } + ) { + # Init tied payload + #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys + tie(my %payload, 'Tie::IxHash', termsOfServiceAgreed => JSON::true, contact => []); + + # Loop on mails + map { + # Append mail to payload + $payload{contact}[scalar @{$payload{contact}}] = 'mailto:'.$_; + } @{$self->{domain}{mail}}; + + # Post newAccount request + # TODO: change contact field in config to contain directly the array [mailto:example@example.com,...] ??? + #XXX: contact array may contain a tel:+33612345678 for example (supported ???) + my $res = $self->_post($self->{req}{'newAccount'}, \%payload); # Handle error unless ($res->is_success) { - confess 'POST '.$self->{'reg'}.' failed: '.$res->status_line; + confess('POST '.$self->{req}{'newAccount'}.' failed: '.$res->status_line) } + + # Store kid from header location + $content = { + 'kid' => $res->headers->{location}, + }; + + # Write to file + write_file($file, to_json($content)); } + + # Set kid from content + $self->{req}{kid} = $content->{kid}; + } # Authorize domains -sub authorize { +sub order { my ($self) = @_; - # Create challenges hash - %{$self->{challenges}} = (); + # Init file + #XXX: we use this file to store the requested domains on our side + #XXX: see bug https://github.com/letsencrypt/boulder/issues/3335 and https://community.letsencrypt.org/t/acmev2-orders-list/51662 + my $file = $self->{req}{pending}.'/'.(((sha256_base64(join(',', ($self->{domain}{domain}, @{$self->{domain}{domains}})))) =~ s/=+\z//r) =~ tr[+/][-_]r); + + # Init content + my $content = undef; + + # Load account content or post a new one + 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) + ) { + # Init tied payload + #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys + #XXX: https://www.perlmonks.org/?node_id=1215976 + #XXX: optional notBefore, notAfter, see https://ietf-wg-acme.github.io/acme/draft-ietf-acme-acme.html#applying-for-certificate-issuance + tie(my %payload, 'Tie::IxHash', identifiers => []); + + # Loop on domains + map { + # Tie in a stable hash and append to identifiers array + #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys + tie(%{$payload{identifiers}[scalar @{$payload{identifiers}}]}, 'Tie::IxHash', type => 'dns', value => $_); + } ($self->{domain}{domain}, @{$self->{domain}{domains}}); + + # Post new order request + my $res = $self->_post($self->{req}{'newOrder'}, \%payload); + + # Handle error + unless ($res->is_success) { + confess('POST '.$self->{req}{'newOrder'}.' failed: '.$res->status_line); + } + + # Handle error + unless ($res->content) { + confess('POST '.$self->{req}{'newOrder'}.' empty content: '.$res->status_line); + } + + # Handle error + unless ($res->headers->{location}) { + confess('POST '.$self->{req}{'newOrder'}.' missing location: '.$res->status_line); + } + + # Extract content + $content = from_json($res->content); + + # Write to file + write_file($file, to_json($content)); + } + + # Save the authorizations + $self->{req}{authorizations} = [ keys %{{ map { $_ => undef } @{$content->{authorizations}} }} ]; - # Pending list - my @pending = (); + # Save the finalize uri + $self->{req}{finalize} = $content->{finalize}; - # Create or load auth request for each domain + # Create challenges hash + %{$self->{req}{challenges}} = (); + + # Extract authorizations map { + # Init uri + my $uri = $_; + # Init content my $content = undef; # Init file - my $file = PENDING_DIR.'/'.$self->{mail}.'.'.($self->{prod} ? 'prod' : 'staging').'/'.$_; + #XXX: tmpdir.'/'..'/'. + my $file = $self->{req}{pending}.'/'.encode_base64url($uri); # Load auth request content or post a new one #TODO: add more check on cache file ??? @@ -499,24 +700,35 @@ sub authorize { } || (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'}); + my $res = $self->_post($uri, ''); # Handle error unless ($res->is_success) { - confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line; + confess('POST '.$uri.' failed: '.$res->status_line); } # 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 identifier + unless ( + defined $content->{identifier} and + defined $content->{identifier}{type} and + defined $content->{identifier}{value} + ) { + confess('POST '.$uri.' missing identifier: '.$res->status_line); + } else { + unless ( + $content->{identifier}{type} eq 'dns' and + $content->{identifier}{value} + ) { + confess('POST '.$uri.' invalid identifier: '.$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; + confess('POST '.$uri.' for '.$content->{identifier}{value}.' failed: '.$res->status_line); } # Write to file @@ -524,145 +736,230 @@ sub authorize { } # Add challenge - %{$self->{challenges}{$_}} = ( + %{$self->{req}{challenges}{$content->{identifier}{value}}} = ( status => $content->{status}, expires => $content->{expires}, - polls => [] + challenges => {}, + polls => {} ); + # Extract challenges + map { + # Save if valid + if ($_->{status} eq 'valid') { + $self->{req}{challenges}{$content->{identifier}{value}}{status} = $_->{status}; + # Check is still polling + } elsif ($content->{status} eq 'pending') { + # Add to challenges list for later use + $self->{req}{challenges}{$content->{identifier}{value}}{challenges}{$_->{type}} = { + status => $_->{status}, + token => $_->{token}, + url => $_->{url} + }; + } + } @{$content->{challenges}}; + + # Set identifier + my $identifier = $content->{identifier}{value}; + # Save pending data - if ($content->{status} eq 'pending') { - # Extract validation data - foreach my $challenge (@{$content->{challenges}}) { + if ($self->{req}{challenges}{$identifier}{status} eq 'pending') { + # Check challenges + map { # 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} - }); + unless($self->{req}{challenges}{$identifier}{status} eq 'valid') { + # One challenge validated + if ($self->{req}{challenges}{$identifier}{challenges}{$_}{status} eq 'valid') { + $self->{req}{challenges}{$identifier}{status} = $self->{req}{challenges}{$identifier}{challenges}{$_}{status}; + # This challenge is to be validated + } elsif ($self->{req}{challenges}{$identifier}{challenges}{$_}{status} eq 'pending') { + #TODO: implement tls-alpn-01 challenge someday if possible + if ( + ($_ eq 'http-01' and $self->_httpCheck($identifier, $self->{req}{challenges}{$identifier}{challenges}{$_}{token})) or + ($_ eq 'dns-01' and $self->_dnsCheck($identifier, $self->{req}{challenges}{$identifier}{challenges}{$_}{token})) + ) { + # Init file + #XXX: tmpdir.'/'..'/'. + my $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{challenges}{$identifier}{challenges}{$_}{url}); + + # Reset content + $content = undef; + + # 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)) + #TODO: Check file modification time ? There is no expires field in json answer + }# || (str2time($content->{expires}) <= time()+3600) + ) { + # Post challenge request + my $res = $self->_post( + $self->{req}{challenges}{$identifier}{challenges}{$_}{url}, + {keyAuthorization => $self->{req}{challenges}{$identifier}{challenges}{$_}{token}.'.'.$self->{account}{thumbprint}} + ); + + # Handle error + unless ($res->is_success) { + confess('POST '.$self->{req}{challenges}{$identifier}{challenges}{$_}{url}.' failed: '.$res->status_line); + } + + # Extract content + $content = from_json($res->content); + + # Write to file + write_file($file, to_json($content)); + } + + # Save if valid + if ($content->{status} eq 'valid') { + $self->{req}{challenges}{$identifier}{status} = $content->{status}; + # Check is still polling + } elsif ($content->{status} eq 'pending') { + # Add to poll list for later use + $self->{req}{challenges}{$identifier}{polls}{$content->{type}} = 1; + } } } } - } + } keys %{$self->{req}{challenges}{$identifier}{challenges}}; + # Check if check is challenge still in pending and no polls - if ($self->{challenges}{$_}{status} eq 'pending' && scalar @{$self->{challenges}{$_}{polls}} == 0) { + if ($self->{req}{challenges}{$identifier}{status} eq 'pending' && scalar keys %{$self->{req}{challenges}{$identifier}{polls}} == 0) { # Loop on all remaining challenges - foreach my $challenge (@{$content->{challenges}}) { + map { + #TODO: implement tls-alpn-01 challenge someday if possible # 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"; + if ($_ eq 'http-01') { + print STDERR 'Require URI http://'.$identifier.'/.well-known/acme-challenge/'.$self->{req}{challenges}{$identifier}{challenges}{$_}{token}.' with "'.$self->{req}{challenges}{$identifier}{challenges}{$_}{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"; + } elsif ($_ eq 'dns-01') { + print STDERR 'Require TXT record _acme-challenge.'.$identifier.'. with "'.(((sha256_base64($self->{req}{challenges}{$identifier}{challenges}{$_}{token}.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r).'"'."\n"; } - } + } keys %{$self->{req}{challenges}{$identifier}{challenges}}; } } - } @{$self->{domains}}; + } @{$self->{req}{authorizations}}; # Init max run - my $remaining = 10; + my $remaining = TIMEOUT; # Poll pending - while (--$remaining >= 0 and scalar map { $_->{status} eq 'valid' ? 1 : (); } values %{$self->{challenges}}) { + while (--$remaining >= 0 and scalar map { ($_->{status} eq 'pending' and scalar keys %{$_->{polls}}) ? 1 : (); } values %{$self->{req}{challenges}}) { # Sleep sleep(1); + # Poll remaining pending map { - # Init domain - my $domain = $_; + # Init identifier + my $identifier = $_; # Poll remaining polls map { - # Create a request - my $req = HTTP::Request->new(GET => $_->{poll}); - - # Get request - my $res = $ua->request($req); + # Post challenge request + #XXX: no cache here we force update + my $res = $self->_post( + $self->{req}{challenges}{$identifier}{challenges}{$_}{url}, + {keyAuthorization => $self->{req}{challenges}{$identifier}{challenges}{$_}{token}.'.'.$self->{account}{thumbprint}} + ); # Handle error unless ($res->is_success) { - carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($self->{debug}); + confess('POST '.$self->{req}{challenges}{$identifier}{challenges}{$_}{url}.' failed: '.$res->status_line); } # Extract content - my $content = from_json($res->content); + $content = from_json($res->content); + + # Init file + #XXX: tmpdir.'/'..'/'. + my $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{challenges}{$identifier}{challenges}{$_}{url}); + + # Write to file + write_file($file, to_json($content)); # Save status if ($content->{status} ne 'pending') { - $self->{challenges}{$domain}{status} = $content->{status}; + $self->{req}{challenges}{$identifier}{status} = $content->{status}; } - } @{$self->{challenges}{$_}{polls}}; - } map { $self->{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{challenges}}; + } keys %{$self->{req}{challenges}{$identifier}{polls}}; + } map { $self->{req}{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{req}{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} - } - ) { + + # Check if thumbprint is writeable + if (-w $self->{config}{thumbprint}) { # Try to write thumbprint - write_file($config->{thumbprint}, ''); + write_file($self->{config}{thumbprint}, ''); } - # Stop here with remaining chanllenge - if (scalar map { ! defined $_->{status} or $_->{status} ne 'valid' ? 1 : (); } values %{$self->{challenges}}) { - # Deactivate all activated domains - #XXX: not implemented by letsencrypt + # Stop here with remaining challenge + if (scalar map { $_->{status} ne 'valid' ? 1 : (); } values %{$self->{req}{challenges}}) { + #TODO: Deactivate all activated domains ? + #XXX: see if implemented by letsencrypt ACMEv2 #map { # # Post deactivation request # my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'authz', status => 'deactivated'}); # # Handle error # unless ($res->is_success) { - # confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line; + # 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 ($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; + if ($self->{verbose}) { + my @domains = map { $self->{req}{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{req}{challenges}}; + #my @domains = map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}}; + carp 'Fix challenge'.(scalar @domains > 1?'s':'').' for: '.join(', ', @domains); } + exit EXIT_FAILURE; + } +} + +# Generate certificate request +sub genCsr { + my ($self) = @_; + + # Init csr file + #XXX: tmpdir.'/'..'/'..':'..':'.join(',', @domains).'..'.CSR_SUFFIX + $self->{req}{csr} = $self->{req}{pending}.'/'.(((sha256_base64(join(',', ($self->{domain}{domain}, @{$self->{domain}{domains}})))) =~ s/=+\z//r) =~ tr[+/][-_]r).CSR_SUFFIX; + + # Reuse certificate request file without domain/mail change + if (! -f $self->{req}{csr}) { + # Openssl config template + my $oct = File::Temp->new(UNLINK => 0); + + # Save data start position + my $pos = tell DATA; + + # Init counter + my $i = 0; + + # Prepare mail + my $mail = join("\n", map { $i++.'.emailAddress'."\t\t\t".'= '.$_; } @{$self->{domain}{mail}}); + + # Load template from data + map { s/__EMAIL_ADDRESS__/$mail/; s/__COMMON_NAME__/$self->{domain}{domain}/; print $oct $_; } ; + + # Reseek data + seek(DATA, $pos, 0); + + # Append domain names + $i = 0; + map { print $oct 'DNS.'.$i++.' = '.$_."\n"; } ($self->{domain}{domain}, @{$self->{domain}{domains}}); + + # Generate csr + #XXX: read certificate request with: openssl req -inform DER -in $self->{req}{csr} -text + capturex('openssl', ('req', '-new', '-outform', 'DER', '-key', $self->{domain}{key}, '-config', $oct->filename, '-out', $self->{req}{csr})); + + # Close oct + close($oct); } } @@ -671,7 +968,7 @@ sub issue { my ($self) = @_; # Open csr file - open(my $fh, '<', CERT_DIR.DS.REQUEST_CSR) or die $!; + open(my $fh, '<', $self->{req}{csr}) or die $!; # Load csr my $csr = encode_base64url(join('', <$fh>) =~ s/^\0+//r); @@ -679,39 +976,104 @@ sub issue { # Close csr file close($fh) or die $!; - # Post certificate request - my $res = $self->_post($self->{'new-cert'}, {resource => 'new-cert', csr => $csr}); + # Init file + #XXX: tmpdir.'/'..'/'. + my $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{finalize}); - # Handle error - unless ($res->is_success) { - confess 'POST '.$self->{'new-cert'}.' failed: '.$res->status_line; - } + # Init content + my $content = undef; - # Open crt file - open($fh, '>', CERT_DIR.DS.SERVER_CRT) or die $!; + # Init res + my $res = undef; - # Convert to pem - print $fh '-----BEGIN CERTIFICATE-----'."\n".encode_base64($res->content).'-----END CERTIFICATE-----'."\n"; + # 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 file modification time ? There is no expires field in json answer + } || (str2time($content->{expires}) <= time()+3600) + ) { + # Post certificate request + $res = $self->_post($self->{req}{finalize}, {csr => $csr}); - # Create a request - my $req = HTTP::Request->new(GET => ACME_CERT); + # Handle error + unless ($res->is_success) { + confess('POST '.$self->{req}{finalize}.' failed: '.$res->status_line); + } - # Get request - $res = $ua->request($req); + # Extract content + $content = from_json($res->content); - # Handle error - unless ($res->is_success) { - carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($self->{debug}); + # Check status + unless (defined $content->{status} and $content->{status} eq 'valid') { + confess('POST '.$self->{req}{finalize}.' failed: invalid status: '.(defined $content->{status}?$content->{status}:'undefined')); + } + + # Check certificate + unless (defined $content->{certificate} and $content->{certificate}) { + confess('POST '.$self->{req}{finalize}.' failed: invalid certificate: '.(defined $content->{certificate}?$content->{certificate}:'undefined')); + } + + # Write to file + write_file($file, to_json($content)); } - # Append content - print $fh $res->content; + # Set certificate + $self->{req}{certificate} = $content->{certificate}; - # Close file - close($fh) or die $!; + # Set file + #XXX: tmpdir.'/'..'/'. + $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{certificate}); + + # Reset content + $content = undef; + + # 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)) + # Check file modification time ? There is no expires field in json answer + #TODO: add a checck on modification time ??? + }# || (str2time($content->{expires}) <= time()+3600) + ) { + # Post certificate request + $res = $self->_post($self->{req}{certificate}, ''); + + # Handle error + unless ($res->is_success) { + confess('POST '.$self->{req}{certificate}.' failed: '.$res->status_line); + } + + # Set content + $content = $res->content; + + # Remove multi-line jump + $content =~ s/\n\n/\n/; + + # Remove trailing line jump + chomp $content; + + # Write to file + write_file($file, $content); + } + + # Write to cert file + write_file($self->{domain}{cert}, $content); # Print success - carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($self->{debug}); + carp 'Saved '.$self->{domain}{cert}.' pem certificate' if ($self->{verbose}); } 1; @@ -744,7 +1106,7 @@ localityName = Locality Name organizationName = Organization Name organizationalUnitName = Organizational Unit Name commonName = __COMMON_NAME__ -emailAddress = __EMAIL_ADDRESS__ +__EMAIL_ADDRESS__ [ v3_req ] basicConstraints = CA:false