--- /dev/null
+# 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 $_; } <DATA>;
+
+ # 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]
Rapsys Git / acme / commitdiff