]>
Raphaƫl G. Git Repositories - acme/blob - acme.pm
10 our @ISA = qw(Exporter) ;
13 use Carp
qw(carp confess) ;
14 use Date
:: Parse
qw(str2time) ;
16 use Digest
:: SHA
qw(sha256_base64) ;
18 use File
:: Path
qw(make_path) ;
19 use File
:: Slurp
qw(read_file write_file) ;
20 use File
:: Temp
; # qw( :seekable );
21 use IPC
:: System
:: Simple
qw(capturex) ;
22 use JSON
qw(encode_json decode_json) ;
24 use MIME
:: Base64
qw(encode_base64url encode_base64) ;
27 use POSIX
qw(EXIT_FAILURE) ;
33 #XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
34 #XXX: see jwk rfc http://www.rfc-editor.org/rfc/rfc7517.txt
35 #XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js
42 # Directory for certificates
48 # Directory for pending cache
49 PENDING_DIR
=> 'pending' ,
51 # Request certificate file name
52 REQUEST_CSR
=> 'request.der' ,
54 # Account key file name
55 ACCOUNT_KEY
=> 'account.pem' ,
58 SERVER_KEY
=> 'server.pem' ,
60 # Server public certificate
61 SERVER_CRT
=> 'server.crt' ,
70 ACME_CERT
=> 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem' ,
71 ACME_DIR
=> 'https://acme-staging.api.letsencrypt.org/directory' ,
72 ACME_PROD_DIR
=> 'https://acme-v01.api.letsencrypt.org/directory' ,
73 ACME_TERMS
=> 'https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf' ,
89 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
98 # kty => uc(KEY_TYPE),
103 # thumbprint => undef
105 tie
( our %jwk , 'Tie::IxHash' , pubkey
=> undef , jwk
=> undef , thumbprint
=> undef );
106 tie
(%{ $jwk { jwk
}}, 'Tie::IxHash' , alg
=> 'RS256' , jwk
=> undef );
107 #XXX: strict ordering only really needed here for thumbprint sha256 digest
108 tie
(%{ $jwk { jwk
}{ jwk
}}, 'Tie::IxHash' , e
=> undef , kty
=> uc ( KEY_TYPE
), n
=> undef );
113 my ( $class , $mail , @domains ) = @_ ;
118 # Link self to package
119 bless ( $self , $class );
121 # Add extra check to mail validity
122 #XXX: mxcheck fail if there is only a A record on the domain
123 my $ev = Email
:: Valid-
> new (- fqdn
=> 1 , - tldcheck
=> 1 , - mxcheck
=> 1 );
125 # Show error if check fail
126 if (! defined $ev -> address ( $mail )) {
127 map { carp
'failed check: ' . $_ if ( $_debug ) } $ev -> details ();
128 confess
'Email::Valid->address failed' ;
132 $self ->{ mail
} = $mail ;
135 my $res = new Net
:: DNS
:: Resolver
();
142 unless (( $tld ) = $_ =~ m/\.(\w+)$/ ) {
143 confess
$_ . ' \' s tld extraction failed' ;
146 # Check if tld exists
147 unless ( Net
:: Domain
:: TLD
:: tld_exists
( $tld )) {
148 confess
$tld . ' tld from ' . $_ . ' don \' t exists' ;
151 # Check if we get dns answer
152 #XXX: only search A type because letsencrypt don't support ipv6 (AAAA) yet
153 unless ( my $rep = $res -> search ( $_ , 'A' )) {
154 confess
'search A record for ' . $_ . ' failed' ;
156 unless ( scalar map { $_ -> type eq 'A' ? 1 : (); } $rep -> answer ) {
157 confess
'search recursively A record for ' . $_ . ' failed' ;
163 @{ $self ->{ domains
}} = @domains ;
165 # Return class reference
169 # Prepare environement
171 my ( $self , $prod ) = @_ ;
174 make_path
( CERT_DIR
, KEY_DIR
, PENDING_DIR
. '/' . $self ->{ mail
}. '.' .( $prod ? 'prod' : 'staging' ), { error
=> \
my $err });
177 my ( $file , $msg ) = %$_ ;
178 carp
( $file eq '' ? '' : $file . ': ' ). $msg if ( $_debug );
180 confess
'make_path failed' ;
184 $ua = LWP
:: UserAgent-
> new ;
185 $ua -> agent ( __PACKAGE__
. '/' . VERSION
)
191 open ( $_stderr , '>&STDERR' ) or die $! ;
193 close ( STDERR
) or die $! ;
195 open ( STDERR
, '>' , '/dev/null' ) or die $! ;
203 open ( STDERR
, '>&' , $_stderr ) or die $! ;
206 # Generate required keys
210 # Generate account and server key if required
212 # Check key existence
217 #XXX: we drop stderr here because openssl can't be quiet on this command
218 capturex
( 'openssl' , ( 'genrsa' , '-out' , $_ , KEY_SIZE
));
222 } ( KEY_DIR
. DS
. ACCOUNT_KEY
, KEY_DIR
. DS
. SERVER_KEY
);
224 # Extract modulus and publicExponent jwk
225 #XXX: same here we tie to keep ordering
226 tie
(%{ $self ->{ account
}}, 'Tie::IxHash' , %jwk );
228 if ( /^Modulus=([0-9A-F]+)$/ ) {
229 # Extract to binary from hex and convert to base64 url
230 $self ->{ account
}{ jwk
}{ jwk
}{ n
} = encode_base64url
( pack ( "H*" , $1 ) =~ s/^\0+//r );
231 } elsif ( /^publicExponent:\s([0-9]+)\s\(0x[0-1]+\)$/ ) {
232 # Extract to binary from int, trim leading zeros and convert to base64 url
233 chomp ( $self ->{ account
}{ jwk
}{ jwk
}{ e
} = encode_base64url
( pack ( "N" , $1 ) =~ s/^\0+//r ));
235 } capturex
( 'openssl' , ( 'rsa' , '-text' , '-in' , KEY_DIR
. DS
. ACCOUNT_KEY
, '-noout' , '-modulus' ));
239 # Extract account public key
240 $self ->{ account
}{ pubkey
} = join ( '' , map { chomp ; $_ ; } capturex
( 'openssl' , ( 'rsa' , '-in' , KEY_DIR
. DS
. ACCOUNT_KEY
, '-pubout' )));
245 #XXX: convert base64 to base64 url
246 $self ->{ account
}{ thumbprint
} = ( sha256_base64
( encode_json
( $self ->{ account
}{ jwk
}{ jwk
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
;
249 # Generate certificate request
253 # Openssl config template
254 my $oct = File
:: Temp-
> new ();
256 # Load template from data
257 map { s/__EMAIL_ADDRESS__/$self->{mail}/ ; s/__COMMON_NAME__/$self->{domains}[0]/ ; print $oct $_ ; } < DATA
>;
262 # Append domain names
264 map { print $oct 'DNS.' . $i++ . ' = ' . $_ . " \n " ; } @{ $self ->{ domains
}};
267 capturex
( 'openssl' , ( 'req' , '-new' , '-outform' , 'DER' , '-key' , KEY_DIR
. DS
. SERVER_KEY
, '-config' , $oct -> filename , '-out' , CERT_DIR
. DS
. REQUEST_CSR
));
275 my ( $self , $prod ) = @_ ;
281 my $dir = $prod ? ACME_PROD_DIR
: ACME_DIR
;
284 my $req = HTTP
:: Request-
> new ( GET
=> $dir . '?' . $time );
287 my $res = $ua -> request ( $req );
290 unless ( $res -> is_success ) {
291 confess
'GET ' . $dir . '?' . $time . ' failed: ' . $res -> status_line ;
295 $self ->{ nonce
} = $res -> headers ->{ 'replay-nonce' };
297 # Merge uris in self content
298 %$self = ( %$self , %{ decode_json
( $res -> content )});
303 my ( $self , $uri , $payload ) = @_ ;
306 my $protected = encode_base64url
( encode_json
({ nonce
=> $self ->{ nonce
}}));
309 $payload = encode_base64url
( encode_json
( $payload ));
312 my $stf = File
:: Temp-
> new ();
314 # Append protect.payload to stf
315 print $stf $protected . '.' . $payload ;
320 # Generate digest of stf
321 my $signature = encode_base64url
( join ( '' , capturex
( 'openssl' , ( 'dgst' , '-sha256' , '-binary' , '-sign' , KEY_DIR
. DS
. ACCOUNT_KEY
, $stf -> filename ))) =~ s/^\0+//r );
324 my $req = HTTP
:: Request-
> new ( POST
=> $uri );
326 # Set new-reg request content
327 $req -> content ( encode_json
({
328 header
=> $self ->{ account
}{ jwk
},
329 protected
=> $protected ,
331 signature
=> $signature
335 my $res = $ua -> request ( $req );
338 if ( defined $res -> headers ->{ 'replay-nonce' }) {
339 $self ->{ nonce
} = $res -> headers ->{ 'replay-nonce' };
346 # Resolve dns and check content
347 #XXX: see https://community.centminmod.com/threads/looks-like-letsencrypt-dns-01-is-ready.5845/#12 for example
349 my ( $self , $domain , $token ) = @_ ;
351 # Generate signature from content
352 my $signature = (( sha256_base64
( $token . '.' . $self ->{ account
}{ thumbprint
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
;
355 $domain = '_acme-challenge.' . $domain . '.' ;
358 my $res = new Net
:: DNS
:: Resolver
();
360 # Check if we get dns answer
361 unless ( my $rep = $res -> search ( $domain , 'TXT' )) {
362 carp
'TXT record search for ' . $domain . ' failed' if ( $_debug );
365 unless ( scalar map { $_ -> type eq 'TXT' && $_ -> txtdata =~ /^$signature$/ ? 1 : (); } $rep -> answer ) {
366 carp
'TXT record recursive search for ' . $domain . ' failed' if ( $_debug );
374 # Get uri and check content
376 my ( $self , $domain , $token ) = @_ ;
379 my $req = HTTP
:: Request-
> new ( GET
=> 'http://' . $domain . '/.well-known/acme-challenge/' . $token );
382 my $res = $ua -> request ( $req );
385 unless ( $res -> is_success ) {
386 carp
'GET http://' . $domain . '/.well-known/acme-challenge/' . $token . ' failed: ' . $res -> status_line if ( $_debug );
390 # Handle invalid content
391 unless ( $res -> content =~ /^$token.$self->{account}{thumbprint}\s*$/ ) {
392 carp
'GET http://' . $domain . '/.well-known/acme-challenge/' . $token . ' content match failed: /^' . $token . '.' . $self ->{ account
}{ thumbprint
}. '\s* $/ !~ ' . $res -> content if ( $_debug );
401 #XXX: see doc at https://ietf-wg-acme.github.io/acme/#rfc.section.6.3
405 # Post new-reg request
406 #XXX: contact array may contain a tel:+33612345678 for example
407 my $res = $self -> _post ( $self ->{ 'new-reg' }, { resource
=> 'new-reg' , contact
=> [ 'mailto:' . $self ->{ mail
}], agreement
=> ACME_TERMS
});
410 unless ( $res -> is_success || $res -> code eq 409 ) {
411 confess
'POST ' . $self ->{ 'new-reg' }. ' failed: ' . $res -> status_line ;
414 # Update mail informations
415 if ( $res -> code eq 409 ) {
416 # Save registration uri
417 $self ->{ 'reg' } = $res -> headers ->{ location
};
420 #XXX: contact array may contain a tel:+33612345678 for example
421 $res = $self -> _post ( $self ->{ 'reg' }, { resource
=> 'reg' , contact
=> [ 'mailto:' . $self ->{ mail
}]});
424 unless ( $res -> is_success ) {
425 confess
'POST ' . $self ->{ 'reg' }. ' failed: ' . $res -> status_line ;
432 my ( $self , $prod ) = @_ ;
434 # Create challenges hash
435 %{ $self ->{ challenges
}} = ();
440 # Create or load auth request for each domain
446 my $file = PENDING_DIR
. '/' . $self ->{ mail
}. '.' .( $prod ? 'prod' : 'staging' ). '/' . $_ ;
448 # Load auth request content or post a new one
449 #TODO: add more check on cache file ???
451 #XXX: use eval to workaround a fatal in decode_json
453 # Check that file exists
456 ( $content = read_file
( $file )) &&
458 ( $content = decode_json
( $content )) &&
460 ( DateTime-
> from_epoch ( epoch
=> str2time
( $content ->{ expires
})) >= DateTime-
> now ()-> add ( hours
=> 1 ))
463 # Post new-authz request
464 my $res = $self -> _post ( $self ->{ 'new-authz' }, { resource
=> 'new-authz' , identifier
=> { type
=> 'dns' , value
=> $_ }, existing
=> 'accept' });
467 unless ( $res -> is_success ) {
468 confess
'POST ' . $self ->{ 'new-authz' }. ' for ' . $_ . ' failed: ' . $res -> status_line ;
472 $content = decode_json
( $res -> content );
475 unless ( defined $content ->{ identifier
}{ value
} && $content ->{ identifier
}{ value
} eq $_ ) {
476 confess
'domain matching ' . $content ->{ identifier
}{ value
}. ' for ' . $_ . ' failed: ' . $res -> status_line ;
480 unless ( $content ->{ status
} eq 'valid' or $content ->{ status
} eq 'pending' ) {
481 confess
'POST ' . $self ->{ 'new-authz' }. ' for ' . $_ . ' failed: ' . $res -> status_line ;
485 write_file
( $file , encode_json
( $content ));
489 %{ $self ->{ challenges
}{ $_ }} = (
490 status
=> $content ->{ status
},
491 expires
=> $content ->{ expires
},
496 if ( $content ->{ status
} eq 'pending' ) {
497 # Extract validation data
498 foreach my $challenge (@{ $content ->{ challenges
}}) {
499 # One test already validated this auth request
500 if ( $self ->{ challenges
}{ $_ }{ status
} eq 'valid' ) {
502 } elsif ( $challenge ->{ status
} eq 'valid' ) {
503 $self ->{ challenges
}{ $_ }{ status
} = $challenge ->{ status
};
505 } elsif ( $challenge ->{ status
} eq 'pending' ) {
508 ( $challenge ->{ type
} =~ /^http-[0-9]+$/ and $self -> _httpCheck ( $_ , $challenge ->{ token
})) or
509 ( $challenge ->{ type
} =~ /^dns-[0-9]+$/ and $self -> _dnsCheck ( $_ , $challenge ->{ token
}))
511 # Post challenge request
512 my $res = $self -> _post ( $challenge ->{ uri
}, { resource
=> 'challenge' , keyAuthorization
=> $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
}});
515 unless ( $res -> is_success ) {
516 confess
'POST ' . $challenge ->{ uri
}. ' failed: ' . $res -> status_line ;
520 my $content = decode_json
( $res -> content );
523 if ( $content ->{ status
} eq 'valid' ) {
524 $self ->{ challenges
}{ $_ }{ status
} = $content ->{ status
};
525 # Check is still polling
526 } elsif ( $content ->{ status
} eq 'pending' ) {
527 # Add to poll list for later use
528 push (@{ $self ->{ challenges
}{ $_ }{ polls
}}, {
529 type
=> ( split ( /-/ , $challenge ->{ type
}))[ 0 ],
530 status
=> $content ->{ status
},
531 poll
=> $content ->{ uri
}
535 } elsif ( $challenge ->{ type
} =~ /^http-[0-9]+$/ ) {
536 print STDERR
'Create URI http://' . $_ . '/.well-known/acme-challenge/' . $challenge ->{ token
}. ' with content ' . $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
}. " \n " ;
538 } elsif ( $challenge ->{ type
} =~ /^dns-[0-9]+$/ ) {
539 print STDERR
'Create TXT record _acme-challenge.' . $_ . '. with value ' .((( sha256_base64
( $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
). " \n " ;
544 } @{ $self ->{ domains
}};
550 while (-- $remaining >= 0 and scalar map { $_ ->{ status
} eq 'valid' ? 1 : (); } values %{ $self ->{ challenges
}}) {
553 # Poll remaining pending
558 # Poll remaining polls
561 my $req = HTTP
:: Request-
> new ( GET
=> $_ ->{ poll
});
564 my $res = $ua -> request ( $req );
567 unless ( $res -> is_success ) {
568 carp
'GET ' . $self ->{ challenges
}{ $_ }{ http_challenge
}. ' failed: ' . $res -> status_line if ( $_debug );
572 my $content = decode_json
( $res -> content );
575 if ( $content ->{ status
} ne 'pending' ) {
576 $self ->{ challenges
}{ $domain }{ status
} = $content ->{ status
};
578 } @{ $self ->{ challenges
}{ $_ }{ polls
}};
579 } map { $self ->{ challenges
}{ $_ }{ status
} eq 'pending' ? $_ : (); } keys %{ $self ->{ challenges
}};
582 # Stop here with remaining chanllenge
583 if ( scalar map { ! defined $_ ->{ status
} or $_ ->{ status
} ne 'valid' ? 1 : (); } values %{ $self ->{ challenges
}}) {
584 # Deactivate all activated domains
585 #XXX: not implemented by letsencrypt
587 # # Post deactivation request
588 # my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'authz', status => 'deactivated'});
590 # unless ($res->is_success) {
591 # print Dumper($res);
592 # confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line;
594 #} map { $self->{challenges}{$_}{status} eq 'valid' ? $_ : () } keys %{$self->{challenges}};
596 # Stop here as a domain of csr list failed authorization
598 confess
'Fix the challenges for domains: ' . join ( ', ' , map { ! defined $self ->{ challenges
}{ $_ }{ status
} or $self ->{ challenges
}{ $_ }{ status
} ne 'valid' ? $_ : (); } keys %{ $self ->{ challenges
}});
610 open ( my $fh , '<' , CERT_DIR
. DS
. REQUEST_CSR
) or die $! ;
613 my $csr = encode_base64url
( join ( '' , < $fh >) =~ s/^\0+//r );
616 close ( $fh ) or die $! ;
618 # Post certificate request
619 my $res = $self -> _post ( $self ->{ 'new-cert' }, { resource
=> 'new-cert' , csr
=> $csr });
622 unless ( $res -> is_success ) {
624 confess
'POST ' . $self ->{ 'new-cert' }. ' failed: ' . $res -> status_line ;
628 open ( $fh , '>' , CERT_DIR
. DS
. SERVER_CRT
) or die $! ;
631 print $fh '-----BEGIN CERTIFICATE-----' . " \n " . encode_base64
( $res -> content ). '-----END CERTIFICATE-----' . " \n " ;
634 my $req = HTTP
:: Request-
> new ( GET
=> ACME_CERT
);
637 $res = $ua -> request ( $req );
640 unless ( $res -> is_success ) {
641 carp
'GET ' . ACME_CERT
. ' failed: ' . $res -> status_line if ( $_debug );
645 print $fh $res -> content ;
648 close ( $fh ) or die $! ;
651 carp
'Success, pem certificate in ' . CERT_DIR
. DS
. SERVER_CRT
if ( $_debug );
658 # OpenSSL configuration file.
659 # This is mostly being used for generation of certificate requests.
666 distinguished_name
= req_distinguished_name
667 # The extentions to add to the self signed cert
668 x509_extensions
= v3_ca
669 # The extensions to add to a certificate request
670 req_extensions
= v3_req
672 # This sets a mask for permitted string types. There are several options.
673 # utf8only: only UTF8Strings (PKIX recommendation after 2004).
674 # WARNING: ancient versions of Netscape crash on BMPStrings or UTF8Strings.
675 string_mask
= utf8only
677 [ req_distinguished_name
]
679 stateOrProvinceName
= State
or Province Name
680 localityName
= Locality Name
681 organizationName
= Organization Name
682 organizationalUnitName
= Organizational Unit Name
683 commonName
= __COMMON_NAME__
684 emailAddress
= __EMAIL_ADDRESS__
687 basicConstraints
= CA
: false
688 keyUsage
= nonRepudiation
, digitalSignature
, keyEncipherment
689 subjectAltName
= email
: move
690 subjectAltName
= @alt_names
693 subjectKeyIdentifier
= hash
694 authorityKeyIdentifier
= keyid
: always
, issuer
695 basicConstraints
= CA
: true