Pascal (Lazarus/Delphi)

Trust Specific Root CA Certificates

See more Certificates Examples

Demonstrates how to trust specific root CA certificates and none others. Pascal (Lazarus/Delphi)

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.TrustedRoots,
  Chilkat.Cert,
  Chilkat.Http;

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

procedure RunDemo;
var
  success: Boolean;
  tRoots: TTrustedRoots;
  caCert: TCert;
  http: THttp;

begin
  success := False;

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

  //  This example will trust the Amazon root CA certificates provided at 
  //  https://www.amazontrust.com/repository/

  //  I've previously downloaded the root CA certificates to DER format.
  //  Add each to the Chilkat TrustedRoots singleton object.

  tRoots := TTrustedRoots.Create;

  caCert := TCert.Create;
  success := caCert.LoadFromFile('qa_data/certs/aws_root_ca/AmazonRootCA1.cer');
  if (success = False) then
    begin
      WriteLn(caCert.LastErrorText);
      Exit;
    end;
  success := tRoots.AddCert(caCert);

  //  Continue with the others.
  //  For brevity, we're not checking return values for success/failure.
  success := caCert.LoadFromFile('qa_data/certs/aws_root_ca/AmazonRootCA2.cer');
  success := tRoots.AddCert(caCert);

  success := caCert.LoadFromFile('qa_data/certs/aws_root_ca/AmazonRootCA3.cer');
  success := tRoots.AddCert(caCert);

  success := caCert.LoadFromFile('qa_data/certs/aws_root_ca/AmazonRootCA4.cer');
  success := tRoots.AddCert(caCert);

  success := caCert.LoadFromFile('qa_data/certs/aws_root_ca/SFSRootCAG2.cer');
  success := tRoots.AddCert(caCert);

  //  Indicate we don't want to automatically trust the operating system's installed root CA certificates.
  //  On a Windows operating system, this would be the registry-based CA certificate stores. 
  //  On a Linux system, this could be /etc/ssl/certs/ca-certificates.crt, if it exists.
  tRoots.TrustSystemCaRoots := False;

  //  Activate the trusted roots object.
  //  Once activated, all Chilkat objects that use TLS connections (HTTP, REST, Socket, MailMan, IMAP, FTP, etc.)
  //  will fail the TLS handshake if the server certificate is not verified and rooted with one of our explicitly trusted root certificates.
  success := tRoots.Activate();

  http := THttp.Create;

  //  Note: We also need to explicitly indicate that server certificates are to be verified.
  http.RequireSslCertVerify := True;

  //  For example, the following should fail because www.chilkatsoft.com's server certificate is not rooted in one of the explicitly trusted root CA certs.
  success := http.Download('https://www.chilkatsoft.com/helloWorld.txt','qa_output/helloWorld.txt');
  if (success <> True) then
    begin
      //  The above Download should fail.
      WriteLn(http.LastErrorText);

      //  There should be a message in the LastErrorText indicating that we were "Unable to build certificate chain to root.."
    end;

  //  However, we should be able to make TLS connections to good.sca1a.amazontrust.com
  success := http.Download('https://good.sca1a.amazontrust.com/','qa_output/valid.html');
  if (success <> True) then
    begin
      WriteLn(http.LastErrorText);
      Exit;
    end;

  //  We can still examine the LastErrorText and we'll find this message within:  
  //  "The public key was successfully validated against the public key of the explicitly trusted root cert."
  WriteLn(http.LastErrorText);

  WriteLn('Success!');


  tRoots.Free;
  caCert.Free;
  http.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.