ACME client implementation for mORMot 2

mormot.crypt.acme.pas

/// Framework Core ACME Support
// - this unit is a part of the Open Source Synopse mORMot framework 2,
// licensed under a MPL/GPL/LGPL three license - see LICENSE.md
unit mormot.crypt.acme;

{
  *****************************************************************************

   Automatic Certificate Management Environment (ACME)
    - ACME client implementation

  *****************************************************************************
}

interface

{$I ..\mormot.defines.inc}

uses
  classes,
  sysutils,
  mormot.core.base,
  mormot.core.unicode,
  mormot.core.text,
  mormot.core.buffers,
  mormot.core.data,
  mormot.core.variants,
  mormot.core.json,
  mormot.crypt.core,
  mormot.crypt.secure,
  mormot.net.client,
  mormot.crypt.x509,
  mormot.crypt.openssl;


{ **************** JWS HTTP-client implementation }

type
  /// exception associated with TJwsHttpClient
  EJwsHttp = class(ESynException);

  /// JSON Web Signature (JWS) HTTP-client
  // - send content secured with digital signature
  TJwsHttpClient = class(TSimpleHttpClient)
  protected
    fCert: ICryptCert;
    fNonce: RawUtf8;
    fKid: RawUtf8;
    fJwkThumbprint: RawUtf8;
  public
    constructor Create(aCert: ICryptCert);
    /// GET requests, not authenticated
    function Get(aUrl: RawUtf8): RawJson;
    /// POST request, authenticated, with a JWS body
    function Post(aUrl: RawUtf8; aJson: RawJson): RawJson; overload;
    function Post(aUrl: RawUtf8; aNameValues: array of const): RawJson; overload;
    /// JWK Thumbprint
    property JwkThumbprint: RawUtf8 read fJwkThumbprint;
  end;

{ **************** ACME client implementation }

type
  /// exception associated with TAcmeClient
  EAcmeClient = class(ESynException);

  TAcmeStatus = (asInvalid, asPending, asValid);

  TAcmeChallenge = record
    SubjectType: RawUtf8;
    Subject: RawUtf8;
    Status: TAcmeStatus;
    Url: RawUtf8;
    Token: RawUtf8;
    Key: RawUtf8;
  end;

  TAcmeChallengeDynArray = array of TAcmeChallenge;

  TOnAcmeChallenges = procedure (Sender: TObject;
    const aChallenges: TAcmeChallengeDynArray) of object;

  /// ACME client
  // - implements the Acme V2 client (specified in RFC8555) to download
  // free domain validated certificates
  TAcmeClient = class
  protected
    fDirectoryUrl: RawUtf8;
    fAlgo: TCryptAsymAlgo;
    fContact: RawUtf8;
    fSubjects: RawUtf8;
    fHttpClient: TJwsHttpClient;
    fNewNonce: RawUtf8;
    fNewAccount: RawUtf8;
    fNewOrder: RawUtf8;
    fFinalize: RawUtf8;
    fChallenges: TAcmeChallengeDynArray;
    fOnChallenges: TOnAcmeChallenges;
    procedure ReadDirectory;
    procedure CreateAccount;
    function CreateOrder: TAcmeStatus;
    procedure RequestAuthz(const aJson: RawJson);
  public
    /// create an ACME client instance
    // - aDirectoryUrl is URL of a directory object
    // - aCert will be used to identify client account
    constructor Create(aDirectoryUrl: RawUtf8; aCert: ICryptCert);
    /// finalize the instance
    destructor Destroy; override;
    /// Register account and applying for Certificate Issuance
    procedure StartDomainRegistration;
    /// Check if challenge for a domain is completed
    function CheckChallengesStatus: TAcmeStatus;
    /// Finalizes the order and download the certificate
    function CompleteDomainRegistration(out aCert, aPrivateKey: RawUtf8;
      const aPrivateKeyPassword: SpiUtf8): TAcmeStatus;
    /// Contact as mailto: link, e.g. 'mailto:admin@synopse.info'
    property Contact: RawUtf8 read fContact write fContact;
    /// Subjects is given as a CSV text, e.g. 'synopse.info,www.synopse.info'
    property Subjects: RawUtf8 read fSubjects write fSubjects;
    /// Notify top-level application
    property OnChallenges: TOnAcmeChallenges read fOnChallenges write fOnChallenges;
  end;

function ToText(status: TAcmeStatus): PShortString; overload;

const
  ACME_LETSENCRYPT_URL = 'https://acme-v02.api.letsencrypt.org/directory';
  ACME_CHALLENGE_PATH = '/.well-known/acme-challenge/';
  ACME_CHALLENGE_PATH_UPPER = '/.WELL-KNOWN/ACME-CHALLENGE/';

procedure TestAcme;

implementation

uses
  mormot.core.rtti, mormot.lib.openssl11;

const
  /// the JWS ECC curve names according to our known asymmetric algorithms
  //  https://www.iana.org/assignments/jose/jose.xhtml#web-key-elliptic-curve
  CAA_CRV: array[TCryptAsymAlgo] of RawUtf8 = (
    'P-256', // caaES256
    'P-384', // caaES384
    'P-521', // caaES512, note P-521 is not typo
    'secp256k1', // caaES256K
    '', // caaRS256
    '', // caaRS384
    '', // caaRS512
    '', // caaPS256
    '', // caaPS384
    '', // caaPS512
    'Ed25519'); // caaEdDSA

// TODO:
// Functions, not found in mormot.lib.openssl11
// All this functions available in OpenSSL 1.1 and OpenSSL 3

// Used in GetEccPubKey to retrieve uncompressed x and y values of private key
function EC_KEY_key2buf(key: PEC_KEY; form: point_conversion_form_t; pbuf: PPByte; ctx: PBN_CTX): PtrUInt; cdecl;
  external LIB_CRYPTO3 name _PU + 'EC_KEY_key2buf';

// Used in GetRsaPubKey to retrieve e and N values of private key
function EVP_PKEY_get0_RSA(pkey: PEVP_PKEY): PRSA; cdecl;
  external LIB_CRYPTO3 name _PU + 'EVP_PKEY_get0_RSA';
procedure RSA_get0_key(r: PRSA; n: PPBIGNUM; e: PPBIGNUM; d: PPBIGNUM); cdecl;
  external LIB_CRYPTO3 name _PU + 'RSA_get0_key';

// Used in CreateCsr to add subjectAltName extension to CSR
function X509_REQ_add_extensions(req: PX509_REQ; exts: Pstack_st_X509_EXTENSION): integer; cdecl;
  external LIB_CRYPTO3 name _PU + 'X509_REQ_add_extensions';

{ Helper functions }

procedure GetEccPubKey(const pkey: PEVP_PKEY; var x, y: RawUtf8);
var
  ecc: PEC_KEY;
  len: Integer;
  pub: PAnsiChar;
begin
  ecc := EVP_PKEY_get0_EC_KEY(pkey);
  len := EC_KEY_key2buf(ecc, POINT_CONVERSION_UNCOMPRESSED, @pub, nil);
  len := (len - 1) div 2;
  // Skip first byte, it's key compression marker
  x := BinToBase64uri(pub + 1, len);
  y := BinToBase64uri(pub + len + 1, len);
  OPENSSL_free(pub);
end;

procedure GetRsaPubKey(const pkey: PEVP_PKEY; var e, n: RawUtf8);
var
  rsa: PRSA;
  n_num: PBIGNUM;
  e_num: PBIGNUM;
  len: Integer;
  buf: array [0..1023] of AnsiChar;
begin
  rsa := EVP_PKEY_get0_RSA(pkey);
  RSA_get0_key(rsa, @n_num, @e_num, nil);
  len := BN_num_bytes(e_num);
  BN_bn2bin(e_num, @buf[0]);
  e := BinToBase64uri(@buf[0], len);
  len := BN_num_bytes(n_num);
  BN_bn2bin(n_num, @buf[0]);
  n := BinToBase64uri(@buf[0], len);
end;

procedure DerToEccSign(const der: RawByteString; var sign: RawUtf8);
var
  tags, bit_tags: TAsnTags;
  len: Cardinal;
  bin: RawByteString;
  p: PAnsiChar;
begin
  // Let's Encrypt does not accept this ASN1 encoded signature.
  // So we need to parse ASN1 string and extract x and y coordinates,
  // and then return x + y.
  // Also, skip first byte if #0
  tags := AsnParse(pointer(der), length(der));
  bit_tags := AsnParse(tags[0].Data, tags[0].Len);
  len := (bit_tags[0].Len div 2) * 2;
  SetLength(bin, len * 2);
  p := bit_tags[0].Data;
  if (p^ = #0) and (bit_tags[0].Len > len) then
    Inc(p);
  MoveFast(p^, bin[1], len);
  p := bit_tags[1].Data;
  if (p^ = #0) and (bit_tags[1].Len > len) then
    Inc(p);
  MoveFast(p^, bin[len + 1], len);
  sign := BinToBase64uri(bin);
end;

procedure DerToRsaSign(const der: RawByteString; var sign: RawUtf8);
begin
  sign := BinToBase64uri(pointer(der), length(der));
end;

// return identifers array from Subjects, like that:
// [ {"type": "dns", "value": "synopse.info"} ]
function GetIdentifiersArr(const aSubjects: RawUtf8): Variant;
var
  ids: TRawUtf8DynArray;
  i: Integer;
  typ, name: RawUtf8;
begin
  TDocVariantData(Result).InitArray([]);
  CsvToRawUtf8DynArray(pointer(aSubjects), ids, ',', {trim=}true);
  for i := 0 to length(ids) - 1 do
  begin
    if PosExChar(':', ids[i]) > 0 then
    begin
      Split(ids[i], ':', typ, name)
    end
    else
    begin
      typ := 'dns';
      name := ids[i];
    end;
    TDocVariantData(Result).AddItem(_Obj(['type', typ, 'value', name]));
  end;
end;

function TextToStatus(p: PUtf8Char): TAcmeStatus;
begin
  if IdemPChar(p, 'VALID') then
    result := asValid
  else if IdemPChar(p, 'READY') then
    result := asValid
  else if IdemPChar(p, 'PENDING') then
    result := asPending
  else
    result := asInvalid;
end;

function ToText(status: TAcmeStatus): PShortString;
begin
  result := GetEnumName(TypeInfo(TAcmeStatus), ord(status));
end;

function CreateCsr(const pkey: PEVP_PKEY; const md: PEVP_MD;
  const aSubjects: RawUtf8): RawByteString;
var
  dns: TRawUtf8DynArray;
  cn, altnames: RawUtf8;
  req: PX509_REQ;
  names: PX509_NAME;
  ex: PX509_EXTENSION;
  exts: Pstack_st_X509_EXTENSION;
  i: Integer;
begin
  // Same logic as in TCryptCertOpenSsl.Generate
  CsvToRawUtf8DynArray(pointer(aSubjects), dns, ',', {trim=}true);
  if Length(dns) < 1 then
    raise EAcmeClient.Create('no Subject/CommonName');
  cn := dns[0];
  for i := 0 to length(dns) - 1 do
    if PosExChar(':', dns[i]) = 0 then
      dns[i] := 'DNS:' + dns[i]; // e.g. DNS: email: IP: URI:
  altnames := RawUtf8ArrayToCsv(dns);
  // CSR
  req := NewCertificateRequest();
  try
    names := X509_REQ_get_subject_name(req);
    names^.AddEntry('CN', cn);
    ex := X509V3_EXT_conf_nid(nil, nil, NID_subject_alt_name, pointer(altnames));
    if ex <> nil then
    begin
      exts := NewOpenSslStack();
      exts.Add(ex);
      X509_REQ_add_extensions(req, exts);
      exts.Free();
    end;
    ex.Free();
    X509_REQ_set_pubkey(req, pkey);
    X509_REQ_sign(req, pkey, md);
    result := req^.ToBinary();
  finally
    req.Free();
  end;
end;

function IsEcc(aAlgo: TCryptAsymAlgo): Boolean;
begin
  result := aAlgo in [caaES256, caaES384, caaES512, caaES256K, caaEdDSA];
end;

{ TJwsHttpClient }

constructor TJwsHttpClient.Create(aCert: ICryptCert);
begin
  inherited Create({aOnlyUseClientSocket=}false);
  fCert := aCert;
end;

function TJwsHttpClient.Get(aUrl: RawUtf8): RawJson;
var
  status: Integer;
begin
  status := Request(aUrl, 'GET');
  // The server include a Replay-Nonce header field in every response
  fNonce := FindIniNameValue(pointer(fHeaders), 'REPLAY-NONCE: ');
  if (status <> 200) and (status <> 201) and (status <> 204) then
    raise EJwsHttp.CreateUtf8('Error % while querying %', [status, aUrl]);
  result := fBody;
end;

function TJwsHttpClient.Post(aUrl: RawUtf8; aJson: RawJson): RawJson;
var
  x, y, jwk, header: RawUtf8;
  thumb: TSha256Digest;
  header_enc, json_enc, body_enc: RawUtf8;
  sign: RawUtf8;
  data: RawUtf8;
  status: Integer;
  err: RawUtf8;
begin
  if fKid <> '' then
  begin
    // We have the key identifier provided by the server
    header := FormatUtf8('{"alg":?,"kid":?,"nonce":?,"url":?}', [],
      [CAA_JWT[fCert.AsymAlgo], fKid, fNonce, aUrl], true)
  end
  else
  begin
    if fCert.PrivateKeyHandle = nil then
      raise EJwsHttp.Create('No private key');
    // No key identifier, need to provide JSON Web Key
    if IsEcc(fCert.AsymAlgo) then
    begin
      //DerToEccPubKey(fCert.GetPublicKey(), x, y);
      GetEccPubKey(fCert.PrivateKeyHandle, x, y);
      jwk := FormatUtf8('{"crv":?,"kty":"EC","x":?,"y":?}',
        [], [CAA_CRV[fCert.AsymAlgo], x, y], true);
    end
    else
    begin
      GetRsaPubKey(fCert.PrivateKeyHandle, x, y);
      jwk := FormatUtf8('{"e":?,"kty":"RSA","n":?}',
        [], [x, y], true);
    end;
    // The thumbprint of a JWK is computed with no whitespace or line breaks
    // before or after any syntactic elements and with the required members
    // ordered lexicographically
    thumb := Sha256Digest(jwk);
    fJwkThumbprint := BinToBase64uri(@thumb, sizeof(thumb));
    header := FormatUtf8('{"alg":?,"jwk":%,"nonce":?,"url":?}',
      [jwk], [CAA_JWT[fCert.AsymAlgo], fNonce, aUrl], true);
  end;
  header_enc := BinToBase64uri(header);
  json_enc := BinToBase64uri(aJson);
  body_enc := header_enc + '.' + json_enc;
  if IsEcc(fCert.AsymAlgo) then
    DerToEccSign(fCert.Sign(pointer(body_enc), length(body_enc)), sign)
  else
    DerToRsaSign(fCert.Sign(pointer(body_enc), length(body_enc)), sign);
  data := FormatUtf8('{"protected":?,"payload":?,"signature":?}',
    [], [header_enc, json_enc, sign], true);
  status := Request(aUrl, 'POST', '', data, 'application/jose+json');
  // The server include a Replay-Nonce header field in every response
  fNonce := FindIniNameValue(pointer(fHeaders), 'REPLAY-NONCE: ');
  if (status <> 200) and (status <> 201) and (status <> 204) then
  begin
    err := JsonDecode(pointer(fBody), 'detail', nil, false);
    raise EJwsHttp.CreateUtf8('Error % while querying %: %', [status, aUrl, err]);
  end;
  if fKid = '' then
    fKid := FindIniNameValue(pointer(fHeaders), 'LOCATION: ');
  result := fBody;
end;

function TJwsHttpClient.Post(aUrl: RawUtf8;
  aNameValues: array of const): RawJson;
begin
  result := Post(aUrl, JsonEncode(aNameValues));
end;

{ TAcmeClient }

constructor TAcmeClient.Create(aDirectoryUrl: RawUtf8; aCert: ICryptCert);
begin
  fDirectoryUrl := aDirectoryUrl;
  fAlgo := aCert.AsymAlgo;
  fHttpClient := TJwsHttpClient.Create(aCert);
end;

destructor TAcmeClient.Destroy;
begin
  FreeAndNil(fHttpClient);
end;

procedure TAcmeClient.ReadDirectory;
var
  resp: RawJson;
  values: array [0..2] of TValuePUtf8Char;
begin
  // In order to help clients configure themselves with the right URLs for
  // each ACME operation, ACME servers provide a directory object
  resp := fHttpClient.Get(fDirectoryUrl);
  JsonDecode(pointer(resp), ['newNonce', 'newAccount', 'newOrder'], @values, true);
  values[0].ToUtf8(fNewNonce);
  values[1].ToUtf8(fNewAccount);
  values[2].ToUtf8(fNewOrder);
  if (fNewNonce = '') or (fNewAccount = '') or (fNewOrder = '') then
    raise EAcmeClient.CreateUtf8('Invalid directory %', [fDirectoryUrl]);
end;

procedure TAcmeClient.CreateAccount;
var
  resp: RawJson;
  status: RawUtf8;
begin
  // A client creates a new account with the server by sending a POST
  // request to the server's newAccount URL
  resp := fHttpClient.Post(fNewAccount,
    ['termsOfServiceAgreed', true, 'contact', _Arr([fContact])]);
  status := JsonDecode(pointer(resp), 'status', nil, true);
  if TextToStatus(pointer(status)) <> asValid then
    raise EAcmeClient.CreateUtf8('ACME account status % (expected "valid")', [status]);
end;

function TAcmeClient.CreateOrder: TAcmeStatus;
var
  resp: RawJson;
  values: array [0..2] of TValuePUtf8Char;
  authzs: TRawUtf8DynArray;
  i, j: Integer;
  ch_resp: RawJson;
  ch_values: array [0..2] of TValuePUtf8Char;
  p: PUtf8Char;
  challenges: TPUtf8CharDynArray;
begin
  // The client begins the certificate issuance process by sending a POST
  // request to the server's newOrder resource
  resp := fHttpClient.Post(fNewOrder,
    ['identifiers', GetIdentifiersArr(fSubjects)]);
  JsonDecode(pointer(resp), ['status', 'finalize', 'authorizations'], @values, true);
  result := TextToStatus(values[0].Text);
  if result = asInvalid then
    raise EAcmeClient.CreateUtf8('New order status % (expected "pending" or "ready")', [values[0].Text]);
  values[1].ToUtf8(fFinalize);
  // When a client receives an order from the server in reply to a
  // newOrder request, it downloads the authorization resources by sending
  // requests to the indicated URLs
  DynArrayLoadJson(authzs, values[2].Text, TypeInfo(TRawUtf8DynArray));
  SetLength(fChallenges, length(authzs));
  for i := 0 to length(authzs) - 1 do
  begin
    ch_resp := fHttpClient.Post(authzs[i], '');
    JsonDecode(pointer(ch_resp), ['status', 'identifier', 'challenges'], @values, true);
    fChallenges[i].Status := TextToStatus(pointer(values[0].Text));
    JsonDecode(values[1].Text, ['type', 'value'], @ch_values, false);
    ch_values[0].ToUtf8(fChallenges[i].SubjectType);
    ch_values[1].ToUtf8(fChallenges[i].Subject);
    if fChallenges[i].Status = asPending then
    begin
      p := values[2].Text;
      if NextNotSpaceCharIs(p, '[') then
        JsonArrayDecode(p, challenges)
      else
        challenges := nil;
      for j := 0 to length(challenges) - 1 do
      begin
        JsonDecode(challenges[j], ['type', 'url', 'token'], @ch_values, false);
        // We use only HTTP validation
        if IdemPChar(ch_values[0].Text, 'HTTP-01') then
        begin
          ch_values[1].ToUtf8(fChallenges[i].Url);
          ch_values[2].ToUtf8(fChallenges[i].Token);
          // A key authorization is a string that
          // concatenates the token for the challenge with a key fingerprint
          // (using the SHA-256 digest), separated by a "." character
          fChallenges[i].Key := fChallenges[i].Token + '.' + fHttpClient.JwkThumbprint;
          break;
        end;
      end;
    end;
  end;
end;

procedure TAcmeClient.RequestAuthz(const aJson: RawJson);
var
  i: Integer;
  resp: RawJson;
  status: RawUtf8;
begin
  // The client indicates to the server that it is ready for the challenge
  // validation by sending an empty body aJson = '{}'.
  // If aJson = '' then client requests validation state
  for i := 0 to length(fChallenges) - 1 do
  begin
    if fChallenges[i].Status = asPending then
    begin
      resp := fHttpClient.Post(fChallenges[i].Url, aJson);
      status := JsonDecode(pointer(resp), 'status', nil, false);
      fChallenges[i].Status := TextToStatus(pointer(status));
    end;
  end;
end;

procedure TAcmeClient.StartDomainRegistration;
begin
  // In order to help clients configure themselves with the right URLs for
  // each ACME operation, ACME servers provide a directory object
  ReadDirectory();
  // Before sending a POST request to the server, an ACME client needs to
  // have a fresh anti-replay nonce to put in the "nonce" header of the JWS
  fHttpClient.Get(fNewNonce);
  // Create an account on an ACME server or retrieve existing
  CreateAccount();
  // Applying for Certificate Issuance
  if CreateOrder() = asPending then
  begin
    // Notify top-level application
    if Assigned(fOnChallenges) then
      fOnChallenges(Self, fChallenges);
    // Queue challenge testing
    RequestAuthz('{}');
  end;
end;

function TAcmeClient.CheckChallengesStatus: TAcmeStatus;
var
  i: Integer;
  valid: Integer;
begin
  // Before sending a POST request to the server, an ACME client needs to
  // have a fresh anti-replay nonce to put in the "nonce" header of the JWS
  fHttpClient.Get(fNewNonce);
  // Check if challenge for a domain is completed
  RequestAuthz('');
  // Compute result:
  // One invalid -> invalid
  // All valid -> valid
  // else pending
  result := asPending;
  valid := 0;
  for i := 0 to length(fChallenges) - 1 do
  begin
    if fChallenges[i].Status = asInvalid then
      result := asInvalid;
    if fChallenges[i].Status = asValid then
      inc(valid);
  end;
  if (result = asPending) and (valid = length(fChallenges)) then
    result := asValid
end;

function TAcmeClient.CompleteDomainRegistration(out aCert, aPrivateKey: RawUtf8;
  const aPrivateKeyPassword: SpiUtf8): TAcmeStatus;
var
  keys: PEVP_PKEY;
  csr: RawByteString;
  resp: RawJson;
  values: array [0..1] of TValuePUtf8Char;
begin
  keys := OpenSslGenerateKeys(CAA_EVPTYPE[fAlgo], CAA_BITSORCURVE[fAlgo]);
  try
    csr := CreateCsr(keys, OpenSslGetMd(CAA_HASH[fAlgo], 'TAcmeClient'),
      fSubjects);
    // Before sending a POST request to the server, an ACME client needs to
    // have a fresh anti-replay nonce to put in the "nonce" header of the JWS
    fHttpClient.Get(fNewNonce);
    // Once the validation process is complete and the server is satisfied
    // that the client has met its requirements, the client finalizes the
    // order by submitting a Certificate Signing Request (CSR)
    resp := fHttpClient.Post(fFinalize, ['csr', BinToBase64uri(csr)]);
    JsonDecode(pointer(resp), ['status', 'certificate'], @values, true);
    result := TextToStatus(values[0].Text);
    if result = asValid then
    begin
      // The server has issued the certificate and provisioned its
      // URL to the "certificate" field of the order.
      // Download the certificate
      aCert := fHttpClient.Post(values[1].ToUtf8(), '');
      aPrivateKey := keys.PrivateToPem(aPrivateKeyPassword)
    end;
  finally
    keys.Free();
  end;
end;

{ Test code }

type
  TChallengeConsumer = class
    class procedure DoChallenges(Sender: TObject;
      const aChallenges: TAcmeChallengeDynArray);
  end;

class procedure TChallengeConsumer.DoChallenges(Sender: TObject;
  const aChallenges: TAcmeChallengeDynArray);
var
  i: Integer;
  //filename: TFileName;
begin
  for i := 0 to Length(aChallenges) - 1 do
  begin
    // Store challenges in some place.
    // For example, we can create files in webserver root directory:
    //Utf8ToFileName('/var/www/html' + ACME_CHALLENGE_PATH + aChallenges[i].Token,
    //  filename);
    //FileFromString(aChallenges[i].Key, filename);
  end;
end;

procedure TestAcme;
var
  server_cert: ICryptCert;
  client: TAcmeClient;
  status: TAcmeStatus;
  i: Integer;
  newcert, key: RawUtf8;
begin
  try
    RegisterOpenSsl();
    // Let's Encrypt supports only one of RS256, ES256, ES384 or ES512
    server_cert := Cert('x509-es256');
    assert(server_cert <> nil);
    if not FileExists('myserver-id.cer') then
    begin
      server_cert.Generate([cuDigitalSignature], '127.0.0.1', nil, 3650);
      server_cert.SaveToFile('myserver-id.cer', cccCertWithPrivateKey);
    end
    else
      server_cert.LoadFromFile('myserver-id.cer', cccCertWithPrivateKey);
    // Use staging server for test purposes.
    // Main server is https://acme-v02.api.letsencrypt.org/directory
    client := TAcmeClient.Create('https://acme-staging-v02.api.letsencrypt.org/directory',
      server_cert);
    try
      client.OnChallenges := TChallengeConsumer.DoChallenges;
      client.Contact := 'mailto:admin@synopse.info';
      client.Subjects := 'synopse.info,www.synopse.info';
      client.StartDomainRegistration();
      // Wait up to 10 seconds for ACME server to test challenges
      for i := 0 to 9 do
      begin
        sleep(1000);
        status := client.CheckChallengesStatus();
        if status <> asPending then
          break;
      end;
      if status = asValid then
        status := client.CompleteDomainRegistration(newcert, key, '');
      // Store certificate and private key.
      // They returned in PEM format, and newcert also contains full chain
      // of certificates:
      //FileFromString(newcert, 'cert.pem');
      //FileFromString(key, 'privkey.pem');
      writeln('Status: ', ToText(status)^);
    finally
      client.Free;
    end;
  except
    on E: Exception do
      writeln('Exception: ', E.Message);
  end;
end;

end.