From: Raphaƫl Gertz Date: Sun, 26 Jun 2016 18:50:26 +0000 (+0200) Subject: Initial import X-Git-Tag: 0.1.0~1 X-Git-Url: https://git.rapsys.eu/acme/commitdiff_plain/98649bccc6a08c193cfbbbdc61b61a41808bbe13?ds=inline Initial import --- 98649bccc6a08c193cfbbbdc61b61a41808bbe13 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..657eae2 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +cert +key diff --git a/acme.pm b/acme.pm new file mode 100644 index 0000000..06bcac9 --- /dev/null +++ b/acme.pm @@ -0,0 +1,639 @@ +# acme package +package acme; + +# Best practice +use strict; +use warnings; + +# Symbol export +use Exporter; +our @ISA = qw(Exporter); + +# Load dependancies +use Carp qw(carp confess); +use Digest::SHA qw(sha256_base64); +use Email::Valid; +use File::Path qw(make_path); +use File::Temp; # qw( :seekable ); +use IPC::System::Simple qw(capturex); +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; + +# Documentation links +#XXX: see ietf draft at https://ietf-wg-acme.github.io/acme/ +#XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js + +# Set constants +use constant { + DS => '/', + + CERT_DIR => 'cert', + KEY_DIR => 'key', + + ACCOUNT_KEY => 'account.pem', + ACCOUNT_PUB => 'account.pub', + SERVER_KEY => 'server.pem', + REQUEST_CSR => 'request.der', + SERVER_CRT => 'server.crt', + # rsa + KEY_TYPE => 'rsa', + # 2048|4096 + KEY_SIZE => 4096, + + 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', + + VERSION => 'v0.1' +}; + +# User agent object +our $ua; + +# Debug +our $_debug = 0; + +# 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, @domains) = @_; + + # Create self hash + my $self = {}; + + # Link self to package + bless($self, $class); + + # 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(); + 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 { + # Create all paths + make_path(CERT_DIR, KEY_DIR, {error => \my $err}); + if (@$err) { + map { + my ($file, $msg) = %$_; + carp ($file eq '' ? '' : $file.': ').$msg if ($_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(encode_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; + + # Create a request + my $req = HTTP::Request->new(GET => ACME_DIR.'?'.$time); + + # Get request + my $res = $ua->request($req); + + # Handle error + unless ($res->is_success) { + confess 'GET '.ACME_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)}); +} + +# Post request +sub _post { + my ($self, $uri, $payload) = @_; + + # Protected field + my $protected = encode_base64url(encode_json({nonce => $self->{nonce}})); + + # Payload field + $payload = encode_base64url(encode_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(encode_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; +} + +# Get uri and check content +sub _httpCheck { + my ($self, $uri, $content) = @_; + + # Create a request + my $req = HTTP::Request->new(GET => $uri); + + # Get request + my $res = $ua->request($req); + + # Handle error + unless ($res->is_success) { + carp 'GET '.$uri.' failed: '.$res->status_line if ($_debug); + return; + } + + # Handle invalid content + unless($res->content =~ /^$content\s*$/) { + carp 'GET '.$uri.' content match failed: /^'.$content.'\s*$/ !~ '.$res->content if ($_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 +#TODO: implement combinations check one day +sub authorize { + my ($self) = @_; + + # Create challenges hash + %{$self->{challenges}} = (); + + # Pending list + my @pending = (); + + # Create 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'}); + + # Handle error + unless ($res->is_success) { + confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line; + } + + # Decode content + my $content = decode_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; + } + + # Add challenge + %{$self->{challenges}{$_}} = ( + status => undef, + expires => undef, + #dns_uri => undef, + #dns_token => undef, + http_uri => undef, + http_token => undef, + http_challenge => undef + ); + + # Save status + $self->{challenges}{$_}{status} = $content->{status}; + + # Save pending data + if ($content->{status} eq 'pending') { + # Exctract 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}; + } + } + + # 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}; + } + } 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}}; + + # Poll pending + while (scalar map { $_->{status} eq 'pending' ? 1 : (); } values %{$self->{challenges}}) { + # Sleep + sleep(1); + # Poll remaining pending + map { + # Create a request + my $req = HTTP::Request->new(GET => $self->{challenges}{$_}{http_challenge}); + + # Get request + my $res = $ua->request($req); + + # Handle error + unless ($res->is_success) { + carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($_debug); + } + + # Extract content + my $content = decode_json($res->content); + + # Save status + $self->{challenges}{$_}{status} = $content->{status}; + } map { $self->{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{challenges}}; + } + + # 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) { + # 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}}); + } 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) { + 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(); + + # Append protect.payload to stf + print $stf $content; + + # 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)))); + + # 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; + } + } + + return 1; +} + +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] diff --git a/gencert b/gencert new file mode 100755 index 0000000..85e6f69 --- /dev/null +++ b/gencert @@ -0,0 +1,48 @@ +#! /usr/bin/perl + +# Best practice +use strict; +use warnings; + +# Load acme +use acme; + +# Load POSIX +use POSIX qw(EXIT_SUCCESS EXIT_FAILURE); + +#XXX: debug +use Data::Dumper; + +# Show usage +if (scalar(@ARGV) < 2) { + print "Usage: $0 user\@example.com www.example.com [example.com] [...]\n"; + exit EXIT_FAILURE; +} + +# Create new object +my $acme = acme->new(shift @ARGV, @ARGV); + +# Prepare environement +$acme->prepare(); + +# Generate required keys +$acme->genKeys(); + +# Generate csr +$acme->genCsr(); + +# Directory +$acme->directory(); + +# Register +$acme->register(); + +# Authorize +$acme->authorize(); + +# Issue +$acme->issue(); + +# Exit with success +exit EXIT_SUCCESS; +