]>
Raphaƫl G. Git Repositories - acme/blob - acme.pm
b3629f913cf3de54e0672c2a203a0e65e1dd1339
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) ;
30 #XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
31 #XXX: see jwk rfc http://www.rfc-editor.org/rfc/rfc7517.txt
32 #XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js
39 # Directory for certificates
45 # Directory for pending cache
46 PENDING_DIR
=> 'pending' ,
48 # Request certificate file name
49 REQUEST_CSR
=> 'request.der' ,
51 # Account key file name
52 ACCOUNT_KEY
=> 'account.pem' ,
55 SERVER_KEY
=> 'server.pem' ,
57 # Server public certificate
58 SERVER_CRT
=> 'server.crt' ,
67 ACME_CERT
=> 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem' ,
68 ACME_DIR
=> 'https://acme-staging.api.letsencrypt.org/directory' ,
69 ACME_PROD_DIR
=> 'https://acme-v01.api.letsencrypt.org/directory' ,
70 ACME_TERMS
=> 'https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf' ,
86 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
95 # kty => uc(KEY_TYPE),
100 # thumbprint => undef
102 tie
( our %jwk , 'Tie::IxHash' , pubkey
=> undef , jwk
=> undef , thumbprint
=> undef );
103 tie
(%{ $jwk { jwk
}}, 'Tie::IxHash' , alg
=> 'RS256' , jwk
=> undef );
104 #XXX: strict ordering only really needed here for thumbprint sha256 digest
105 tie
(%{ $jwk { jwk
}{ jwk
}}, 'Tie::IxHash' , e
=> undef , kty
=> uc ( KEY_TYPE
), n
=> undef );
110 my ( $class , $mail , @domains ) = @_ ;
115 # Link self to package
116 bless ( $self , $class );
118 # Add extra check to mail validity
119 #XXX: mxcheck fail if there is only a A record on the domain
120 my $ev = Email
:: Valid-
> new (- fqdn
=> 1 , - tldcheck
=> 1 , - mxcheck
=> 1 );
122 # Show error if check fail
123 if (! defined $ev -> address ( $mail )) {
124 map { carp
'failed check: ' . $_ if ( $_debug ) } $ev -> details ();
125 confess
'Email::Valid->address failed' ;
129 $self ->{ mail
} = $mail ;
132 my $res = new Net
:: DNS
:: Resolver
();
139 unless (( $tld ) = $_ =~ m/\.(\w+)$/ ) {
140 confess
$_ . ' \' s tld extraction failed' ;
143 # Check if tld exists
144 unless ( Net
:: Domain
:: TLD
:: tld_exists
( $tld )) {
145 confess
$tld . ' tld from ' . $_ . ' don \' t exists' ;
148 # Check if we get dns answer
149 #XXX: only search A type because letsencrypt don't support ipv6 (AAAA) yet
150 unless ( my $rep = $res -> search ( $_ , 'A' )) {
151 confess
'search A record for ' . $_ . ' failed' ;
153 unless ( scalar map { $_ -> type eq 'A' ? 1 : (); } $rep -> answer ) {
154 confess
'search recursively A record for ' . $_ . ' failed' ;
160 @{ $self ->{ domains
}} = @domains ;
162 # Return class reference
166 # Prepare environement
168 my ( $self , $prod ) = @_ ;
171 make_path
( CERT_DIR
, KEY_DIR
, PENDING_DIR
. '/' . $self ->{ mail
}. '.' .( $prod ? 'prod' : 'staging' ), { error
=> \
my $err });
174 my ( $file , $msg ) = %$_ ;
175 carp
( $file eq '' ? '' : $file . ': ' ). $msg if ( $_debug );
177 confess
'make_path failed' ;
181 $ua = LWP
:: UserAgent-
> new ;
182 $ua -> agent ( __PACKAGE__
. '/' . VERSION
)
188 open ( $_stderr , '>&STDERR' ) or die $! ;
190 close ( STDERR
) or die $! ;
192 open ( STDERR
, '>' , '/dev/null' ) or die $! ;
200 open ( STDERR
, '>&' , $_stderr ) or die $! ;
203 # Generate required keys
207 # Generate account and server key if required
209 # Check key existence
214 #XXX: we drop stderr here because openssl can't be quiet on this command
215 capturex
( 'openssl' , ( 'genrsa' , '-out' , $_ , KEY_SIZE
));
219 } ( KEY_DIR
. DS
. ACCOUNT_KEY
, KEY_DIR
. DS
. SERVER_KEY
);
221 # Extract modulus and publicExponent jwk
222 #XXX: same here we tie to keep ordering
223 tie
(%{ $self ->{ account
}}, 'Tie::IxHash' , %jwk );
225 if ( /^Modulus=([0-9A-F]+)$/ ) {
226 # Extract to binary from hex and convert to base64 url
227 $self ->{ account
}{ jwk
}{ jwk
}{ n
} = encode_base64url
( pack ( "H*" , $1 ) =~ s/^\0+//r );
228 } elsif ( /^publicExponent:\s([0-9]+)\s\(0x[0-1]+\)$/ ) {
229 # Extract to binary from int, trim leading zeros and convert to base64 url
230 chomp ( $self ->{ account
}{ jwk
}{ jwk
}{ e
} = encode_base64url
( pack ( "N" , $1 ) =~ s/^\0+//r ));
232 } capturex
( 'openssl' , ( 'rsa' , '-text' , '-in' , KEY_DIR
. DS
. ACCOUNT_KEY
, '-noout' , '-modulus' ));
236 # Extract account public key
237 $self ->{ account
}{ pubkey
} = join ( '' , map { chomp ; $_ ; } capturex
( 'openssl' , ( 'rsa' , '-in' , KEY_DIR
. DS
. ACCOUNT_KEY
, '-pubout' )));
242 #XXX: convert base64 to base64 url
243 $self ->{ account
}{ thumbprint
} = ( sha256_base64
( encode_json
( $self ->{ account
}{ jwk
}{ jwk
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
;
246 # Generate certificate request
250 # Openssl config template
251 my $oct = File
:: Temp-
> new ();
253 # Load template from data
254 map { s/__EMAIL_ADDRESS__/$self->{mail}/ ; s/__COMMON_NAME__/$self->{domains}[0]/ ; print $oct $_ ; } < DATA
>;
259 # Append domain names
261 map { print $oct 'DNS.' . $i++ . ' = ' . $_ . " \n " ; } @{ $self ->{ domains
}};
264 capturex
( 'openssl' , ( 'req' , '-new' , '-outform' , 'DER' , '-key' , KEY_DIR
. DS
. SERVER_KEY
, '-config' , $oct -> filename , '-out' , CERT_DIR
. DS
. REQUEST_CSR
));
272 my ( $self , $prod ) = @_ ;
278 my $dir = $prod ? ACME_PROD_DIR
: ACME_DIR
;
281 my $req = HTTP
:: Request-
> new ( GET
=> $dir . '?' . $time );
284 my $res = $ua -> request ( $req );
287 unless ( $res -> is_success ) {
288 confess
'GET ' . $dir . '?' . $time . ' failed: ' . $res -> status_line ;
292 $self ->{ nonce
} = $res -> headers ->{ 'replay-nonce' };
294 # Merge uris in self content
295 %$self = ( %$self , %{ decode_json
( $res -> content )});
300 my ( $self , $uri , $payload ) = @_ ;
303 my $protected = encode_base64url
( encode_json
({ nonce
=> $self ->{ nonce
}}));
306 $payload = encode_base64url
( encode_json
( $payload ));
309 my $stf = File
:: Temp-
> new ();
311 # Append protect.payload to stf
312 print $stf $protected . '.' . $payload ;
317 # Generate digest of stf
318 my $signature = encode_base64url
( join ( '' , capturex
( 'openssl' , ( 'dgst' , '-sha256' , '-binary' , '-sign' , KEY_DIR
. DS
. ACCOUNT_KEY
, $stf -> filename ))) =~ s/^\0+//r );
321 my $req = HTTP
:: Request-
> new ( POST
=> $uri );
323 # Set new-reg request content
324 $req -> content ( encode_json
({
325 header
=> $self ->{ account
}{ jwk
},
326 protected
=> $protected ,
328 signature
=> $signature
332 my $res = $ua -> request ( $req );
335 if ( defined $res -> headers ->{ 'replay-nonce' }) {
336 $self ->{ nonce
} = $res -> headers ->{ 'replay-nonce' };
343 # Resolve dns and check content
344 #XXX: see https://community.centminmod.com/threads/looks-like-letsencrypt-dns-01-is-ready.5845/#12 for example
346 my ( $self , $domain , $token ) = @_ ;
348 # Generate signature from content
349 my $signature = (( sha256_base64
( $token . '.' . $self ->{ account
}{ thumbprint
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
;
352 $domain = '_acme-challenge.' . $domain . '.' ;
355 my $res = new Net
:: DNS
:: Resolver
();
357 # Check if we get dns answer
358 unless ( my $rep = $res -> search ( $domain , 'TXT' )) {
359 carp
'TXT record search for ' . $domain . ' failed' if ( $_debug );
362 unless ( scalar map { $_ -> type eq 'TXT' && $_ -> txtdata =~ /^$signature$/ ? 1 : (); } $rep -> answer ) {
363 carp
'TXT record recursive search for ' . $domain . ' failed' if ( $_debug );
371 # Get uri and check content
373 my ( $self , $domain , $token ) = @_ ;
376 my $req = HTTP
:: Request-
> new ( GET
=> 'http://' . $domain . '/.well-known/acme-challenge/' . $token );
379 my $res = $ua -> request ( $req );
382 unless ( $res -> is_success ) {
383 carp
'GET http://' . $domain . '/.well-known/acme-challenge/' . $token . ' failed: ' . $res -> status_line if ( $_debug );
387 # Handle invalid content
388 unless ( $res -> content =~ /^$token.$self->{account}{thumbprint}\s*$/ ) {
389 carp
'GET http://' . $domain . '/.well-known/acme-challenge/' . $token . ' content match failed: /^' . $token . '.' . $self ->{ account
}{ thumbprint
}. '\s* $/ !~ ' . $res -> content if ( $_debug );
398 #XXX: see doc at https://ietf-wg-acme.github.io/acme/#rfc.section.6.3
402 # Post new-reg request
403 #XXX: contact array may contain a tel:+33612345678 for example
404 my $res = $self -> _post ( $self ->{ 'new-reg' }, { resource
=> 'new-reg' , contact
=> [ 'mailto:' . $self ->{ mail
}], agreement
=> ACME_TERMS
});
407 unless ( $res -> is_success || $res -> code eq 409 ) {
408 confess
'POST ' . $self ->{ 'new-reg' }. ' failed: ' . $res -> status_line ;
411 # Update mail informations
412 if ( $res -> code eq 409 ) {
413 # Save registration uri
414 $self ->{ 'reg' } = $res -> headers ->{ location
};
417 #XXX: contact array may contain a tel:+33612345678 for example
418 $res = $self -> _post ( $self ->{ 'reg' }, { resource
=> 'reg' , contact
=> [ 'mailto:' . $self ->{ mail
}]});
421 unless ( $res -> is_success ) {
422 confess
'POST ' . $self ->{ 'reg' }. ' failed: ' . $res -> status_line ;
429 my ( $self , $prod ) = @_ ;
431 # Create challenges hash
432 %{ $self ->{ challenges
}} = ();
437 # Create or load auth request for each domain
443 my $file = PENDING_DIR
. '/' . $self ->{ mail
}. '.' .( $prod ? 'prod' : 'staging' ). '/' . $_ ;
445 # Load auth request content or post a new one
446 #TODO: add more check on cache file ???
448 #XXX: use eval to workaround a fatal in decode_json
450 # Check that file exists
453 ( $content = read_file
( $file )) &&
455 ( $content = decode_json
( $content )) &&
457 ( DateTime-
> from_epoch ( epoch
=> str2time
( $content ->{ expires
})) >= DateTime-
> now ()-> add ( hours
=> 1 ))
460 # Post new-authz request
461 my $res = $self -> _post ( $self ->{ 'new-authz' }, { resource
=> 'new-authz' , identifier
=> { type
=> 'dns' , value
=> $_ }, existing
=> 'accept' });
464 unless ( $res -> is_success ) {
465 confess
'POST ' . $self ->{ 'new-authz' }. ' for ' . $_ . ' failed: ' . $res -> status_line ;
469 $content = decode_json
( $res -> content );
472 unless ( defined $content ->{ identifier
}{ value
} && $content ->{ identifier
}{ value
} eq $_ ) {
473 confess
'domain matching ' . $content ->{ identifier
}{ value
}. ' for ' . $_ . ' failed: ' . $res -> status_line ;
477 unless ( $content ->{ status
} eq 'valid' or $content ->{ status
} eq 'pending' ) {
478 confess
'POST ' . $self ->{ 'new-authz' }. ' for ' . $_ . ' failed: ' . $res -> status_line ;
482 write_file
( $file , encode_json
( $content ));
486 %{ $self ->{ challenges
}{ $_ }} = (
487 status
=> $content ->{ status
},
488 expires
=> $content ->{ expires
},
493 if ( $content ->{ status
} eq 'pending' ) {
494 # Extract validation data
495 foreach my $challenge (@{ $content ->{ challenges
}}) {
496 # One test already validated this auth request
497 if ( $self ->{ challenges
}{ $_ }{ status
} eq 'valid' ) {
499 } elsif ( $challenge ->{ status
} eq 'valid' ) {
500 $self ->{ challenges
}{ $_ }{ status
} = $challenge ->{ status
};
502 } elsif ( $challenge ->{ status
} eq 'pending' ) {
505 ( $challenge ->{ type
} =~ /^http-[0-9]+$/ and $self -> _httpCheck ( $_ , $challenge ->{ token
})) or
506 ( $challenge ->{ type
} =~ /^dns-[0-9]+$/ and $self -> _dnsCheck ( $_ , $challenge ->{ token
}))
508 # Post challenge request
509 my $res = $self -> _post ( $challenge ->{ uri
}, { resource
=> 'challenge' , keyAuthorization
=> $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
}});
512 unless ( $res -> is_success ) {
513 confess
'POST ' . $challenge ->{ uri
}. ' failed: ' . $res -> status_line ;
517 my $content = decode_json
( $res -> content );
520 if ( $content ->{ status
} eq 'valid' ) {
521 $self ->{ challenges
}{ $_ }{ status
} = $content ->{ status
};
522 # Check is still polling
523 } elsif ( $content ->{ status
} eq 'pending' ) {
524 # Add to poll list for later use
525 push (@{ $self ->{ challenges
}{ $_ }{ polls
}}, {
526 type
=> ( split ( /-/ , $challenge ->{ type
}))[ 0 ],
527 status
=> $content ->{ status
},
528 poll
=> $content ->{ uri
}
532 } elsif ( $challenge ->{ type
} =~ /^http-[0-9]+$/ ) {
533 print STDERR
'Create URI http://' . $_ . '/.well-known/acme-challenge/' . $challenge ->{ token
}. ' with content ' . $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
}. " \n " ;
535 } elsif ( $challenge ->{ type
} =~ /^dns-[0-9]+$/ ) {
536 print STDERR
'Create TXT record _acme-challenge.' . $_ . '. with value ' .((( sha256_base64
( $challenge ->{ token
}. '.' . $self ->{ account
}{ thumbprint
})) =~ s/=+\z//r ) =~ tr
[+/][- _
] r
). " \n " ;
541 } @{ $self ->{ domains
}};
547 while (-- $remaining >= 0 and scalar map { $_ ->{ status
} eq 'valid' ? 1 : (); } values %{ $self ->{ challenges
}}) {
550 # Poll remaining pending
555 # Poll remaining polls
558 my $req = HTTP
:: Request-
> new ( GET
=> $_ ->{ poll
});
561 my $res = $ua -> request ( $req );
564 unless ( $res -> is_success ) {
565 carp
'GET ' . $self ->{ challenges
}{ $_ }{ http_challenge
}. ' failed: ' . $res -> status_line if ( $_debug );
569 my $content = decode_json
( $res -> content );
572 if ( $content ->{ status
} ne 'pending' ) {
573 $self ->{ challenges
}{ $domain }{ status
} = $content ->{ status
};
575 } @{ $self ->{ challenges
}{ $_ }{ polls
}};
576 } map { $self ->{ challenges
}{ $_ }{ status
} eq 'pending' ? $_ : (); } keys %{ $self ->{ challenges
}};
579 # Stop here with remaining chanllenge
580 if ( scalar map { ! defined $_ ->{ status
} or $_ ->{ status
} ne 'valid' ? 1 : (); } values %{ $self ->{ challenges
}}) {
581 # Deactivate all activated domains
582 #XXX: not implemented by letsencrypt
584 # # Post deactivation request
585 # my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'authz', status => 'deactivated'});
587 # unless ($res->is_success) {
588 # print Dumper($res);
589 # confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line;
591 #} map { $self->{challenges}{$_}{status} eq 'valid' ? $_ : () } keys %{$self->{challenges}};
593 # Stop here as a domain of csr list failed authorization
595 confess
'Fix the challenges for domains: ' . join ( ', ' , map { ! defined $self ->{ challenges
}{ $_ }{ status
} or $self ->{ challenges
}{ $_ }{ status
} ne 'valid' ? $_ : (); } keys %{ $self ->{ challenges
}});
607 open ( my $fh , '<' , CERT_DIR
. DS
. REQUEST_CSR
) or die $! ;
610 my $csr = encode_base64url
( join ( '' , < $fh >) =~ s/^\0+//r );
613 close ( $fh ) or die $! ;
615 # Post certificate request
616 my $res = $self -> _post ( $self ->{ 'new-cert' }, { resource
=> 'new-cert' , csr
=> $csr });
619 unless ( $res -> is_success ) {
620 confess
'POST ' . $self ->{ 'new-cert' }. ' failed: ' . $res -> status_line ;
624 open ( $fh , '>' , CERT_DIR
. DS
. SERVER_CRT
) or die $! ;
627 print $fh '-----BEGIN CERTIFICATE-----' . " \n " . encode_base64
( $res -> content ). '-----END CERTIFICATE-----' . " \n " ;
630 my $req = HTTP
:: Request-
> new ( GET
=> ACME_CERT
);
633 $res = $ua -> request ( $req );
636 unless ( $res -> is_success ) {
637 carp
'GET ' . ACME_CERT
. ' failed: ' . $res -> status_line if ( $_debug );
641 print $fh $res -> content ;
644 close ( $fh ) or die $! ;
647 carp
'Success, pem certificate in ' . CERT_DIR
. DS
. SERVER_CRT
if ( $_debug );
654 # OpenSSL configuration file.
655 # This is mostly being used for generation of certificate requests.
662 distinguished_name
= req_distinguished_name
663 # The extentions to add to the self signed cert
664 x509_extensions
= v3_ca
665 # The extensions to add to a certificate request
666 req_extensions
= v3_req
668 # This sets a mask for permitted string types. There are several options.
669 # utf8only: only UTF8Strings (PKIX recommendation after 2004).
670 # WARNING: ancient versions of Netscape crash on BMPStrings or UTF8Strings.
671 string_mask
= utf8only
673 [ req_distinguished_name
]
675 stateOrProvinceName
= State
or Province Name
676 localityName
= Locality Name
677 organizationName
= Organization Name
678 organizationalUnitName
= Organizational Unit Name
679 commonName
= __COMMON_NAME__
680 emailAddress
= __EMAIL_ADDRESS__
683 basicConstraints
= CA
: false
684 keyUsage
= nonRepudiation
, digitalSignature
, keyEncipherment
685 subjectAltName
= email
: move
686 subjectAltName
= @alt_names
689 subjectKeyIdentifier
= hash
690 authorityKeyIdentifier
= keyid
: always
, issuer
691 basicConstraints
= CA
: true