]> Raphaël G. Git Repositories - acme/blobdiff - acme.pm
Rapsys Git / acme / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Replace encode_json and decode_json with to_json and from_json to avoid
[acme] / acme.pm
diff --git a/acme.pm b/acme.pm
index b3629f913cf3de54e0672c2a203a0e65e1dd1339..db1c6d4c6ca1e0cf15209ea26b9ad3dc58a583e2 100644 (file)
--- a/acme.pm
+++ b/acme.pm
@@ -1,3 +1,20 @@
+# This file is part of Acmepl
+#
+# Acmepl is is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#
+# Copyright (C) 2016 - 2017 Raphaël Gertz <acmepl@rapsys.eu>
+
 # acme package
 package acme;
 
 # acme package
 package acme;
 
@@ -8,23 +25,23 @@ use warnings;
 # Symbol export
 use Exporter;
 our @ISA = qw(Exporter);
 # 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);
 
 # 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::Path qw(make_path);
 use File::Slurp qw(read_file write_file);
 use File::Temp; # qw( :seekable );
 use IPC::System::Simple qw(capturex);
 use Digest::SHA qw(sha256_base64);
 use Email::Valid;
 use File::Path qw(make_path);
 use File::Slurp qw(read_file write_file);
 use File::Temp; # qw( :seekable );
 use IPC::System::Simple qw(capturex);
-use JSON qw(encode_json decode_json);
+use JSON qw(from_json to_json);
 use LWP;
 use MIME::Base64 qw(encode_base64url encode_base64);
 use Net::Domain::TLD;
 use LWP;
 use MIME::Base64 qw(encode_base64url encode_base64);
 use Net::Domain::TLD;
-use Tie::IxHash;
 use POSIX qw(EXIT_FAILURE);
 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/)
 
 # Documentation links
 #XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
@@ -67,18 +84,18 @@ use constant {
        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_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.0.1-July-27-2015.pdf',
+       ACME_TERMS => 'https://letsencrypt.org/documents/LE-SA-v1.1.1-August-1-2016.pdf',
 
        # Version
 
        # Version
-       VERSION => 'v0.3'
+       VERSION => 'v0.6',
+
+       # Config
+       CONFIG => '/etc/acmepl/config'
 };
 
 # User agent object
 our $ua;
 
 };
 
 # User agent object
 our $ua;
 
-# Debug
-our $_debug = 0;
-
 # Strerr backup
 our $_stderr;
 
 # Strerr backup
 our $_stderr;
 
@@ -107,7 +124,7 @@ tie(%{$jwk{jwk}{jwk}}, 'Tie::IxHash', e => undef, kty => uc(KEY_TYPE), n => unde
 # Constructor
 sub new {
        # Extract params
 # Constructor
 sub new {
        # Extract params
-       my ($class, $mail, @domains) = @_;
+       my ($class, $mail, $debug, $prod, @domains) = @_;
 
        # Create self hash
        my $self = {};
 
        # Create self hash
        my $self = {};
@@ -115,13 +132,19 @@ sub new {
        # Link self to package
        bless($self, $class);
 
        # 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)) {
        # Add extra check to mail validity
        #XXX: mxcheck fail if there is only a A record on the domain
        my $ev = Email::Valid->new(-fqdn => 1, -tldcheck => 1, -mxcheck => 1);
 
        # Show error if check fail
        if (! defined $ev->address($mail)) {
-               map { carp 'failed check: '.$_ if ($_debug) } $ev->details();
+               map { carp 'failed check: '.$_ if ($self->{debug}) } $ev->details();
                confess 'Email::Valid->address failed';
        }
 
                confess 'Email::Valid->address failed';
        }
 
@@ -165,14 +188,14 @@ sub new {
 
 # Prepare environement
 sub prepare {
 
 # Prepare environement
 sub prepare {
-       my ($self, $prod) = @_;
+       my ($self) = @_;
 
        # Create all paths
 
        # Create all paths
-       make_path(CERT_DIR, KEY_DIR, PENDING_DIR.'/'.$self->{mail}.'.'.($prod ? 'prod' : 'staging'), {error => \my $err});
+       make_path(CERT_DIR, KEY_DIR, PENDING_DIR.'/'.$self->{mail}.'.'.($self->{prod} ? 'prod' : 'staging'), {error => \my $err});
        if (@$err) {
                map {
                        my ($file, $msg) = %$_;
        if (@$err) {
                map {
                        my ($file, $msg) = %$_;
-                       carp ($file eq '' ? '' : $file.': ').$msg if ($_debug);
+                       carp ($file eq '' ? '' : $file.': ').$msg if ($self->{debug});
                } @$err;
                confess 'make_path failed';
        }
                } @$err;
                confess 'make_path failed';
        }
@@ -240,7 +263,7 @@ sub genKeys {
 
        # Store thumbprint
        #XXX: convert base64 to base64 url
 
        # Store thumbprint
        #XXX: convert base64 to base64 url
-       $self->{account}{thumbprint} = (sha256_base64(encode_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r;
+       $self->{account}{thumbprint} = (sha256_base64(to_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r;
 }
 
 # Generate certificate request
 }
 
 # Generate certificate request
@@ -269,13 +292,13 @@ sub genCsr {
 
 # Directory call
 sub directory {
 
 # Directory call
 sub directory {
-       my ($self, $prod) = @_;
+       my ($self) = @_;
 
        # Set time
        my $time = time;
 
        # Set directory
 
        # Set time
        my $time = time;
 
        # Set directory
-       my $dir = $prod ? ACME_PROD_DIR : ACME_DIR;
+       my $dir = $self->{prod} ? ACME_PROD_DIR : ACME_DIR;
 
        # Create a request
        my $req = HTTP::Request->new(GET => $dir.'?'.$time);
 
        # Create a request
        my $req = HTTP::Request->new(GET => $dir.'?'.$time);
@@ -292,7 +315,7 @@ sub directory {
        $self->{nonce} = $res->headers->{'replay-nonce'};
 
        # Merge uris in self content
        $self->{nonce} = $res->headers->{'replay-nonce'};
 
        # Merge uris in self content
-       %$self = (%$self, %{decode_json($res->content)});
+       %$self = (%$self, %{from_json($res->content)});
 }
 
 # Post request
 }
 
 # Post request
@@ -300,10 +323,10 @@ sub _post {
        my ($self, $uri, $payload) = @_;
 
        # Protected field
        my ($self, $uri, $payload) = @_;
 
        # Protected field
-       my $protected = encode_base64url(encode_json({nonce => $self->{nonce}}));
+       my $protected = encode_base64url(to_json({nonce => $self->{nonce}}));
 
        # Payload field
 
        # Payload field
-       $payload = encode_base64url(encode_json($payload));
+       $payload = encode_base64url(to_json($payload));
 
        # Sign temp file
        my $stf = File::Temp->new();
 
        # Sign temp file
        my $stf = File::Temp->new();
@@ -321,7 +344,7 @@ sub _post {
        my $req = HTTP::Request->new(POST => $uri);
        
        # Set new-reg request content
        my $req = HTTP::Request->new(POST => $uri);
        
        # Set new-reg request content
-       $req->content(encode_json({
+       $req->content(to_json({
                header => $self->{account}{jwk},
                protected => $protected,
                payload => $payload,
                header => $self->{account}{jwk},
                protected => $protected,
                payload => $payload,
@@ -356,11 +379,11 @@ sub _dnsCheck {
 
        # Check if we get dns answer
        unless(my $rep = $res->search($domain, 'TXT')) {
 
        # Check if we get dns answer
        unless(my $rep = $res->search($domain, 'TXT')) {
-               carp 'TXT record search for '.$domain.' failed' if ($_debug);
+               carp 'TXT record search for '.$domain.' failed' if ($self->{debug});
                return;
        } else {
                unless (scalar map { $_->type eq 'TXT' && $_->txtdata =~ /^$signature$/ ? 1 : (); } $rep->answer) {
                return;
        } else {
                unless (scalar map { $_->type eq 'TXT' && $_->txtdata =~ /^$signature$/ ? 1 : (); } $rep->answer) {
-                       carp 'TXT record recursive search for '.$domain.' failed' if ($_debug);
+                       carp 'TXT record recursive search for '.$domain.' failed' if ($self->{debug});
                        return;
                }
        }
                        return;
                }
        }
@@ -375,18 +398,37 @@ sub _httpCheck {
        # Create a request
        my $req = HTTP::Request->new(GET => 'http://'.$domain.'/.well-known/acme-challenge/'.$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) {
        # 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 ($_debug);
+               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*$/) {
                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 ($_debug);
+               carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' content match failed: /^'.$token.'.'.$self->{account}{thumbprint}.'\s*$/ !~ '.$res->content if ($self->{debug});
                return;
        }
 
                return;
        }
 
@@ -426,7 +468,7 @@ sub register {
 
 # Authorize domains
 sub authorize {
 
 # Authorize domains
 sub authorize {
-       my ($self, $prod) = @_;
+       my ($self) = @_;
 
        # Create challenges hash
        %{$self->{challenges}} = ();
 
        # Create challenges hash
        %{$self->{challenges}} = ();
@@ -440,22 +482,21 @@ sub authorize {
                my $content = undef;
 
                # Init file
                my $content = undef;
 
                # Init file
-               my $file = PENDING_DIR.'/'.$self->{mail}.'.'.($prod ? 'prod' : 'staging').'/'.$_;
+               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 (
 
                # 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 decode_json
+                       #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
                        ! defined eval {
                                # Check that file exists
                                -f $file &&
                                # Read it
                                ($content = read_file($file)) &&
                                # Decode it
-                               ($content = decode_json($content)) &&
-                               # Check expiration
-                               (DateTime->from_epoch(epoch => str2time($content->{expires})) >= DateTime->now()->add(hours => 1))
-                       }
+                               ($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'});
                ) {
                        # Post new-authz request
                        my $res = $self->_post($self->{'new-authz'}, {resource => 'new-authz', identifier => {type => 'dns', value => $_}, existing => 'accept'});
@@ -466,7 +507,7 @@ sub authorize {
                        }
 
                        # Decode content
                        }
 
                        # Decode content
-                       $content = decode_json($res->content);
+                       $content = from_json($res->content);
 
                        # Check domain
                        unless (defined $content->{identifier}{value} && $content->{identifier}{value} eq $_) {
 
                        # Check domain
                        unless (defined $content->{identifier}{value} && $content->{identifier}{value} eq $_) {
@@ -479,7 +520,7 @@ sub authorize {
                        }
 
                        # Write to file
                        }
 
                        # Write to file
-                       write_file($file, encode_json($content));
+                       write_file($file, to_json($content));
                }
 
                # Add challenge
                }
 
                # Add challenge
@@ -502,8 +543,8 @@ sub authorize {
                                } elsif ($challenge->{status} eq 'pending') {
                                        # Handle check
                                        if (
                                } elsif ($challenge->{status} eq 'pending') {
                                        # Handle check
                                        if (
-                                               ($challenge->{type} =~ /^http-[0-9]+$/ and $self->_httpCheck($_, $challenge->{token})) or
-                                               ($challenge->{type} =~ /^dns-[0-9]+$/ and $self->_dnsCheck($_, $challenge->{token}))
+                                               ($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}});
                                        ) {
                                                # Post challenge request
                                                my $res = $self->_post($challenge->{uri}, {resource => 'challenge', keyAuthorization => $challenge->{token}.'.'.$self->{account}{thumbprint}});
@@ -514,7 +555,7 @@ sub authorize {
                                                }
 
                                                # Extract content
                                                }
 
                                                # Extract content
-                                               my $content = decode_json($res->content);
+                                               my $content = from_json($res->content);
 
                                                # Save if valid
                                                if ($content->{status} eq 'valid') {
 
                                                # Save if valid
                                                if ($content->{status} eq 'valid') {
@@ -528,11 +569,18 @@ sub authorize {
                                                                poll => $content->{uri}
                                                        });
                                                }
                                                                poll => $content->{uri}
                                                        });
                                                }
-                                       # Print http help
-                                       } elsif ($challenge->{type} =~ /^http-[0-9]+$/) {
+                                       }
+                               }
+                       }
+                       # 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";
                                                print STDERR 'Create URI http://'.$_.'/.well-known/acme-challenge/'.$challenge->{token}.' with content '.$challenge->{token}.'.'.$self->{account}{thumbprint}."\n";
-                                       # Print dns help
-                                       } elsif ($challenge->{type} =~ /^dns-[0-9]+$/) {
+                                       # 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";
                                        }
                                }
                                                print STDERR 'Create TXT record _acme-challenge.'.$_.'. with value '.(((sha256_base64($challenge->{token}.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r)."\n";
                                        }
                                }
@@ -562,11 +610,11 @@ sub authorize {
 
                                # Handle error
                                unless ($res->is_success) {
 
                                # Handle error
                                unless ($res->is_success) {
-                                       carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($_debug);
+                                       carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($self->{debug});
                                }
 
                                # Extract content
                                }
 
                                # Extract content
-                               my $content = decode_json($res->content);
+                               my $content = from_json($res->content);
 
                                # Save status
                                if ($content->{status} ne 'pending') {
 
                                # Save status
                                if ($content->{status} ne 'pending') {
@@ -576,6 +624,25 @@ sub authorize {
                } map { $self->{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{challenges}};
        } 
 
                } 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 
        # Stop here with remaining chanllenge
        if (scalar map { ! defined $_->{status} or $_->{status} ne 'valid' ? 1 : (); } values %{$self->{challenges}}) {
                # Deactivate all activated domains 
@@ -585,14 +652,14 @@ sub authorize {
                #       my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'authz', status => 'deactivated'});
                #       # Handle error
                #       unless ($res->is_success) {
                #       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
                #               confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line;
                #       }
                #} map { $self->{challenges}{$_}{status} eq 'valid' ? $_ : () } keys %{$self->{challenges}};
 
                # Stop here as a domain of csr list failed authorization
-               if ($_debug) {
-                       confess 'Fix the challenges for domains: '.join(', ', map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}});
+               if ($self->{debug}) {
+                       my @domains = map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}};
+                       confess 'Fix the challenge'.(scalar @domains > 1?'s':'').' for domain'.(scalar @domains > 1?'s':'').': '.join(', ', @domains);
                } else {
                        exit EXIT_FAILURE;
                }
                } else {
                        exit EXIT_FAILURE;
                }
@@ -634,7 +701,7 @@ sub issue {
 
        # Handle error
        unless ($res->is_success) {
 
        # Handle error
        unless ($res->is_success) {
-               carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($_debug);
+               carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($self->{debug});
        }
 
        # Append content
        }
 
        # Append content
@@ -644,7 +711,7 @@ sub issue {
        close($fh) or die $!;
 
        # Print success
        close($fh) or die $!;
 
        # Print success
-       carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($_debug);
+       carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($self->{debug});
 }
 
 1;
 }
 
 1;
Letsencrypt perl client