]>
Raphaƫl G. Git Repositories - acme/blob - acme.pm 
144222c8ccbe22c014103b2f1bdb7379d728d8b5
  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' ,   83  #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys   92  #                       kty => uc(KEY_TYPE),   99  tie
( our  %jwk ,  'Tie::IxHash' ,  pubkey 
=>  undef ,  jwk 
=>  undef ,  thumbprint 
=>  undef );  100  tie
(%{ $jwk { jwk
}},  'Tie::IxHash' ,  alg 
=>  'RS256' ,  jwk 
=>  undef );  101  #XXX: strict ordering only really needed here for thumbprint sha256 digest  102  tie
(%{ $jwk { jwk
}{ jwk
}},  'Tie::IxHash' ,  e 
=>  undef ,  kty 
=>  uc ( KEY_TYPE
),  n 
=>  undef );  107          my  ( $class ,  $mail ,  $debug ,  $prod ,  @domains ) =  @_ ;  112          # Link self to package  113          bless ( $self ,  $class );  116          $self ->{ debug
} =  $debug ;  119          $self ->{ prod
} =  $prod ;  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  ( $self ->{ 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  174          make_path
( CERT_DIR
,  KEY_DIR
,  PENDING_DIR
. '/' . $self ->{ mail
}. '.' .( $self ->{ prod
} ?  'prod'  :  'staging' ), { error 
=>  \
my  $err });  177                          my  ( $file ,  $msg ) =  %$_ ;  178                          carp 
( $file  eq  ''  ?  ''  :  $file . ': ' ). $msg  if  ( $self ->{ 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
));  281          my  $dir  =  $self ->{ 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  ( $self ->{ debug
});  365                  unless  ( scalar map  {  $_ -> type  eq  'TXT'  &&  $_ -> txtdata  =~  /^$signature$/  ?  1  : (); }  $rep -> answer ) {  366                          carp 
'TXT record recursive search for ' . $domain . ' failed'  if  ( $self ->{ 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  ( $self ->{ 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  ( $self ->{ 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 ;  434          # Create challenges hash  435          %{ $self ->{ challenges
}} = ();  440          # Create or load auth request for each domain  446                  my  $file  =  PENDING_DIR
. '/' . $self ->{ mail
}. '.' .( $self ->{ 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  ( $self ->{ 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  597                  if  ( $self ->{ debug
}) {  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 ) {  623                  confess 
'POST ' . $self ->{ 'new-cert' }. ' failed: ' . $res -> status_line ;  627          open ( $fh ,  '>' ,  CERT_DIR
. DS
. SERVER_CRT
)  or die  $! ;  630          print  $fh  '-----BEGIN CERTIFICATE-----' . " \n " . encode_base64
( $res -> content ). '-----END CERTIFICATE-----' . " \n " ;  633          my  $req  =  HTTP
:: Request-
> new ( GET 
=>  ACME_CERT
);  636          $res  =  $ua -> request ( $req );  639          unless  ( $res -> is_success ) {  640                  carp 
'GET ' . ACME_CERT
. ' failed: ' . $res -> status_line  if  ( $self ->{ debug
});  644          print  $fh $res -> content ;  647          close ( $fh )  or die  $! ;  650          carp 
'Success, pem certificate in ' . CERT_DIR
. DS
. SERVER_CRT 
if  ( $self ->{ debug
});  657  # OpenSSL configuration file.  658  # This is mostly being used for generation of certificate requests.  665  distinguished_name      
=  req_distinguished_name
 666  # The extentions to add to the self signed cert  667  x509_extensions 
=  v3_ca
 668  # The extensions to add to a certificate request  669  req_extensions 
=  v3_req
 671  # This sets a mask for permitted string types. There are several options.   672  # utf8only: only UTF8Strings (PKIX recommendation after 2004).  673  # WARNING: ancient versions of Netscape crash on BMPStrings or UTF8Strings.  674  string_mask 
=  utf8only
 676  [  req_distinguished_name 
]  678  stateOrProvinceName             
=  State 
or  Province Name
 679  localityName                    
=  Locality Name
 680  organizationName                
=  Organization Name
 681  organizationalUnitName          
=  Organizational Unit Name
 682  commonName                      
=  __COMMON_NAME__
 683  emailAddress                    
=  __EMAIL_ADDRESS__
 686  basicConstraints 
=  CA
: false
 687  keyUsage 
=  nonRepudiation
,  digitalSignature
,  keyEncipherment
 688  subjectAltName 
=  email
: move
 689  subjectAltName 
=  @alt_names  692  subjectKeyIdentifier 
=  hash
 693  authorityKeyIdentifier 
=  keyid
: always
, issuer
 694  basicConstraints 
=  CA
: true