Pascal (Lazarus/Delphi)

HTTP - Verify Server is a Trusted Root CA

See more HTTP Examples

Demonstrates how to only allow connections to an HTTP server having a certificate with a root that is in our list of trusted CA root certificates. 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.Http;

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

procedure RunDemo;
var
  success: Boolean;
  url: string;
  http: THttp;
  html: string;
  trustedRoots: TTrustedRoots;

begin
  success := False;

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

  success := False;

  //   On my particular system, the root CA cert for this URL is not pre-installed.
  //   Note: This may be different for you.
  //   Also, this example was written on 29-May-2015.  This URL was valid at the time,
  //   but may not be valid at a future date.
  url := 'https://animals.nationalgeographic.com/animals/invertebrates/starfish/';

  http := THttp.Create;

  //   Require that the SSL/TLS server certificate is not expired,
  //   and that the certificate signature is valid.
  //   This does not ensure that it has a chain of authentication to
  //   a trusted root.  To ensure that, the TrustedRoots object (below) is required.
  http.RequireSslCertVerify := True;

  //   Do the HTTPS page fetch (through the SSH tunnel)
  html := http.QuickGetStr(url);
  if (http.LastMethodSuccess <> True) then
    begin
      WriteLn(http.LastErrorText);
      Exit;
    end;

  WriteLn('The HTTP GET was successful.');

  //   Now let's require that HTTP requests to SSL/TLS servers that don't have trusted CA roots
  //   should fail.
  trustedRoots := TTrustedRoots.Create;

  //   Indicate that we will trust any pre-installed certificates on this system.
  //   (The meaning of pre-installed certificates depends on the operating system, and in
  //   some environments there is no such thing as pre-installed certificates.  See the reference
  //   documentation for the TrustedRoots class.)
  trustedRoots.TrustSystemCaRoots := True;

  //   Activate the trusted roots globally for all Chilkat objects.
  //   This call really shouldn't fail, so we're not checking the return value.
  success := trustedRoots.Activate();

  //   Given that our previous HTTP GET likely kept the connection open,
  //   make sure that all HTTP connections are closed before re-trying.
  //   Otherwise, we'll simply be re-using the pre-existing connection.
  success := http.CloseAllConnections();

  //   Now let's try fetching the URL again.  It should fail this time because
  //   there is a requirement that the SSL/TLS server certificate must have a trusted root,
  //   and the trusted root for this URL is not installed on my system (but may be different for you..)
  html := http.QuickGetStr(url);
  if (http.LastMethodSuccess <> True) then
    begin
      WriteLn(http.LastErrorText);
      WriteLn('Good, the HTTP request failed as expected.');
    end
  else
    begin
      WriteLn(http.LastErrorText);
      WriteLn('Hmmm... we did not fail as expected?');
    end;


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