Lazarus Pascal Requires Chilkat v11.0.0+

Extract TSTInfo from RFC3161 Timestamp Reply

See more HTTP Examples

Sends an RFC 3161 timestamp request to a TSA (Timestamp Authority) server and converts the timestamp reply to XML, and then extracts the TSTInfo from the XML and converts it to XML. Lazarus Pascal

program ChilkatDemo;

// Demonstrates using the Chilkat Pascal wrapper via the C bridge DLL.
// Builds as a console application under Lazarus (FPC) or Delphi.

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  SysUtils,
  CkDllLoader,
  Chilkat.Asn,
  Chilkat.HttpResponse,
  Chilkat.Http,
  Chilkat.BinData,
  Chilkat.StringBuilder,
  Chilkat.Xml,
  Chilkat.Crypt2;

// ---------------------------------------------------------------------------

procedure RunDemo;
var
  success: Boolean;
  crypt: TCrypt2;
  base64Hash: string;
  http: THttp;
  requestToken: TBinData;
  optionalPolicyOid: string;
  addNonce: Boolean;
  requestTsaCert: Boolean;
  tsaUrl: string;
  resp: THttpResponse;
  timestampReply: TBinData;
  asn: TAsn;
  xml: TXml;
  tstInfoBase64: string;
  bdTstInfo: TBinData;
  asnTstInfo: TAsn;
  xmlTstInfo: TXml;
  sbGenTime: TStringBuilder;

begin
  success := False;

  //  Note: Requires Chilkat v9.5.0.75 or greater.

  //  This requires the Chilkat API to have been previously unlocked.
  //  See Global Unlock Sample for sample code.

  //  First sha-256 hash the data that is to be timestamped.
  //  In this example, the data is the string "Hello World"

  crypt := TCrypt2.Create;
  crypt.HashAlgorithm := 'sha256';
  crypt.EncodingMode := 'base64';
  base64Hash := crypt.HashFileENC('qa_data/hamlet.xml');

  http := THttp.Create;

  requestToken := TBinData.Create;
  optionalPolicyOid := '';
  addNonce := False;
  requestTsaCert := True;

  //  Create a time-stamp request token
  success := http.CreateTimestampRequest('sha256',base64Hash,optionalPolicyOid,addNonce,requestTsaCert,requestToken);
  if (success = False) then
    begin
      WriteLn(http.LastErrorText);
      Exit;
    end;

  //  Send the time-stamp request token to the TSA.
  //  This is the equivalent of the following CURL command:
  //  curl -H "Content-Type: application/timestamp-query" --data-binary '@file.tsq' http://timestamp.digicert.com > file.tsr
  tsaUrl := 'http://timestamp.digicert.com';
  resp := THttpResponse.Create;
  success := http.HttpBd('POST',tsaUrl,requestToken,'application/timestamp-query',resp);
  if (success = False) then
    begin
      WriteLn(http.LastErrorText);
      Exit;
    end;

  //  Get the timestamp reply from the HTTP response object.
  timestampReply := TBinData.Create;
  resp.GetBodyBd(timestampReply);

  //  Convert the binary timestamp reply to XML
  asn := TAsn.Create;
  success := asn.LoadBd(timestampReply);
  if (success = False) then
    begin
      WriteLn(asn.LastErrorText);
      Exit;
    end;

  xml := TXml.Create;
  success := xml.LoadXml(asn.AsnToXml());

  //  Extract the TSTInfo from the XML.
  //  The TSTInfo is this base64 encoded ASN.1 

  //  TSTInfo ::= SEQUENCE  {
  //     version                      INTEGER  { v1(1) },
  //     policy                       TSAPolicyId,
  //     messageImprint               MessageImprint,
  //       -- MUST have the same value as the similar field in
  //       -- TimeStampReq
  //     serialNumber                 INTEGER,
  //      -- Time-Stamping users MUST be ready to accommodate integers
  //      -- up to 160 bits.
  //     genTime                      GeneralizedTime,
  //     accuracy                     Accuracy                 OPTIONAL,
  //     ordering                     BOOLEAN             DEFAULT FALSE,
  //     nonce                        INTEGER                  OPTIONAL,
  //       -- MUST be present if the similar field was present
  //       -- in TimeStampReq.  In that case it MUST have the same value.
  //     tsa                          [0] GeneralName          OPTIONAL,
  //     extensions                   [1] IMPLICIT Extensions   OPTIONAL  }

  tstInfoBase64 := xml.GetChildContent('sequence[1]|contextSpecific|sequence|sequence|contextSpecific|octets');

  bdTstInfo := TBinData.Create;
  bdTstInfo.AppendEncoded(tstInfoBase64,'base64');

  asnTstInfo := TAsn.Create;
  success := asnTstInfo.LoadBd(bdTstInfo);
  if (success = False) then
    begin
      WriteLn(asnTstInfo.LastErrorText);
      Exit;
    end;

  xmlTstInfo := TXml.Create;
  success := xmlTstInfo.LoadXml(asnTstInfo.AsnToXml());
  WriteLn(xmlTstInfo.GetXml());

  //  Here's the TSTInfo XML:

  //  <?xml version="1.0" encoding="utf-8"?>
  //  <sequence>
  //      <int>01</int>
  //      <oid>2.16.840.1.114412.7.1</oid>
  //      <sequence>
  //          <sequence>
  //              <oid>2.16.840.1.101.3.4.2.1</oid>
  //              <null/>
  //          </sequence>
  //          <octets>4sRRyWOzC7EOic4fQ9+Op1pa10DbgoBGjBvkq09LZmE=</octets>
  //      </sequence>
  //      <int>00AD2C86E49872597B60F87D5C54BCFFAE</int>
  //      <universal tag="24" constructed="0">MjAyMzAzMTYxMTQ5NTJa</universal>
  //  </sequence>

  //     The genTime (GeneralizedTime) is contained in the final "universal" XML element and is 
  //     in base64. It is the time at which the time-stamp token has been created by
  //     the TSA. After decoding from base64, it is:
  //  
  //     The syntax is: YYYYMMDDhhmmss[.s...]Z
  //     Example: 19990609001326.34352Z

  sbGenTime := TStringBuilder.Create;
  sbGenTime.DecodeAndAppend(xmlTstInfo.GetChildContent('universal'),'base64','utf-8');
  WriteLn(sbGenTime.GetAsString());

  //  Result:
  //  20230316115718Z


  crypt.Free;
  http.Free;
  requestToken.Free;
  resp.Free;
  timestampReply.Free;
  asn.Free;
  xml.Free;
  bdTstInfo.Free;
  asnTstInfo.Free;
  xmlTstInfo.Free;
  sbGenTime.Free;

end;

// ---------------------------------------------------------------------------

begin

  try
    RunDemo;
  except
    on E: Exception do
      WriteLn('Unhandled exception: ', E.ClassName, ': ', E.Message);
  end;

  WriteLn;
  {$IFDEF MSWINDOWS}
  WriteLn('Press Enter to exit...');
  ReadLn;
  {$ENDIF}
end.