Access Violation setting Passthrough (10.6.2.0)

[Hafedh TRIMECHE 1]

Using SSL libraries version 1.0.2u, EAccessViolation  is raised.

Code used for connection:

procedure TTCPClient.Connect;
var
  LConfig : TTCPConfig;
begin
  Lock;
  LConfig := FConfig;
  Unlock;
  if LConfig.HostOrIP='' then Exit;
  Disconnect;
  try
    inherited Host := LConfig.HostOrIP;
    inherited Port := LConfig.Port
  except
  end;
  if LConfig.SSLEnabled then IOHandler := FSSLHandler
                        else IOHandler := nil;
  try
    inherited Connect;
  except
    on E: Exception do HandleException(E);
  end;
end;

 

===============================================================================
Application Name      : PGFClient.exe
Memory manager        : msvcrt.dll
Compiler Version      : Delphi: 33
Indy Version          : 10.6.2.0
Zeos Version          : 7.2.6-stable
Report Unique ID      : {4C789C3C-712A-4FE7-B68B-73FF6B4160F1}
Start Time            : 2020-06-07 23:33:47.688
Exception Time        : 2020-06-07 23:34:19.770
Application up time   :  32 seconds 82 milliseconds
===============================================================================
Processor             : eMachines, eMachines G640, AMD64 Family 16 Model 6 Stepping 3, AMD Athlon(tm) II P320 Dual-Core Processor, 2.095 GHz
System                : Windows 10 (Version 10.0, Build 18362, 64-bit Edition)
Display               : 1680x1050 pixels, 96 bpp
Total Physical Memory :   5.748 GB
Free Physical Memory  :   1.092 GB
Max used Memory       :   176.047 MB
===============================================================================
Exception class       : EAccessViolation
Access violation at address 007D7E14 in module 'PGFClient.exe'. Read of address 0000000C
-------------------------------------------------------------------------------
Module                : IdSSLOpenSSL
Command Line          : D:\Applications-Folder\PGFClient\PGFClient.exe
Procedure             : IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.SetPassThrough
Unit                  : IdSSLOpenSSL.pas
Line                  : 2889
-------------------------------------------------------------------------------
[007D7E14] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.SetPassThrough (Line 2889, "IdSSLOpenSSL.pas" + 36) + $1F
[00795019] IdIOHandler.TIdIOHandler.ReadFromSource (Line 1737, "IdIOHandler.pas" + 62) + $1
[0079B436] IdIOHandlerStack.DoConnectTimeout (Line 329, "IdIOHandlerStack.pas" + 76) + $2C
[007A13DA] IdTCPConnection.TIdTCPConnection.DoOnDisconnected (Line 584, "IdTCPConnection.pas" + 1) + $6
[007DEFE0] uTCP.TTCPClient.Connect (Line 1694, "uTCP.pas" + 13) + $A
[00B29D32] uAsyncTCP.TTCPAsyncThread.Execute (Line 421, "uAsyncTCP.pas" + 21) + $0
[00B2AC95] uAsyncTCP.TTCPAsyncClient.Disconnect (Line 842, "uAsyncTCP.pas" + 5) + $3
[00DE877E] uClient.TMainForm.ControllerStart (Line 1781, "uClient.pas" + 68) + $1B
[00BC5DBD] uMainForm.TUForm.Destroy (Line 1304, "uMainForm.pas" + 9) + $8
[00BC65EE] uMainForm.TUForm.WndProc (Line 1554, "uMainForm.pas" + 38) + $22
[0057980C] Vcl.Controls.TWinControl.MainWndProc + $2C
[004DDDDC] System.Classes.StdWndProc + $14
[0067606F] Vcl.Forms.TApplication.ProcessMessage + $F3
[006760B2] Vcl.Forms.TApplication.HandleMessage + $A
[006763E5] Vcl.Forms.TApplication.Run + $C9
[00E2C32D] PGFClient.PGFClient (Line 19, "" + -934) + $7

 

[Remy Lebeau 1432]

You did not show how you are creating and setting up your FSSLHandler, or how you are using TIdTCPClient in your TTCPAsyncThread, but the error report indicates that a nil pointer is being accessed inside of the IOHandler's PassThrough property setter method.  The report also says that you are using Delphi 10.3 Rio.  Are you using an up-to-date version of Indy 10 with it?  Delphi 10.4 shipped with an updated Indy 10 snapshot from a few weeks ago.  There were some changes made to the PassThrough setter back in August 2019, but I can't tell if you are using that version or not.

 

The call stack trace shown in your error report makes no sense.  It implies that your MainForm is trying to connect to the server while the Form is being destroyed?  Typically, when an exception is logged, only the call stack of the thread that raised the exception should be logged.  But the only way this error report's call stack trace makes sense is if it is actually logging call stacks from multiple threads at the same time, overlapping them.  I think your code has a secondary worker thread that is trying to connect to the server at the same moment that your MainForm is destroying the Indy components.  You need to shut down your TTCPAsyncThread completely before allowed the MainForm to destroy the Indy components.

 

I'm also a little worried that Indy's ReadFromSource() method appears in this error report at all.  TIdTCPClient's Connect() method doesn't call ReadFromSource(), which implies that something else in your code is trying to read from the TCP connection when it likely should not be.  Are you, by chance, making any calls to TIdTCPClient's Connected() method to check the state of the TCP connection, in particular in the main thread?  If so, you should not be doing that at all.

 

It is hard to diagnose this error without seeing all of your relevant code that is using Indy, at least the connect and disconnect portions.

Edited June 8, 2020 by Remy Lebeau

[Hafedh TRIMECHE 1]

Thank you Remy,

 

Indeed, the exception is raised because the function Connected is called before the FSSLHandler is assigned to IOHandler so fSSLSocket and/or fSSL not assigned too.

function TIdSSLIOHandlerSocketOpenSSL.Readable(AMSec: Integer = IdTimeoutDefault): Boolean;
begin
  if not fPassThrough then
  begin
    Result := ssl_pending(fSSLSocket.fSSL) > 0;
    if Result then Exit;
  end;
  Result := inherited Readable(AMSec);
end;

 

 

Edited June 9, 2020 by Hafedh TRIMECHE

[Remy Lebeau 1432]

12 hours ago, Hafedh TRIMECHE said:

Indeed, the exception is raised because the function Connected is called

You are right, I misspoke.  TIdTCPClient's Connect() method does call the Connected() method internally.

12 hours ago, Hafedh TRIMECHE said:

before the FSSLHandler is assigned to IOHandler

Not true, otherwise you would not be getting the exception inside of TIdSSLIOHandlerSocketOpenSSL.  The Connected() method checks for a nil IOHandler.  So, the fact that you are getting an exception inside of the Readable() method of TIdSSLIOHandlerSocketOpenSSL means that your FSSLHandler is actually assigned to the TIdTCPClient's IOHandler.

12 hours ago, Hafedh TRIMECHE said:

so fSSLSocket and/or fSSL not assigned too.

Also not true, because Readable() accesses the fSSLSocket object only when the fPassThrough member is False, and that member can't be False without an active fSSLSocket object, as the PassThrough property setter ensures that object's existence before setting fPassThrough to False.

 

Your earlier crash report clearly shows your TTCPClient.Connect() method being called while your MainForm is being destroyed, so I still believe that your code is trying to access the TIdTCPClient and/or TIdSSLIOHandlerSocketOpenSSL while (or after) it is in a state of destruction.  Your code is not cleaning up after itself properly during a shutdown.  But you have not shown any of your actual code for TTCPAsyncThread or TMainForm, so noone can tell you why it is not cleaning up properly.  You are likely missing some shutdown logic to stop the TTCPAsyncThread before the MainForm destroys the Indy components.

[Hafedh TRIMECHE 1]

Please find the exception raised at the form creation and not at it's shutdown.

===============================================================================
Application Name      : PGFClient.exe
Memory manager        : msvcrt.dll
Compiler Version      : Delphi: 33
Indy Version          : 10.6.2.0
Zeos Version          : 7.2.6-stable
Report Unique ID      : {44B4A782-BEAF-4AB4-AEAC-5863139C89AC}
Start Time            : 2020-06-09 22:42:32.370
Exception Time        : 2020-06-09 22:43:08.037
Application up time   :  35 seconds 667 milliseconds
===============================================================================
Processor             : eMachines, eMachines G640, AMD64 Family 16 Model 6 Stepping 3, AMD Athlon(tm) II P320 Dual-Core Processor, 2.095 GHz
System                : Windows 10 (Version 10.0, Build 18362, 64-bit Edition)
Display               : 1680x1050 pixels, 96 bpp
Total Physical Memory :   5.748 GB
Free Physical Memory  :   2.211 GB
Max used Memory       :   179.254 MB
===============================================================================
Exception class       : EAccessViolation
Access violation at address 007D98E8 in module 'PGFClient.exe'. Read of address 0000000C
Exception trigger     : UnhandledException
-------------------------------------------------------------------------------
Module                : IdSSLOpenSSL
Command Line          : D:\Applications-Folder\PGFClient\PGFClient.exe
Procedure             : IdSSLOpenSSL.TIdSSLSocket.GetSSLError
Unit                  : IdSSLOpenSSL.pas
Line                  : 3647
-------------------------------------------------------------------------------
[007D98E8] IdSSLOpenSSL.TIdSSLSocket.GetSSLError (Line 3647, "IdSSLOpenSSL.pas" + 5) + $1
[007D87F4] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.CheckForError (Line 3134, "IdSSLOpenSSL.pas" + 4) + $8
[007952C0] IdIOHandler.TIdIOHandler.ReadFromSource (Line 1737, "IdIOHandler.pas" + 62) + $8
[0079B59A] IdIOHandlerStack.TIdIOHandlerStack.Connected (Line 243, "IdIOHandlerStack.pas" + 1) + $8
[007A153E] IdTCPConnection.TIdTCPConnection.Connected (Line 503, "IdTCPConnection.pas" + 7) + $4
[007DF0EE] uTCP.TTCPClient.Connected (Line 1664, "uTCP.pas" + 7) + $0
[00B29E3E] uAsyncTCP.TTCPAsyncThread.Connected (Line 383, "uAsyncTCP.pas" + 1) + $B
[00B2ADAD] uAsyncTCP.TTCPAsyncClient.Connect (Line 803, "uAsyncTCP.pas" + 14) + $7
[00DE888E] uClient.TMainForm.ControllerStart (Line 1760, "uClient.pas" + 47) + $9
[00BC5ECD] uMainForm.TUForm.SafeActivate (Line 1287, "uMainForm.pas" + 10) + $14
[00BC66FE] uMainForm.TUForm.WndProc (Line 1520, "uMainForm.pas" + 5) + $3
[0057980C] Vcl.Controls.TWinControl.MainWndProc + $2C
[004DDDDC] System.Classes.StdWndProc + $14
[0067606F] Vcl.Forms.TApplication.ProcessMessage + $F3
[006760B2] Vcl.Forms.TApplication.HandleMessage + $A
[006763E5] Vcl.Forms.TApplication.Run + $C9
[00E2C32D] PGFClient.PGFClient (Line 18, "" + -935) + $7

Would the creation of the the client into a thread be the problem?

type
  TTCPAsyncWorker=class(TTCPClient)
  private
  end;
////////////////////////////////////////////////////////////////////////
function TTCPAsyncClient.Connect(Client:TTCPClient):Boolean;
begin
  if FTerminated then Exit(False);
  Client.AssignConfig(FConfig);
  Client.Bound := False;
  if Client.Connected then Client.Disconnect;
  Result := False;
  if Client.Host<>'' then
  begin
    Client.Connect;
    Result := Client.Connected;
  end;
end;
////////////////////////////////////////////////////////////////////////
procedure TTCPAsyncThread.Execute;
var
  TCPHandler : TTCPHandler;
  Data       ,
  Pattern    : TBytes;
begin
  inherited;
  COMInitialize;
  InitRecord(TCPHandler,SizeOf(TCPHandler));
  FWorker              := TTCPAsyncWorker.Create(nil);
  TCPHandler.Worker    := FWorker;
  FWorker.SSLEnabled   := FAsyncClient.SSLEnabled;
  FWorker.Timeout      := IdTimeoutDefault;
  FWorker.OnConnect    := FAsyncClient.DoOnConnect;
  FWorker.OnDisconnect := FAsyncClient.DoOnDisconnect;
  FStarted             := True;
  while (not FAsyncClient.FTerminated) do
  begin
    RelinquishTimeSlice(20);
    if FAsyncClient.FTerminated then Break;
    if (FAsyncClient.Host='') or (FAsyncClient.Port=0) then Continue;
    while FWorker.Bound do
    begin
      if FAsyncClient.Tagged then
      begin
        TCPHandler.Data := FWorker.Read(TCPHandler.AsyncTag);
        if TCPHandler.Data=nil then
        begin
          RelinquishTimeSlice;
          Break;
        end;
        ProcessTagRead(TCPHandler);
      end
      else
      begin
        if (not FAsyncClient.DoOnWaitForData(TCPHandler,Data,Pattern)) then
        begin
          Disconnect;
          Break;
        end;
        MatchData(Data,Pattern);
      end;
    end;
    if FAsyncClient.FTerminated then Break;
    if (not Connected) then
    begin
      if FWorker.LastError<>0 then FAsyncClient.DoOnDisconnect(FWorker);
      FAsyncClient.Connect(FWorker);
    end;
  end;
  COMUninitialize;
  FreeAndNil(FWorker);
end;

Best regards.

[Remy Lebeau 1432]

18 hours ago, Hafedh TRIMECHE said:

Please find the exception raised at the form creation and not at it's shutdown.

That stack trace is useless without CONTEXT.  WHERE in your code is that AccessViolation occurring exactly?  At best, all I can gleam from this report is that a nil pointer is still being accessed.  Probably when the IOHandler's ReadFromSource() calls TIdSSLIOHandlerSocketOpenSSL.CheckForError(), which then calls fSSLSocket.GetSSLError() when fPassThrough is False.  But as I told you earlier, fSSLSocket cannot be nil when fPassThrough is False.  So where is the nil exactly?  You need to debug your code, I can't do it remotely for you.

18 hours ago, Hafedh TRIMECHE said:

Would the creation of the the client into a thread be the problem?

Usually no.  But I can't say for certain as you did not show ALL of your relevant code for how the client gets created and passed around and used.  It is really hard to follow your code.

 

Can you please do a separate test where you just create a simple thread that connects a simple TIdTCPClient and TIdSSLIOHandlerSocketOpenSSL to your server, without all the extra noise?  Do you still run into problems when doing that test?

[Hafedh TRIMECHE 1]

This TCP Client Wrapper is used for connecting to the server:

type
  TTCPClientNotify  = procedure(Client:TTCPClient) of object;
  TTCPClientVerify  = function(Client:TTCPClient;const Certificate:string):Boolean of object;

  TSSLOptions=class
  private
    FP12         : TBytes;
    FKeyPassword : string;
    FPEMCert     ,
    FPEMKey      : string;
    FCiphers     : string;
  public
    constructor Create;
    property    P12         : TBytes read FP12         write FP12;
    property    KeyPassword : string read FKeyPassword write FKeyPassword;
    property    Ciphers     : string read FCiphers     write FCiphers;
  end;

  TSSLIOClient = class(TIdSSLIOHandlerSocketOpenSSL)
  private
    FSSLOptions : TSSLOptions;
    FCACert     : PX509;
    FCert       : PX509;
    FPrivateKey : PEVP_PKEY;
    procedure InitSSLContext;
    property  PassThrough;
    function  GetPeerCert:string;
    function  GetPeerCommonName:string;
  protected
    procedure InitComponent;override;
  public
    destructor Destroy;override;
    property   SSLOptions:TSSLOptions read FSSLOptions write FSSLOptions;
    procedure  StartSSL;override;
    property   PeerCert       : string read GetPeerCert;
    property   PeerCommonName : string read GetPeerCommonName;
  end;

  TTCPConfig=
  packed record
    HostOrIP          : string;
    Port              : Integer;
    Tagged            : Boolean;
    MaxConnections    : Word;
    Timeout           : Integer;
    P12               : TBytes;
    KeyPassword       : string;
    Ciphers           : string;
    SSLEnabled        : Boolean;
    LinkCheckInterval : Integer;
  end;

  TTCPClient=class(TIdTCPClient)
  strict private
    property OnConnected;
    property OnDisconnected;
  private
  var
    FCS              : TTCPLock;
    FSSLHandler      : TSSLIOClient;
    FPeerCertificate : string;
    FCommonName      : string;
    FConfig          : TTCPConfig;
    FLastError       : Integer;
    FLastErrorDesc   : string;
    FBound           : Boolean;
    FOnConnect       : TTCPClientNotify;
    FOnVerify        : TTCPClientVerify;
    FOnDisconnect    : TTCPClientNotify;
    procedure ClearErrors;
    procedure SetHostOrIP(Value:string);
    procedure SetRemotePort(Value:Integer);
    procedure SetTagged(Value:Boolean);
    procedure SetTimeout(Value:Integer);
    procedure SetP12(Value:TBytes);
    procedure SetKeyPassword(Value:string);
    procedure SetCiphers(Value:string);
    procedure SetSSLEnabled(Value:Boolean);
    function  GetPeerInfo(Index:Integer):string;
    procedure HandleException(AException:Exception);
    procedure SetBound(Value:Boolean);
  protected
    procedure InitComponent;override;
    procedure DoOnConnected;override;
    procedure DoOnDisconnected;override;
    function  DoOnVerify(const PEMCert:string):Boolean;virtual;
  public
    Destructor Destroy;override;
    procedure  Lock;
    procedure  Unlock;
  public
    property  Host          : string           read FConfig.HostOrIP    write SetHostOrIP;
    property  Port          : Integer          read FConfig.Port        write SetRemotePort;
    property  Tagged        : Boolean          read FConfig.Tagged      write SetTagged;
    property  Timeout       : Integer          read FConfig.Timeout     write SetTimeout;
    property  P12           : TBytes           read FConfig.P12         write SetP12;
    property  KeyPassword   : string           read FConfig.KeyPassword write SetKeyPassword;
    property  Ciphers       : string           read FConfig.Ciphers     write SetCiphers;
    property  SSLEnabled    : Boolean          read FConfig.SSLEnabled  write SetSSLEnabled;
    procedure SetError(ErrorCode:Integer;ErrorDesc:string);
    procedure AssignConfig(Config:TTCPConfig);
    procedure Connect;overload;override;
    procedure Connect(const AHost:string;const APort:Integer);reintroduce;overload;
    procedure Reconnect;
    procedure Disconnect(ANotifyPeer:Boolean);override;
    function  Connected:Boolean;override;
    property  Bound : Boolean read FBound write SetBound;
  public
    property  LastError       : Integer read FLastError;
    property  LastErrorDesc   : string  read FLastErrorDesc;

    property  PeerCertificate : string index 1 read GetPeerInfo;
    property  CommonName      : string index 2 read GetPeerInfo;
  public
    property  OnConnect    : TTCPClientNotify read FOnConnect    write FOnConnect;
    property  OnVerify     : TTCPClientVerify read FOnVerify     write FOnVerify;
    property  OnDisconnect : TTCPClientNotify read FOnDisconnect write FOnDisconnect;
  end;

implementation

procedure HandleSocketException(E:Exception;var SocketError:Integer);
begin
  if E=nil then SocketError := 0 else
  begin
    SocketError := WSANO_RECOVERY;
    if (E is EIdSocketError)          then SocketError := (E as EIdSocketError).LastError else
    if (E is EIdOpenSSLError)         then SocketError := Id_WSAENOPROTOOPT               else
    if (E is EIdReadTimeout)          then SocketError := Id_WSAETIMEDOUT                 else
    if (E is EIdConnClosedGracefully) then SocketError := Id_WSAEHOSTDOWN                 else
    if (E is EIdAlreadyConnected)     then SocketError := Id_WSAEISCONN                   ;
  end;
end;
///////////////////////////////////////////////////////////////////////////
constructor TSSLOptions.Create;
begin
  LoadOpenSSL;
  FP12         := nil;
  FKeyPassword := '';
  FPEMCert     := '';
  FPEMKey      := '';
  FCiphers     := '';
end;
///////////////////////////////////////////////////////////////////////////
function VerifyCallback(ok:TIdC_INT;ctx:PX509_STORE_CTX):TIdC_INT;cdecl;
begin
  Result := 1;
end;

function TSSLIOClient.GetPeerCert: string;
begin
  if Assigned(fSSLSocket) and Assigned(fSSLSocket.PeerCert) then Result := TCPX509ToPEM(fSSLSocket.PeerCert.Certificate)
                                                            else Result := '';
end;

function TSSLIOClient.GetPeerCommonName:string;
begin
  if Assigned(fSSLSocket) and Assigned(fSSLSocket.PeerCert) then Result := TCPX509Name(fSSLSocket.PeerCert.Certificate)
                                                            else Result := '';
end;

procedure TSSLIOClient.InitComponent;
begin
  LoadOpenSSL;
  inherited;
  FCACert              := nil;
  FCert                := nil;
  FPrivateKey          := nil;
  FSSLOptions          := TSSLOptions.Create;
  FSSLOptions.FCiphers := SSLClientCiphers;
  PassThrough          := False;
end;

destructor TSSLIOClient.Destroy;
begin
  Close;
  if FCACert    <>nil then X509_free(FCACert);
  if FCert      <>nil then X509_free(FCert);
  if FPrivateKey<>nil then EVP_PKEY_free(FPrivateKey);
  FreeAndNil(FSSLOptions);
  inherited;
end;

type
  TTCPSSLContext = class(TIdSSLContext)
  public
    constructor Create;
  end;

constructor TTCPSSLContext.Create;
const
  SSLVersion = High(TIdSSLVersion);
begin
  inherited;
  RootCertFile := '';
  CertFile     := '';
  KeyFile      := '';
  DHParamsFile := '';
  VerifyDepth  := 0;
  VerifyMode   := [];
  VerifyDirs   := '';
  CipherList   := '';
  VerifyOn     := False;
  StatusInfoOn := False;
  Method       := sslvSSLv23;
  SSLVersions  := [SSLVersion,Pred(SSLVersion)];
end;

procedure TSSLIOClient.InitSSLContext;
begin
  if Assigned(fSSLContext) then FreeAndNil(fSSLContext);
  fSSLContext              := TTCPSSLContext.Create;
  fSSLContext.Parent       := Self;
  fSSLContext.StatusInfoOn := Assigned(fOnStatusInfo) or Assigned(fOnStatusInfoEx);
  fSSLContext.Mode         := sslmClient;
  TTCPSSLContext(fSSLContext).InitContext(sslCtxClient);
end;

procedure TSSLIOClient.StartSSL;
var
  Error   : Integer;
  FSSLCtx : PSSL_CTX;
begin
  InitSSLContext;
  FSSLCtx := TTCPSSLContext(fSSLContext).fContext;
  Error   := SSL_CTX_set_options(FSSLCtx,SSL_OP_STRONG);
  if Error>0 then
  begin
    SSL_CTX_set_mode(FSSLCtx,SSL_MODE_AUTO_RETRY);
    PrepareSSL(FSSLOptions,FCACert,FCert,FPrivateKey);
    if Assigned(FPrivateKey) and Assigned(FCACert) and Assigned(FCert) then
    begin
      if Error>0 then Error := SSL_CTX_use_certificate(FSSLCtx,FCert);
      if Error>0 then Error := SSL_CTX_use_PrivateKey(FSSLCtx,FPrivateKey);
      if Error>0 then Error := SSL_CTX_check_private_key(FSSLCtx);
    end;
    SSL_CTX_set_verify(FSSLCtx,SSL_VERIFY_PEER,VerifyCallback);
    SSL_CTX_set_verify_depth(FSSLCtx,1);
    if Error>0 then Error := SSL_CTX_ctrl(FSSLCtx,SSL_CTRL_SET_ECDH_AUTO,1,nil);
    if (Error>0) and (FSSLOptions.FCiphers<>'') then
    begin
      Error := SSL_CTX_set_cipher_list(FSSLCtx,PAnsiChar(RawByteString(FSSLOptions.FCiphers)));
    end;
  end;
  if Error<=0 then
  begin
    FreeAndNil(fSSLContext);
    EIdOSSLCreatingContextError.RaiseException(RSSSLCreatingContextError);
  end;
  inherited;
end;
///////////////////////////////////////////////////////////////////////////
procedure TTCPClient.InitComponent;
begin
  LoadOpenSSL;
  InitRecord(FConfig,SizeOf(FConfig));
  inherited;
  FCS              := TTCPLock.Create(ClassName);
  Tagged           := False;
  FSSLHandler      := TSSLIOClient.Create(Self);
  FPeerCertificate := '';
  FCommonName      := '';
  FBound           := False;
  FOnConnect       := nil;
  FOnVerify        := nil;
  FOnDisconnect    := nil;
  OnConnected      := nil;
  OnDisconnected   := nil;
  Timeout          := IdTimeoutDefault;
  Ciphers          := 'DEFAULT';
  SSLEnabled       := False;
end;

procedure TTCPClient.Lock;
begin
  FCS.Lock;
end;

procedure TTCPClient.Unlock;
begin
  FCS.Unlock;
end;

procedure TTCPClient.SetHostOrIP(Value: string);
var
  _Port   : Integer;
  _Params : string;
begin
  Value := ParseURI(Trim(Value),0,_Port,_Params);
  if (FConfig.HostOrIP=Value) and (FConfig.Port=_Port) then Exit;
  Lock;
  FConfig.HostOrIP := Value;
  if _Port>0 then FConfig.Port := _Port;
  Unlock;
end;

procedure TTCPClient.SetRemotePort(Value: Integer);
begin
  if FConfig.Port=Value then Exit;
  Lock;
  FConfig.Port := Value;
  Unlock;
end;

procedure TTCPClient.SetTagged(Value:Boolean);
begin
  if FConfig.Tagged=Value then Exit;
  if Connected then raise TCPException.Create('Tagged can only be set when connection is closed !...');
  Lock;
  FConfig.Tagged := Value;
  Unlock;
end;

procedure TTCPClient.SetTimeout(Value:Integer);
begin
  if Value<=0 then Value := IdTimeoutDefault;
  if FConfig.Timeout=Value then Exit;
  Lock;
  FConfig.Timeout := Value;
  ReadTimeout     := TimeoutMS(FConfig.Timeout);
  Unlock;
end;

procedure TTCPClient.SetP12(Value:TBytes);
begin
  if Similar(Value,FConfig.P12) then Exit;
  Lock;
  FConfig.P12 := Value;
  Unlock;
end;

procedure TTCPClient.SetKeyPassword(Value: string);
begin
  Value := Trim(Value);
  if FConfig.KeyPassword=Value then Exit;
  Lock;
  FConfig.KeyPassword := Value;
  Unlock;
end;

procedure TTCPClient.SetCiphers(Value: string);
begin
  Value := Trim(Value);
  if FConfig.Ciphers=Value then Exit;
  Lock;
  FConfig.Ciphers := Value;
  Unlock;
end;

procedure TTCPClient.SetSSLEnabled(Value:Boolean);
begin
  if FConfig.SSLEnabled=Value then Exit;
  Lock;
  FConfig.SSLEnabled := Value;
  Unlock;
end;

destructor TTCPClient.Destroy;
begin
  Disconnect;
  FreeAndNil(FCS);
  inherited;
end;

function TTCPClient.DoOnVerify(const PEMCert:string):Boolean;
begin
  if Assigned(FOnVerify) then Result := FOnVerify(Self,PEMCert)
                         else Result := True;
end;

procedure TTCPClient.DoOnConnected;
begin
  inherited;
  Socket.Binding.SetKeepAliveValues(True,KeepAliveDefault,KeepAliveIntervalDefault);
  if Assigned(FSSLHandler) then
  begin
    FPeerCertificate := FSSLHandler.PeerCert;
    FCommonName      := FSSLHandler.PeerCommonName;
  end
  else
  begin
    FPeerCertificate := '';
    FCommonName      := '';
  end;
  if DoOnVerify(FPeerCertificate) then
  begin
    if Assigned(FOnConnect) then FOnConnect(Self);
    if Assigned(FCompressor) then FCompressor.FActive := True;
  end
  else Disconnect;
end;

procedure TTCPClient.SetBound(Value:Boolean);
begin
  Lock;
  FBound := Value;
  Unlock;
end;

procedure TTCPClient.DoOnDisconnected;
begin
  inherited;
  if Assigned(FOnDisconnect) then FOnDisconnect(Self);
end;

function TTCPClient.GetPeerInfo(Index:Integer): string;
begin
  case Index of
    1 : Result := FPeerCertificate;
    2 : Result := FCommonName;
  end;
end;

procedure TTCPClient.AssignConfig(Config:TTCPConfig);
begin
  FConfig.HostOrIP          := Config.HostOrIP;
  FConfig.Port              := Config.Port;
  FConfig.Tagged            := Config.Tagged;
  FConfig.Timeout           := Config.Timeout;
  FConfig.P12               := Config.P12;
  FConfig.KeyPassword       := Config.KeyPassword;
  FConfig.Ciphers           := Config.Ciphers;
  FConfig.SSLEnabled        := Config.SSLEnabled;
  FConfig.LinkCheckInterval := Config.LinkCheckInterval;
end;

procedure TTCPClient.HandleException(AException: Exception);
begin
  inherited;
  HandleSocketException(AException,FLastError);
  Lock;
  FLastErrorDesc := AException.Message;
  Unlock;
end;

procedure TTCPClient.ClearErrors;
begin
  Lock;
  FLastError     := 0;
  FLastErrorDesc := '';
  Unlock;
end;

procedure TTCPClient.SetError(ErrorCode:Integer;ErrorDesc: string);
begin
  Lock;
  FLastError     := ErrorCode;
  FLastErrorDesc := ErrorDesc;
  Unlock;
end;

function TTCPClient.Connected: Boolean;
begin
  try
    Result := (inherited Connected);
  except
    Result := False;
  end;
end;

procedure TTCPClient.Disconnect(ANotifyPeer:Boolean);
begin
  try
    inherited Disconnect(ANotifyPeer);
  except
  end;
end;

procedure TTCPClient.Connect;
var
  LConfig : TTCPConfig;
begin
  Lock;
  LConfig := FConfig;
  Unlock;
  if LConfig.HostOrIP='' then Exit;
  Disconnect;
  try
    inherited Host := LConfig.HostOrIP;
    inherited Port := LConfig.Port
  except
  end;
  if LConfig.SSLEnabled then IOHandler := FSSLHandler
                        else IOHandler := nil;
  try
    inherited Connect;
  except
    on E: Exception do HandleException(E);
  end;
end;

procedure TTCPClient.Connect(const AHost:string;const APort:Integer);
begin
  SetHostOrIP(AHost);
  SetRemotePort(APort);
  Connect;
end;

procedure TTCPClient.Reconnect;
begin
  Connect;
end;
///////////////////////////////////////////////////////////////////////////

TTCPClient connection is invoked from a the Thread Pool:

function TTCPAsyncClient.Connect(Client:TTCPClient):Boolean;
begin
  if FTerminated then Exit(False);
  Client.AssignConfig(FConfig);
  Client.Bound := False;
  if Client.Connected then Client.Disconnect;
  Result := False;
  if Client.Host<>'' then
  begin
    Client.Connect;
    Result := Client.Connected;
  end;
end;

But this exception is raised:

===============================================================================
Application Name      : PGFClient.exe
Memory manager        : msvcrt.dll
Compiler Version      : Delphi: 33
Indy Version          : 10.6.2.0
Zeos Version          : 7.2.6-stable
Report Unique ID      : {E824D1A9-DCC4-4F71-ADC7-0882AB6D23DD}
Start Time            : 2020-06-10 20:05:08.588
Exception Time        : 2020-06-10 20:05:58.583
Application up time   :  49 seconds 995 milliseconds
===============================================================================
Processor             : eMachines, eMachines G640, AMD64 Family 16 Model 6 Stepping 3, AMD Athlon(tm) II P320 Dual-Core Processor, 2.095 GHz
System                : Windows 10 (Version 10.0, Build 18362, 64-bit Edition)
Display               : 1680x1050 pixels, 96 bpp
Total Physical Memory :   5.748 GB
Free Physical Memory  :   1.772 GB
Max used Memory       :   174.250 MB
===============================================================================
Exception class       : EAccessViolation
Access violation at address 007D7F78 in module 'PGFClient.exe'. Read of address 0000000C
Exception trigger     : UnhandledException
-------------------------------------------------------------------------------
Module                : IdSSLOpenSSL
Command Line          : D:\Applications-Folder\PGFClient\PGFClient.exe
Procedure             : IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.Readable
Unit                  : IdSSLOpenSSL.pas
Line                  : 2846
-------------------------------------------------------------------------------
[007D7F78] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.Readable (Line 2846, "IdSSLOpenSSL.pas" + 3) + $6
[00620030] Vcl.Themes.{System.Generics.Collections}TList<Vcl.Themes.TStyleHookClass>.GetCapacity + $8
[0079517D] IdIOHandler.TIdIOHandler.ReadFromSource (Line 1696, "IdIOHandler.pas" + 21) + $8
[0079B59A] IdIOHandlerStack.TIdIOHandlerStack.Connected (Line 243, "IdIOHandlerStack.pas" + 1) + $8
[007A153E] IdTCPConnection.TIdTCPConnection.Connected (Line 503, "IdTCPConnection.pas" + 7) + $4
[007DF064] uTCP.TTCPClient.Connected (Line 1653, "uTCP.pas" + 2) + $0
[00B29DAA] uAsyncTCP.TTCPAsyncThread.Connected (Line 383, "uAsyncTCP.pas" + 1) + $B
[00B2AD19] uAsyncTCP.TTCPAsyncClient.Connect (Line 803, "uAsyncTCP.pas" + 14) + $7
[00DE881E] uClient.TMainForm.ControllerStart (Line 1760, "uClient.pas" + 47) + $9
[00BC5E71] uMainForm.TUForm.SafeActivate (Line 1288, "uMainForm.pas" + 10) + $14
[00BC66A6] uMainForm.TUForm.WndProc (Line 1521, "uMainForm.pas" + 5) + $3
[0057980C] Vcl.Controls.TWinControl.MainWndProc + $2C
[004DDDDC] System.Classes.StdWndProc + $14
[0067606F] Vcl.Forms.TApplication.ProcessMessage + $F3
[006760B2] Vcl.Forms.TApplication.HandleMessage + $A
[006763E5] Vcl.Forms.TApplication.Run + $C9
[00E2C32D] PGFClient.PGFClient (Line 18, "" + -935) + $7

 

Edited June 10, 2020 by Hafedh TRIMECHE

[Hafedh TRIMECHE 1]

The function Readable is overridden to avoid exception.

type
  TIdSSLSocketWrapper=class(TIdSSLSocket);

function TSSLIOClient.Readable(AMSec:Integer):Boolean;
var
  IdSSLSocketWrapper : TIdSSLSocketWrapper;
begin
  IdSSLSocketWrapper := TIdSSLSocketWrapper(fSSLSocket);
  Result             := Assigned(IdSSLSocketWrapper) and Assigned(IdSSLSocketWrapper.fSSL);
  Result             := Result and inherited;
end;

 

[Hafedh TRIMECHE 1]

Now the exception is raised inside OpenSSL libraries (libeay32.dll) EC_GROUP_get_degree:

===============================================================================
Application Name      : PGFClient.exe
Memory manager        : msvcrt.dll
Compiler Version      : Delphi: 33
Indy Version          : 10.6.2.0
Zeos Version          : 7.2.6-stable
Report Unique ID      : {17CF23EB-3608-40C5-B1F7-3EB94BA7BA55}
Start Time            : 2020-06-10 21:15:28.616
Exception Time        : 2020-06-10 21:16:06.970
Application up time   :  38 seconds 354 milliseconds
===============================================================================
Processor             : eMachines, eMachines G640, AMD64 Family 16 Model 6 Stepping 3, AMD Athlon(tm) II P320 Dual-Core Processor, 2.095 GHz
System                : Windows 10 (Version 10.0, Build 18362, 64-bit Edition)
Display               : 1680x1050 pixels, 96 bpp
Total Physical Memory :   5.748 GB
Free Physical Memory  :   1.553 GB
Max used Memory       :   180.152 MB
===============================================================================
Exception class       : EAccessViolation
Access violation at address 62A56256 in module 'libeay32.dll'. Read of address FEEEFF0E
Exception trigger     : UnhandledException
-------------------------------------------------------------------------------
Module                : 
Command Line          : D:\Applications-Folder\PGFClient\PGFClient.exe
Procedure             : EC_GROUP_get_degree
-------------------------------------------------------------------------------
[62A56256] EC_GROUP_get_degree + $6
[00554DEB] System.SyncObjs.TCriticalSection.Release + $B
[007D6C49] IdSSLOpenSSL.SslLockingCallback (Line 2249, "IdSSLOpenSSL.pas" + 16) + $5
[00409A5C] System.TMonitor.Enter + $10
[00409F34] System.TMonitor.TryEnter + $28
[00409BEA] System.TMonitor.Exit + $6
[007D9E51] IdSSLOpenSSL.TIdSSLSocket.Connect (Line 3782, "IdSSLOpenSSL.pas" + 36) + $B
[007D85BE] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.OpenEncodedConnection (Line 3091, "IdSSLOpenSSL.pas" + 54) + $13
[007D7EDE] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.StartSSL (Line 2819, "IdSSLOpenSSL.pas" + 2) + $2
[007D7EC1] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.ConnectClient (Line 2813, "IdSSLOpenSSL.pas" + 23) + $5
[0079F12A] IdIOHandlerSocket.TIdIOHandlerSocket.Open (Line 369, "IdIOHandlerSocket.pas" + 13) + $4
[007D7F56] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.Open (Line 2839, "IdSSLOpenSSL.pas" + 2) + $0
[0079AB5C] IdTCPClient.TIdTCPClientCustom.Connect (Line 328, "IdTCPClient.pas" + 54) + $B
[0079596D] IdIOHandler.TIdIOHandler.SetHost (Line 1958, "IdIOHandler.pas" + 1) + $8
[007DF1FF] uTCP.TTCPClient.Connect (Line 1699, "uTCP.pas" + 14) + $3
[00B2ACB1] uAsyncTCP.TTCPAsyncClient.Connect (Line 774, "uAsyncTCP.pas" + 8) + $4
[00B29FF4] uAsyncTCP.TTCPAsyncThread.Execute (Line 442, "uAsyncTCP.pas" + 42) + $6
[004DA455] System.Classes.ThreadProc + $49
[0040ADAC] System.ThreadWrapper + $28

 

[Hafedh TRIMECHE 1]

Exceptions are raised if Connected function is called before a connection attempt is made using Connect method.

the variable FConnectionAttempt is introduced and initialized to False within the overridden InitComponent method:

procedure TTCPClient.InitComponent;
begin
  LoadOpenSSL;
  InitRecord(FConfig,SizeOf(FConfig));
  inherited;
  FConnectionAttempt := False;
  IOHandler          := nil;
  FCS                := TTCPLock.Create(ClassName);
  Tagged             := False;
  CompressClass      := nil;
  FSSLHandler        := TSSLIOClient.Create(Self);
  FPeerCertificate   := '';
  FCommonName        := '';
  FBound             := False;
  FOnConnect         := nil;
  FOnVerify          := nil;
  FOnDisconnect      := nil;
  OnConnected        := nil;
  OnDisconnected     := nil;
  Timeout            := IdTimeoutDefault;
  Ciphers            := 'DEFAULT';
  SSLEnabled         := False;
end;

function TTCPClient.Connected:Boolean;
begin
  if (not FConnectionAttempt) then Exit(False);
  try
    Result := (inherited Connected);
  except
    Result := False;
  end;
end;

procedure TTCPClient.Connect;
var
  LConfig : TTCPConfig;
begin
  Lock;
  LConfig := FConfig;
  Unlock;
  if LConfig.HostOrIP='' then Exit;
  Disconnect;
  try
    inherited Host := LConfig.HostOrIP;
    inherited Port := LConfig.Port
  except
  end;
  if LConfig.SSLEnabled then IOHandler := FSSLHandler
                        else IOHandler := nil;
  try
    inherited Connect;
  except
    on E: Exception do HandleException(E);
  end;
  FConnectionAttempt := True;
end;

It seams that calling Connected function before invoking Connect method generates an access to components/objects not already initialized (fSSLSocket and/or fSSL).

 

After modification made, no exception is raised.

 

Edited June 12, 2020 by Hafedh TRIMECHE

[Remy Lebeau 1432]

5 hours ago, Hafedh TRIMECHE said:

Exceptions are raised if Connected function is called before a connection attempt is made using Connect method.

Can you be more specific?  What is the actual exception that is being raised?  Connect() does call Connected(), but it should not raise an exception if there is no connection.  And if that exception is due to your earlier issues with fSSLSocket being nil, your recent patches should have addressed that.

 

Honestly, you are the only person who seems to be having so many problems with TIdSSLIOHandlerSocketOpenSSL.  Other people use it all the time just fine.  So either you are just not using it correctly (and you posted WAY too much code for me to go through it all - I asked you to test a simple example that doesn't use your wrappers at all), or maybe your Indy installation is faulty/corrupted - have you tried upgrading to the latest Indy release yet?

5 hours ago, Hafedh TRIMECHE said:

It seams that calling Connected function before invoking Connect method generates an access to components/objects not already initialized (fSSLSocket and/or fSSL).

It should not be doing that.  Rather than continuing to apply band-aid patches, have you tried actually debugging the IOHandler's startup to figure out why it is in such a bad state to begin with?  Because what you have described so far is NOT how it is supposed to behave under normal conditions.  Which makes me wonder if maybe there are other problems in your code that may be corrupting memory and the IOHandler is just the victim of that.

 

[Guest]

On 6/10/2020 at 11:21 PM, Hafedh TRIMECHE said:

Now the exception is raised inside OpenSSL libraries (libeay32.dll) EC_GROUP_get_degree:

That stack makes no sense, in my opinion the only logic can explain to get to EC_GROUP_get_degree from System.SyncObjs.TCriticalSection.Release is that the stack had been corrupted (overwritten). so start at that connect function and double check your local vars for overflows.

[Guest]

I forgot to mention another situation can lead to stack corruption like that, check the OpenSSL functions you are calling ( or you have added ) , make sure they all do have the stdcall calling convention.