X-Git-Url: https://git.rapsys.eu/acme/blobdiff_plain/9c3c698790057b5c32bb7daacb9269ddf4b677df..17feca20e7d0e958d43e934cdc4894a0457c2727:/acme.pm diff --git a/acme.pm b/acme.pm deleted file mode 100644 index db1c6d4..0000000 --- a/acme.pm +++ /dev/null @@ -1,760 +0,0 @@ -# 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; - -# Best practice -use strict; -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(from_json to_json); -use LWP; -use MIME::Base64 qw(encode_base64url encode_base64); -use Net::Domain::TLD; -use POSIX qw(EXIT_FAILURE); -use Tie::IxHash; - -# 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 -#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', - - # Server private key - SERVER_KEY => 'server.pem', - - # 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_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 - VERSION => 'v0.6', - - # Config - CONFIG => '/etc/acmepl/config' -}; - -# User agent object -our $ua; - -# Strerr backup -our $_stderr; - -# JSON Web Key (JWK) -#XXX: tie to Tie::IxHash to keep a stable ordering of hash keys -#our %jwk = ( -# pubkey => undef, -# jwk => { -# alg => 'RS256', -# jwk => { -# # Exponent -# e => undef, -# # Key type -# kty => uc(KEY_TYPE), -# # Modulus -# n => undef -# } -# }, -# thumbprint => undef -#); -tie(our %jwk, 'Tie::IxHash', pubkey => undef, jwk => undef, thumbprint => undef); -tie(%{$jwk{jwk}}, 'Tie::IxHash', alg => 'RS256', jwk => undef); -#XXX: strict ordering only really needed here for thumbprint sha256 digest -tie(%{$jwk{jwk}{jwk}}, 'Tie::IxHash', e => undef, kty => uc(KEY_TYPE), n => undef); - -# Constructor -sub new { - # Extract params - my ($class, $mail, $debug, $prod, @domains) = @_; - - # Create self hash - my $self = {}; - - # 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 ($self->{debug}) } $ev->details(); - confess 'Email::Valid->address failed'; - } - - # Save mail - $self->{mail} = $mail; - - # Create resolver - my $res = new Net::DNS::Resolver(); - - # Check domains - map { - my $tld; - - # Extract tld - unless (($tld) = $_ =~ m/\.(\w+)$/) { - confess $_.'\'s tld extraction failed'; - } - - # Check if tld exists - unless(Net::Domain::TLD::tld_exists($tld)) { - confess $tld.' tld from '.$_.' don\'t 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'; - } - } - } @domains; - - # Save domains - @{$self->{domains}} = @domains; - - # Return class reference - return $self; -} - -# Prepare environement -sub prepare { - my ($self) = @_; - - # 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'; - } - - # Create user agent - $ua = LWP::UserAgent->new; - $ua->agent(__PACKAGE__.'/'.VERSION) -} - -# Drop stderr -sub _dropStdErr { - # Save stderr - open($_stderr, '>&STDERR') or die $!; - # Close it - close(STDERR) or die $!; - # Send to /dev/null - open(STDERR, '>', '/dev/null') or die $!; -} - -# Restore stderr -sub _restoreStdErr { - # Close stderr - close(STDERR); - # Open it back - open(STDERR, '>&', $_stderr) or die $!; -} - -# Generate required keys -sub genKeys { - my ($self) = @_; - - # Generate account and server key if required - map { - # Check key existence - if (! -f $_) { - # Drop stderr - _dropStdErr(); - # Generate key - #XXX: we drop stderr here because openssl can't be quiet on this command - capturex('openssl', ('genrsa', '-out', $_, KEY_SIZE)); - # Restore stderr - _restoreStdErr(); - } - } (KEY_DIR.DS.ACCOUNT_KEY, KEY_DIR.DS.SERVER_KEY); - - # Extract modulus and publicExponent jwk - #XXX: same here we tie to keep ordering - tie(%{$self->{account}}, 'Tie::IxHash', %jwk); - map { - if (/^Modulus=([0-9A-F]+)$/) { - # Extract to binary from hex and convert to base64 url - $self->{account}{jwk}{jwk}{n} = encode_base64url(pack("H*", $1) =~ s/^\0+//r); - } elsif (/^publicExponent:\s([0-9]+)\s\(0x[0-1]+\)$/) { - # 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')); - - # Drop stderr - _dropStdErr(); - # Extract account public key - $self->{account}{pubkey} = join('', map { chomp; $_; } capturex('openssl', ('rsa', '-in', KEY_DIR.DS.ACCOUNT_KEY, '-pubout'))); - # Restore stderr - _restoreStdErr(); - - # Store thumbprint - #XXX: convert base64 to base64 url - $self->{account}{thumbprint} = (sha256_base64(to_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r; -} - -# Generate certificate request -sub genCsr { - my ($self) = @_; - - # Openssl config template - my $oct = File::Temp->new(); - - # Load template from data - map { s/__EMAIL_ADDRESS__/$self->{mail}/; s/__COMMON_NAME__/$self->{domains}[0]/; print $oct $_; } ; - - # Close data - close(DATA); - - # Append domain names - my $i = 1; - map { print $oct 'DNS.'.$i++.' = '.$_."\n"; } @{$self->{domains}}; - - # Generate csr - capturex('openssl', ('req', '-new', '-outform', 'DER', '-key', KEY_DIR.DS.SERVER_KEY, '-config', $oct->filename, '-out', CERT_DIR.DS.REQUEST_CSR)); - - # Close oct - close($oct); -} - -# Directory call -sub directory { - 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); - - # Get request - my $res = $ua->request($req); - - # Handle error - unless ($res->is_success) { - confess 'GET '.$dir.'?'.$time.' failed: '.$res->status_line; - } - - # Save nonce - $self->{nonce} = $res->headers->{'replay-nonce'}; - - # Merge uris in self content - %$self = (%$self, %{from_json($res->content)}); -} - -# Post request -sub _post { - my ($self, $uri, $payload) = @_; - - # Protected field - my $protected = encode_base64url(to_json({nonce => $self->{nonce}})); - - # Payload field - $payload = encode_base64url(to_json($payload)); - - # Sign temp file - my $stf = File::Temp->new(); - - # Append protect.payload to stf - print $stf $protected.'.'.$payload; - - # Close stf - 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); - - # Create a request - my $req = HTTP::Request->new(POST => $uri); - - # Set new-reg request content - $req->content(to_json({ - header => $self->{account}{jwk}, - protected => $protected, - payload => $payload, - signature => $signature - })); - - # Post request - my $res = $ua->request($req); - - # Save nonce - if (defined $res->headers->{'replay-nonce'}) { - $self->{nonce} = $res->headers->{'replay-nonce'}; - } - - # Return res object - 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, $domain, $token) = @_; - - # 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} - } - ) { - # 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 ($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 ($self->{debug}); - return; - } - - # Return success - return 1; -} - -# Register account -#XXX: see doc at https://ietf-wg-acme.github.io/acme/#rfc.section.6.3 -sub register { - 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}); - - # Handle error - unless ($res->is_success || $res->code eq 409) { - confess 'POST '.$self->{'new-reg'}.' failed: '.$res->status_line; - } - - # Update mail informations - if ($res->code eq 409) { - # Save registration uri - $self->{'reg'} = $res->headers->{location}; - - # Post reg request - #XXX: contact array may contain a tel:+33612345678 for example - $res = $self->_post($self->{'reg'}, {resource => 'reg', contact => ['mailto:'.$self->{mail}]}); - - # Handle error - unless ($res->is_success) { - confess 'POST '.$self->{'reg'}.' failed: '.$res->status_line; - } - } -} - -# Authorize domains -sub authorize { - my ($self) = @_; - - # Create challenges hash - %{$self->{challenges}} = (); - - # Pending list - my @pending = (); - - # Create or load auth request for each domain - map { - # 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; - } - - # 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 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 => $content->{status}, - expires => $content->{expires}, - polls => [] - ); - - # Save pending data - if ($content->{status} eq 'pending') { - # Extract validation data - foreach my $challenge (@{$content->{challenges}}) { - # 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 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"; - } - } - } - } - } @{$self->{domains}}; - - # Init max run - my $remaining = 10; - - # Poll pending - while (--$remaining >= 0 and scalar map { $_->{status} eq 'valid' ? 1 : (); } values %{$self->{challenges}}) { - # Sleep - sleep(1); - # Poll remaining pending - map { - # Init domain - my $domain = $_; - - # Poll remaining polls - map { - # Create a request - my $req = HTTP::Request->new(GET => $_->{poll}); - - # 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 = from_json($res->content); - - # 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 - #XXX: not implemented by letsencrypt - #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; - # } - #} 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; - } - } -} - -# Issue certificate -sub issue { - my ($self) = @_; - - # Open csr file - open(my $fh, '<', CERT_DIR.DS.REQUEST_CSR) or die $!; - - # Load csr - my $csr = encode_base64url(join('', <$fh>) =~ s/^\0+//r); - - # Close csr file - close($fh) or die $!; - - # Post certificate request - my $res = $self->_post($self->{'new-cert'}, {resource => 'new-cert', csr => $csr}); - - # Handle error - unless ($res->is_success) { - 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"; - - # Create a request - my $req = HTTP::Request->new(GET => ACME_CERT); - - # Get request - $res = $ua->request($req); - - # Handle error - unless ($res->is_success) { - carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($self->{debug}); - } - - # Append content - print $fh $res->content; - - # Close file - close($fh) or die $!; - - # Print success - carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($self->{debug}); -} - -1; - -__DATA__ -# -# OpenSSL configuration file. -# This is mostly being used for generation of certificate requests. -# - -[ req ] -default_bits = 2048 -default_md = sha256 -prompt = no -distinguished_name = req_distinguished_name -# The extentions to add to the self signed cert -x509_extensions = v3_ca -# The extensions to add to a certificate request -req_extensions = v3_req - -# This sets a mask for permitted string types. There are several options. -# utf8only: only UTF8Strings (PKIX recommendation after 2004). -# WARNING: ancient versions of Netscape crash on BMPStrings or UTF8Strings. -string_mask = utf8only - -[ req_distinguished_name ] -countryName = US -stateOrProvinceName = State or Province Name -localityName = Locality Name -organizationName = Organization Name -organizationalUnitName = Organizational Unit Name -commonName = __COMMON_NAME__ -emailAddress = __EMAIL_ADDRESS__ - -[ v3_req ] -basicConstraints = CA:false -keyUsage = nonRepudiation, digitalSignature, keyEncipherment -subjectAltName = email:move -subjectAltName = @alt_names - -[ v3_ca ] -subjectKeyIdentifier = hash -authorityKeyIdentifier = keyid:always,issuer -basicConstraints = CA:true - -[alt_names]