Indy 10 SSL root certificate

Question

I am trying to verify server certificate. I use Indy 10 and OpenSSL. I specify Root RootCertFile and VerifyDepth to MaxInt. OnVerifyPeer works fine - AOk is true. I wonder how to load certificates from Windows Trusted Root Certification Authorities. There is my stripped code of a client:

uses
  {Delphi}
  IdSSLOpenSSL
  , IdHTTP
  , IdHeaderList
  , System.Classes
  {Project}
  ;

type
  TUnicodeHTTPPoster = class
  strict private
    FidHTTP: TIdHTTP;
    FLastError: string;
    FCertPassword: string;

    procedure OnGetPassword(var Password: string);
    function OnVerifySSLPeer(Certificate: TIdX509;AOk: Boolean; ADepth, AError: Integer): Boolean;
  public
    constructor Create(const ASSLVersion: TIdSSLVersion; const AAccept: string = 'application/xml';
      const ACharSet: string = 'utf-8'; const ACertFile: string = ''; const AKeyFile: string = '';
      const ACertPassword: string = ''); reintroduce;
    destructor Destroy; override;

    function Post(const ACustomHeaders: TIdHeaderList; const ARawBody: TStream;
      const AURL: string; out AResponse: string): integer;
  end;

implementation

uses
  {Delphi}
  System.SysUtils
  , IdURI
  , IdGlobal
  {Project}
  ;

constructor TUnicodeHTTPPoster.Create(const ASSLVersion: TIdSSLVersion; const AAccept: string = 'application/xml';
  const ACharSet: string = 'utf-8'; const ACertFile: string = ''; const AKeyFile: string = '';
  const ACertPassword: string = '');
var
  _IdSSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
begin
  inherited Create;

  FidHTTP := TIdHTTP.Create(nil);
  FidHTTP.Request.Accept := 'application/xml';
  if AAccept <> '' then
    FidHTTP.Request.Accept := AAccept;

  FidHTTP.Request.Charset := 'utf-8';
  if ACharSet <> '' then
    FidHTTP.Request.Charset := ACharSet;

  _IdSSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create(FidHTTP);

  if FileExists(ACertFile) then
    _IdSSLIOHandlerSocketOpenSSL.SSLOptions.CertFile := ACertFile;

  if FileExists(AKeyFile) then
    _IdSSLIOHandlerSocketOpenSSL.SSLOptions.KeyFile := AKeyFile;

  FCertPassword := ACertPassword;

  FidHTTP.Request.BasicAuthentication := False;
  _IdSSLIOHandlerSocketOpenSSL.SSLOptions.Mode := sslmClient;
  _IdSSLIOHandlerSocketOpenSSL.SSLOptions.Method := ASSLVersion;
  _IdSSLIOHandlerSocketOpenSSL.OnGetPassword := OnGetPassword;
  _IdSSLIOHandlerSocketOpenSSL.SSLOptions.VerifyMode := [sslvrfPeer];
  _IdSSLIOHandlerSocketOpenSSL.SSLOptions.VerifyDepth := MaxInt;
  _IdSSLIOHandlerSocketOpenSSL.OnVerifyPeer := OnVerifySSLPeer;
  _IdSSLIOHandlerSocketOpenSSL.SSLOptions.RootCertFile := 'C:\Users\ekolesnikovics\Desktop\Projects\nDentity\ndentify\Build\dc_ofisas.nsoft.lt.pem';
  FidHTTP.IOHandler := _IdSSLIOHandlerSocketOpenSSL;
end;

function TUnicodeHTTPPoster.OnVerifySSLPeer(Certificate: TIdX509;AOk: Boolean; ADepth, AError: Integer): Boolean;
begin
  Result := AOk;
end;

procedure TUnicodeHTTPPoster.OnGetPassword(var Password: string);
begin
  Password := FCertPassword;
end;

function TUnicodeHTTPPoster.Post(const ACustomHeaders: TIdHeaderList; const ARawBody: TStream;
  const AURL: string; out AResponse: string): integer;
var
  _URL: string;
  _ResponseStream: TStringStream;
begin
  Result := 500;
  FLastError := '';

  try
    if Trim(AURL) = '' then
      raise EArgumentException.Create('URL is not provided.');

    _URL := TIdURI.URLEncode(AURL, IndyTextEncoding_UTF8);
    _ResponseStream := TStringStream.Create('', TEncoding.UTF8);
    try
      if Assigned(FidHTTP.Request.CustomHeaders) then
        FidHTTP.Request.CustomHeaders.Clear;

      if Assigned(ACustomHeaders) then
        FidHTTP.Request.CustomHeaders := ACustomHeaders;

      FidHTTP.Post(_URL, ARawBody, _ResponseStream);
      _ResponseStream.Position := 0;
      AResponse := _ResponseStream.DataString;
    finally
      FreeAndNil(_ResponseStream);
    end;

    Result := 200;
  except
    on E: EIdHTTPProtocolException do
    begin
      Result := E.ErrorCode;
      FLastError := E.ErrorMessage;
      FidHTTP.Disconnect;
    end;

    on E: Exception do
    begin
      FLastError := E.Message;
      FidHTTP.Disconnect;
    end;
  end;
end;

Answer 1

I ended up using free https://github.com/magicxor/WinCryptographyAPIs

procedure TUnicodeHTTPPoster.ExportWindowsCertificateStoreToFile(const ACertFile: string);
var
  _hStore: HCERTSTORE;
  _CertContext: PCertContext;
  _pchString: Cardinal;
  _szString: string;
  _CertList: TStringList;
begin
  _hStore := CertOpenSystemStore(0, PChar('ROOT'));
  if (_hStore = nil) then
    RaiseLastOSError;

  _CertList := TStringList.Create;
  try
    _CertContext := CertEnumCertificatesInStore(_hStore, nil);
    if (_CertContext = nil) then
      RaiseLastOSError;
    while _CertContext <> nil do
    begin
      _pchString := 0;
      if not CryptBinaryToString(_CertContext.pbCertEncoded,
        _CertContext.cbCertEncoded, CRYPT_STRING_BASE64, nil, _pchString) then
        RaiseLastOSError;

      SetLength(_szString, 0);
      SetLength(_szString, _pchString - 1);
      if not CryptBinaryToString(_CertContext.pbCertEncoded,
        _CertContext.cbCertEncoded, CRYPT_STRING_BASE64, PWideChar(_szString),
        _pchString) then
        RaiseLastOSError;

      _CertList.Add('-----BEGIN CERTIFICATE-----');
      _CertList.Add(Trim(StrPas(PWideChar(_szString))));
      _CertList.Add('-----END CERTIFICATE-----');

      _CertContext := CertEnumCertificatesInStore(_hStore, _CertContext);
    end;

    _CertList.SaveToFile(ACertFile);
  finally
    FreeAndNil(_CertList);
    CertCloseStore(_hStore, 0);
  end;
end;

_RootCertFileName := TPath.Combine(ExtractFilePath(ParamStr(0)), 'windows_cert.pem');
ExportWindowsCertificateStoreToFile(_RootCertFileName);
_IdSSLIOHandlerSocketOpenSSL.SSLOptions.RootCertFile := _RootCertFileName;