]>
Raphaƫl G. Git Repositories - acme/blob - acme.pm
6a17c3c04b2ab1d379a83acebf9b9775d1534b12
10 our @ISA = qw(Exporter) ;
11 our @EXPORT_OK = qw(DS CERT_DIR KEY_DIR REQUEST_CSR ACCOUNT_KEY SERVER_KEY SERVER_CRT CONFIG) ;
14 use Carp
qw(carp confess) ;
16 use Date
:: Parse
qw(str2time) ;
17 use Digest
:: SHA
qw(sha256_base64) ;
19 use File
:: Path
qw(make_path) ;
20 use File
:: Slurp
qw(read_file write_file) ;
21 use File
:: Temp
; # qw( :seekable );
22 use IPC
:: System
:: Simple
qw(capturex) ;
23 use JSON
qw(encode_json decode_json) ;
25 use MIME
:: Base64
qw(encode_base64url encode_base64) ;
27 use POSIX
qw(EXIT_FAILURE) ;
31 #XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
32 #XXX: see jwk rfc http://www.rfc-editor.org/rfc/rfc7517.txt
33 #XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js
40 # Directory for certificates
46 # Directory for pending cache
47 PENDING_DIR
=> 'pending' ,
49 # Request certificate file name
50 REQUEST_CSR
=> 'request.der' ,
52 # Account key file name
53 ACCOUNT_KEY
=> 'account.pem' ,
56 SERVER_KEY
=> 'server.pem' ,
58 # Server public certificate
59 SERVER_CRT
=> 'server.crt' ,
68 ACME_CERT
=> 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem' ,
69 ACME_DIR
=> 'https://acme-staging.api.letsencrypt.org/directory' ,
70 ACME_PROD_DIR
=> 'https://acme-v01.api.letsencrypt.org/directory' ,
71 ACME_TERMS
=> 'https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf' ,
77 CONFIG
=> '/etc/acmepl/config'
87 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
96 # kty => uc(KEY_TYPE),
101 # thumbprint => undef
103 tie
( our %jwk , 'Tie::IxHash' , pubkey
=> undef , jwk
=> undef , thumbprint
=> undef );
104 tie
(%{ $jwk { jwk
}}, 'Tie::IxHash' , alg
=> 'RS256' , jwk
=> undef );
105 #XXX: strict ordering only really needed here for thumbprint sha256 digest
106 tie
(%{ $jwk { jwk
}{ jwk
}}, 'Tie::IxHash' , e
=> undef , kty
=> uc ( KEY_TYPE
), n
=> undef );
111 my ( $class , $mail , $debug , $prod , @domains ) = @_ ;
116 # Link self to package
117 bless ( $self , $class );
120 $self ->{ debug
} = $debug ;
123 $self ->{ prod
} = $prod ;
125 # Add extra check to mail validity
126 #XXX: mxcheck fail if there is only a A record on the domain
127 my $ev = Email
:: Valid-
> new (- fqdn
=> 1 , - tldcheck
=> 1 , - mxcheck
=> 1 );
129 # Show error if check fail
130 if (! defined $ev -> address ( $mail )) {
131 map { carp
'failed check: ' . $_ if ( $self ->{ debug
}) } $ev -> details ();
132 confess
'Email::Valid->address failed' ;
136 $self ->{ mail
} = $mail ;
139 my $res = new Net
:: DNS
:: Resolver
();
146 unless (( $tld ) = $_ =~ m/\.(\w+)$/ ) {
147 confess
$_ . ' \' s tld extraction failed' ;
150 # Check if tld exists
151 unless ( Net
:: Domain
:: TLD
:: tld_exists
( $tld )) {
152 confess
$tld . ' tld from ' . $_ . ' don \' t exists' ;
155 # Check if we get dns answer
156 #XXX: only search A type because letsencrypt don't support ipv6 (AAAA) yet
157 unless ( my $rep = $res -> search ( $_ , 'A' )) {
158 confess
'search A record for ' . $_ . ' failed' ;
160 unless ( scalar map { $_ -> type eq 'A' ? 1 : (); } $rep -> answer ) {
161 confess
'search recursively A record for ' . $_ . ' failed' ;
167 @{ $self ->{ domains
}} = @domains ;
169 # Return class reference
173 # Prepare environement
178 make_path
( CERT_DIR
, KEY_DIR
, PENDING_DIR
. '/' . $self ->{ mail
}. '.' .( $self ->{ prod
} ? 'prod' : 'staging' ), { error
=> \
my $err });
181 my ( $file , $msg ) = %$_ ;
182 carp
( $file eq '' ? '' : $file . ': ' ). $msg if ( $self ->{ debug
});
184 confess
'make_path failed' ;
188 $ua = LWP
:: UserAgent-
> new ;
189 $ua -> agent ( __PACKAGE__
. '/' . VERSION
)
195 open ( $_stderr , '>&STDERR' ) or die $! ;
197 close ( STDERR
) or die $! ;
199 open ( STDERR
, '>' , '/dev/null' ) or die $! ;
207 open ( STDERR
, '>&' , $_stderr ) or die $! ;
210 # Generate required keys
214 # Generate account and server key if required
216 # Check key existence
221 #XXX: we drop stderr here because openssl can't be quiet on this command
222 capturex
( 'openssl' , ( 'genrsa' , '-out' , $_ , KEY_SIZE
));
226 } ( KEY_DIR
. DS
. ACCOUNT_KEY
, KEY_DIR
. DS
. SERVER_KEY
);
228 # Extract modulus and publicExponent jwk
229 #XXX: same here we tie to keep ordering
230 tie
(%{ $self ->{ account
}}, 'Tie::IxHash' , %jwk );
232 if ( /^Modulus=([0-9A-F]+)$/ ) {
233 # Extract to binary from hex and convert to base64 url
234 $self ->{ account
}{ jwk
}{ jwk
}{ n
} = encode_base64url
( pack ( "H*" , $1 ) =~ s/^\0+//r );
235 } elsif ( /^publicExponent:\s([0-9]+)\s\(0x[0-1]+\)$/ ) {
236 # Extract to binary from int, trim leading zeros and convert to base64 url
237 chomp ( $self ->{ account
}{ jwk
}{ jwk
}{ e
} = encode_base64url
( pack ( "N" , $1 ) =~ s/^\0+//r ));
239 } capturex
( 'openssl' , ( 'rsa' , '-text' , '-in' , KEY_DIR
. DS
. ACCOUNT_KEY
, '-noout' , '-modulus' ));
243 # Extract account public key
244 $self ->{ account
}{ pubkey
} = join ( '' , map { chomp ; $_ ; } capturex
( 'openssl' , ( 'rsa' , '-in' , KEY_DIR
. DS
. ACCOUNT_KEY
, '-pubout' )));
249 #XXX: convert base64 to base64 url
250 $self ->{ account
}{ thumbprint
} = ( sha256_base64
( encode_json
( $self ->{ account
}{ jwk
}{ jwk
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
;
253 # Generate certificate request
257 # Openssl config template
258 my $oct = File
:: Temp-
> new ();
260 # Load template from data
261 map { s/__EMAIL_ADDRESS__/$self->{mail}/ ; s/__COMMON_NAME__/$self->{domains}[0]/ ; print $oct $_ ; } < DATA
>;
266 # Append domain names
268 map { print $oct 'DNS.' . $i++ . ' = ' . $_ . " \n " ; } @{ $self ->{ domains
}};
271 capturex
( 'openssl' , ( 'req' , '-new' , '-outform' , 'DER' , '-key' , KEY_DIR
. DS
. SERVER_KEY
, '-config' , $oct -> filename , '-out' , CERT_DIR
. DS
. REQUEST_CSR
));
285 my $dir = $self ->{ prod
} ? ACME_PROD_DIR
: ACME_DIR
;
288 my $req = HTTP
:: Request-
> new ( GET
=> $dir . '?' . $time );
291 my $res = $ua -> request ( $req );
294 unless ( $res -> is_success ) {
295 confess
'GET ' . $dir . '?' . $time . ' failed: ' . $res -> status_line ;
299 $self ->{ nonce
} = $res -> headers ->{ 'replay-nonce' };
301 # Merge uris in self content
302 %$self = ( %$self , %{ decode_json
( $res -> content )});
307 my ( $self , $uri , $payload ) = @_ ;
310 my $protected = encode_base64url
( encode_json
({ nonce
=> $self ->{ nonce
}}));
313 $payload = encode_base64url
( encode_json
( $payload ));
316 my $stf = File
:: Temp-
> new ();
318 # Append protect.payload to stf
319 print $stf $protected . '.' . $payload ;
324 # Generate digest of stf
325 my $signature = encode_base64url
( join ( '' , capturex
( 'openssl' , ( 'dgst' , '-sha256' , '-binary' , '-sign' , KEY_DIR
. DS
. ACCOUNT_KEY
, $stf -> filename ))) =~ s/^\0+//r );
328 my $req = HTTP
:: Request-
> new ( POST
=> $uri );
330 # Set new-reg request content
331 $req -> content ( encode_json
({
332 header
=> $self ->{ account
}{ jwk
},
333 protected
=> $protected ,
335 signature
=> $signature
339 my $res = $ua -> request ( $req );
342 if ( defined $res -> headers ->{ 'replay-nonce' }) {
343 $self ->{ nonce
} = $res -> headers ->{ 'replay-nonce' };
350 # Resolve dns and check content
351 #XXX: see https://community.centminmod.com/threads/looks-like-letsencrypt-dns-01-is-ready.5845/#12 for example
353 my ( $self , $domain , $token ) = @_ ;
355 # Generate signature from content
356 my $signature = (( sha256_base64
( $token . '.' . $self ->{ account
}{ thumbprint
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
;
359 $domain = '_acme-challenge.' . $domain . '.' ;
362 my $res = new Net
:: DNS
:: Resolver
();
364 # Check if we get dns answer
365 unless ( my $rep = $res -> search ( $domain , 'TXT' )) {
366 carp
'TXT record search for ' . $domain . ' failed' if ( $self ->{ debug
});
369 unless ( scalar map { $_ -> type eq 'TXT' && $_ -> txtdata =~ /^$signature$/ ? 1 : (); } $rep -> answer ) {
370 carp
'TXT record recursive search for ' . $domain . ' failed' if ( $self ->{ debug
});
378 # Get uri and check content
380 my ( $self , $domain , $token ) = @_ ;
383 my $req = HTTP
:: Request-
> new ( GET
=> 'http://' . $domain . '/.well-known/acme-challenge/' . $token );
385 # Load config if available
388 #XXX: use eval to workaround a fatal in decode_json
390 # Check that file exists
393 ( $config = read_file
( CONFIG
)) &&
395 ( $config = decode_json
( $config )) &&
397 $config ->{ thumbprint
}
400 # Try to write thumbprint
401 write_file
( $config ->{ thumbprint
}, $self ->{ account
}{ thumbprint
});
405 my $res = $ua -> request ( $req );
408 unless ( $res -> is_success ) {
409 carp
'GET http://' . $domain . '/.well-known/acme-challenge/' . $token . ' failed: ' . $res -> status_line if ( $self ->{ debug
});
413 # Handle invalid content
414 unless ( $res -> content =~ /^$token.$self->{account}{thumbprint}\s*$/ ) {
415 carp
'GET http://' . $domain . '/.well-known/acme-challenge/' . $token . ' content match failed: /^' . $token . '.' . $self ->{ account
}{ thumbprint
}. '\s* $/ !~ ' . $res -> content if ( $self ->{ debug
});
424 #XXX: see doc at https://ietf-wg-acme.github.io/acme/#rfc.section.6.3
428 # Post new-reg request
429 #XXX: contact array may contain a tel:+33612345678 for example
430 my $res = $self -> _post ( $self ->{ 'new-reg' }, { resource
=> 'new-reg' , contact
=> [ 'mailto:' . $self ->{ mail
}], agreement
=> ACME_TERMS
});
433 unless ( $res -> is_success || $res -> code eq 409 ) {
434 confess
'POST ' . $self ->{ 'new-reg' }. ' failed: ' . $res -> status_line ;
437 # Update mail informations
438 if ( $res -> code eq 409 ) {
439 # Save registration uri
440 $self ->{ 'reg' } = $res -> headers ->{ location
};
443 #XXX: contact array may contain a tel:+33612345678 for example
444 $res = $self -> _post ( $self ->{ 'reg' }, { resource
=> 'reg' , contact
=> [ 'mailto:' . $self ->{ mail
}]});
447 unless ( $res -> is_success ) {
448 confess
'POST ' . $self ->{ 'reg' }. ' failed: ' . $res -> status_line ;
457 # Create challenges hash
458 %{ $self ->{ challenges
}} = ();
463 # Create or load auth request for each domain
469 my $file = PENDING_DIR
. '/' . $self ->{ mail
}. '.' .( $self ->{ prod
} ? 'prod' : 'staging' ). '/' . $_ ;
471 # Load auth request content or post a new one
472 #TODO: add more check on cache file ???
474 #XXX: use eval to workaround a fatal in decode_json
476 # Check that file exists
479 ( $content = read_file
( $file )) &&
481 ( $content = decode_json
( $content ))
483 } || ( str2time
( $content ->{ expires
}) <= time ()+ 3600 )
485 # Post new-authz request
486 my $res = $self -> _post ( $self ->{ 'new-authz' }, { resource
=> 'new-authz' , identifier
=> { type
=> 'dns' , value
=> $_ }, existing
=> 'accept' });
489 unless ( $res -> is_success ) {
490 confess
'POST ' . $self ->{ 'new-authz' }. ' for ' . $_ . ' failed: ' . $res -> status_line ;
494 $content = decode_json
( $res -> content );
497 unless ( defined $content ->{ identifier
}{ value
} && $content ->{ identifier
}{ value
} eq $_ ) {
498 confess
'domain matching ' . $content ->{ identifier
}{ value
}. ' for ' . $_ . ' failed: ' . $res -> status_line ;
502 unless ( $content ->{ status
} eq 'valid' or $content ->{ status
} eq 'pending' ) {
503 confess
'POST ' . $self ->{ 'new-authz' }. ' for ' . $_ . ' failed: ' . $res -> status_line ;
507 write_file
( $file , encode_json
( $content ));
511 %{ $self ->{ challenges
}{ $_ }} = (
512 status
=> $content ->{ status
},
513 expires
=> $content ->{ expires
},
518 if ( $content ->{ status
} eq 'pending' ) {
519 # Extract validation data
520 foreach my $challenge (@{ $content ->{ challenges
}}) {
521 # One test already validated this auth request
522 if ( $self ->{ challenges
}{ $_ }{ status
} eq 'valid' ) {
524 } elsif ( $challenge ->{ status
} eq 'valid' ) {
525 $self ->{ challenges
}{ $_ }{ status
} = $challenge ->{ status
};
527 } elsif ( $challenge ->{ status
} eq 'pending' ) {
530 ( $challenge ->{ type
} =~ /^http-01$/ and $self -> _httpCheck ( $_ , $challenge ->{ token
})) or
531 ( $challenge ->{ type
} =~ /^dns-01$/ and $self -> _dnsCheck ( $_ , $challenge ->{ token
}))
533 # Post challenge request
534 my $res = $self -> _post ( $challenge ->{ uri
}, { resource
=> 'challenge' , keyAuthorization
=> $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
}});
537 unless ( $res -> is_success ) {
538 confess
'POST ' . $challenge ->{ uri
}. ' failed: ' . $res -> status_line ;
542 my $content = decode_json
( $res -> content );
545 if ( $content ->{ status
} eq 'valid' ) {
546 $self ->{ challenges
}{ $_ }{ status
} = $content ->{ status
};
547 # Check is still polling
548 } elsif ( $content ->{ status
} eq 'pending' ) {
549 # Add to poll list for later use
550 push (@{ $self ->{ challenges
}{ $_ }{ polls
}}, {
551 type
=> ( split ( /-/ , $challenge ->{ type
}))[ 0 ],
552 status
=> $content ->{ status
},
553 poll
=> $content ->{ uri
}
559 # Check if check is challenge still in pending and no polls
560 if ( $self ->{ challenges
}{ $_ }{ status
} eq 'pending' && scalar @{ $self ->{ challenges
}{ $_ }{ polls
}} == 0 ) {
561 # Loop on all remaining challenges
562 foreach my $challenge (@{ $content ->{ challenges
}}) {
563 # Display help for http-01 check
564 if ( $challenge ->{ type
} eq 'http-01' ) {
565 print STDERR
'Create URI http://' . $_ . '/.well-known/acme-challenge/' . $challenge ->{ token
}. ' with content ' . $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
}. " \n " ;
566 # Display help for dns-01 check
567 } elsif ( $challenge ->{ type
} eq 'dns-01' ) {
568 print STDERR
'Create TXT record _acme-challenge.' . $_ . '. with value ' .((( sha256_base64
( $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
). " \n " ;
573 } @{ $self ->{ domains
}};
579 while (-- $remaining >= 0 and scalar map { $_ ->{ status
} eq 'valid' ? 1 : (); } values %{ $self ->{ challenges
}}) {
582 # Poll remaining pending
587 # Poll remaining polls
590 my $req = HTTP
:: Request-
> new ( GET
=> $_ ->{ poll
});
593 my $res = $ua -> request ( $req );
596 unless ( $res -> is_success ) {
597 carp
'GET ' . $self ->{ challenges
}{ $_ }{ http_challenge
}. ' failed: ' . $res -> status_line if ( $self ->{ debug
});
601 my $content = decode_json
( $res -> content );
604 if ( $content ->{ status
} ne 'pending' ) {
605 $self ->{ challenges
}{ $domain }{ status
} = $content ->{ status
};
607 } @{ $self ->{ challenges
}{ $_ }{ polls
}};
608 } map { $self ->{ challenges
}{ $_ }{ status
} eq 'pending' ? $_ : (); } keys %{ $self ->{ challenges
}};
611 # Load config if available
614 #XXX: use eval to workaround a fatal in decode_json
616 # Check that file exists
619 ( $config = read_file
( CONFIG
)) &&
621 ( $config = decode_json
( $config )) &&
623 $config ->{ thumbprint
}
626 # Try to write thumbprint
627 write_file
( $config ->{ thumbprint
}, '' );
630 # Stop here with remaining chanllenge
631 if ( scalar map { ! defined $_ ->{ status
} or $_ ->{ status
} ne 'valid' ? 1 : (); } values %{ $self ->{ challenges
}}) {
632 # Deactivate all activated domains
633 #XXX: not implemented by letsencrypt
635 # # Post deactivation request
636 # my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'authz', status => 'deactivated'});
638 # unless ($res->is_success) {
639 # print Dumper($res);
640 # confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line;
642 #} map { $self->{challenges}{$_}{status} eq 'valid' ? $_ : () } keys %{$self->{challenges}};
644 # Stop here as a domain of csr list failed authorization
645 if ( $self ->{ debug
}) {
646 my @domains = map { ! defined $self ->{ challenges
}{ $_ }{ status
} or $self ->{ challenges
}{ $_ }{ status
} ne 'valid' ? $_ : (); } keys %{ $self ->{ challenges
}};
647 confess
'Fix the challenge' .( scalar @domains > 1 ? 's' : '' ). ' for domain' .( scalar @domains > 1 ? 's' : '' ). ': ' . join ( ', ' , @domains );
659 open ( my $fh , '<' , CERT_DIR
. DS
. REQUEST_CSR
) or die $! ;
662 my $csr = encode_base64url
( join ( '' , < $fh >) =~ s/^\0+//r );
665 close ( $fh ) or die $! ;
667 # Post certificate request
668 my $res = $self -> _post ( $self ->{ 'new-cert' }, { resource
=> 'new-cert' , csr
=> $csr });
671 unless ( $res -> is_success ) {
673 confess
'POST ' . $self ->{ 'new-cert' }. ' failed: ' . $res -> status_line ;
677 open ( $fh , '>' , CERT_DIR
. DS
. SERVER_CRT
) or die $! ;
680 print $fh '-----BEGIN CERTIFICATE-----' . " \n " . encode_base64
( $res -> content ). '-----END CERTIFICATE-----' . " \n " ;
683 my $req = HTTP
:: Request-
> new ( GET
=> ACME_CERT
);
686 $res = $ua -> request ( $req );
689 unless ( $res -> is_success ) {
690 carp
'GET ' . ACME_CERT
. ' failed: ' . $res -> status_line if ( $self ->{ debug
});
694 print $fh $res -> content ;
697 close ( $fh ) or die $! ;
700 carp
'Success, pem certificate in ' . CERT_DIR
. DS
. SERVER_CRT
if ( $self ->{ debug
});
707 # OpenSSL configuration file.
708 # This is mostly being used for generation of certificate requests.
715 distinguished_name
= req_distinguished_name
716 # The extentions to add to the self signed cert
717 x509_extensions
= v3_ca
718 # The extensions to add to a certificate request
719 req_extensions
= v3_req
721 # This sets a mask for permitted string types. There are several options.
722 # utf8only: only UTF8Strings (PKIX recommendation after 2004).
723 # WARNING: ancient versions of Netscape crash on BMPStrings or UTF8Strings.
724 string_mask
= utf8only
726 [ req_distinguished_name
]
728 stateOrProvinceName
= State
or Province Name
729 localityName
= Locality Name
730 organizationName
= Organization Name
731 organizationalUnitName
= Organizational Unit Name
732 commonName
= __COMMON_NAME__
733 emailAddress
= __EMAIL_ADDRESS__
736 basicConstraints
= CA
: false
737 keyUsage
= nonRepudiation
, digitalSignature
, keyEncipherment
738 subjectAltName
= email
: move
739 subjectAltName
= @alt_names
742 subjectKeyIdentifier
= hash
743 authorityKeyIdentifier
= keyid
: always
, issuer
744 basicConstraints
= CA
: true