Stable Communication between ICS TSslWSocket and TSslWSocketServer

[idontknow 0]

Hello Community,

 

since last week I have been trying to let a TsslWSocket and a TsslWSocketServer communicate with each other.

 

I want to get a long-term stable connection between a TCP client and a TCP server that is secured with TLS1.3. However, after a runtime of a few minutes, the data transfer breaks down.

 

There is a client thread and a server thread. In the respective Execute method I create the socket and initialize it, call Listen (server) or Connect (client) and run the MessageLoop.

 

After a successful SSL handshake, my client sends 128KB data packets to the server.

 

The data arrives at the server, TwSocketClient.onDataAvailable is triggered, the bytes can be read there with TwSocketClient (Sender).Receive (pBuffer ...).

 

When the server has received 128KB, it sends an "ACK" packet to the client (An AnsiString "ACK", 3 bytes).

When the client receives the packet, it sends again 128KB of testdata.

This works a few thousand, sometimes some tenthousands times, until TwSocketClient.onDataAvailable is suddenly no longer called.

There is no OnSessionClosed, no onError, no onException and also no onBgException that would indicate a problem.

 

Apparently the problem is on the client side: A running Wireshark shows an [ACK] packet from the server to the client as last entry. Further clicks on the "Manual Send" button do not lead to any further lines in the Wireshark log.

 

When this state has been reached another client can connect to the server without any problems, so the server is not completely dead.

 

I have no idea what I could do wrong ...

 

Maybe it's not ok to send in the context of another thread? But how is that supposed to work when the client thread is blocked by the MessageLoop?

 

Simultaneous web browsing leads to the problem faster. When I look at any website, it usually takes less than half a minute to see the problem. 

 

My test project is attached. I would be interested to know if you have observed the same problem and if anyone has a guess as to what might be the cause ... 

 

The project is complete, the Win32 folder also contains the certificate used for testing ... 

 

Usage: Enter your own IP address, press the "btCreateStart" button, then the "btSendData Manual Send" button. 

 

The "logICStest.log" file in the program directory grows until the problem occurs ... 

 

Thanks in advance... 

 

P.S: I have already tried not to send after receiving the ACK packet, but cyclically via timer or thread. If you can select both in the test project with checkboxes, the result is the same. The problem does not only occur with TLS1.3, also with TLS1.2. I even think it shows up without encryption, just takes longer ... 

 

I crossposted this in the german Delphi-Praxis in german language (https://www.delphipraxis.net/205223-stabile-tcp-verbindung-mit-ics-ich-kriegs-nicht-hin.html)...

 

Test Overbyte ISC Client und Server.7z

[Angus Robertson 574]

I would suggest you test the OverbyteIcsIpStmLogTst sample, the demo has a local mode where it acts as both client and server sending packets to each other. 

 

I've used this component in several applications  for 10 year or more, and SSL connections of days are commom, if they drop the client retries.  It will also order and install it's own SSL/TLS certificates. 

 

Angus

 

[Fr0sT.Brutal 900]

I would check if your thread stuff is correct. With ICS you usually don't need threads.

procedure TServerThread.ScDataAvailable(Sender: TObject; ErrCode: Word);
begin
  if ErrCode = 0 then
  begin
    Socket := TwSocketClient(Sender);
    while (True) do
    begin
      BytesReceived := Socket.Receive(pBuffer, 32768);
      if BytesReceived <= 0 then
        Exit;
    end;
  end
end

This is wrong.

I guess you've come from blocking socket world. ICS is async so you've to learn its completely different approach.

Edited August 13, 2020 by Fr0sT.Brutal

[idontknow 0]

Hi Angus,

 

thank you very much, i will look in the example code, especially the possibility to automatically order certificates sounds very good. 

But i really would like to understand what I'm doing wrong.

 

Hi Fr0sT.Brutal,

 

thank you, too. i tried a very lot of things. I suppose you mean the while loop. I know the OnDataAvailable will trigger again, if i don't read everything from the receive buffer.

But even if i don't use a while loop, the client hangs after some packets... the last run was more than 18000 Packets, then the same thing...

 

13.08.2020 17:16:23.963 [07056] scDataAvailable
13.08.2020 17:16:23.963 [09372] MessageHandler: Server hat 18233 128KB-Pakete empfangen
13.08.2020 17:16:23.964 [09372] MessageHandler: Client hat 3 Bytes empfangen
13.08.2020 17:16:23.964 [09372] Sende 128KB, Paket #18233
13.08.2020 17:16:23.966 [07056] scDataAvailable
13.08.2020 17:16:23.966 [07056] scDataAvailable
13.08.2020 17:16:23.967 [07056] scDataAvailable
13.08.2020 17:16:23.967 [15264] TClientThread.ClientDataSent: ErrCode=0
13.08.2020 17:16:23.967 [07056] scDataAvailable
13.08.2020 17:16:23.968 [07056] scDataAvailable
13.08.2020 17:16:23.970 [07056] scDataAvailable
13.08.2020 17:16:23.971 [07056] scDataAvailable
13.08.2020 17:16:23.974 [07056] scDataAvailable
13.08.2020 17:16:23.975 [09372] MessageHandler: Server hat 18234 128KB-Pakete empfangen
13.08.2020 17:16:23.975 [09372] MessageHandler: Client hat 3 Bytes empfangen
13.08.2020 17:16:23.986 [15264] TClientThread.ClientDataSent: ErrCode=0
13.08.2020 17:16:23.986 [09372] Sende 128KB, Paket #18234
 

Server:

procedure TServerThread.ScDataAvailable(Sender: TObject; ErrCode: Word);
var
  Socket: TWSocketClient;
  pBuffer: PByte;
  BytesReceived: Integer;
  AckAnsiString: AnsiString;
begin
  Info('scDataAvailable');
  if ErrCode = 0 then
  begin
    Socket := TwSocketClient(Sender);
    Getmem(pBuffer, 32768);
    BytesReceived := Socket.Receive(pBuffer, 32768);
    FreeMem(pBuffer); // It's only a Test: Purge the Data, but count the Bytes

    if BytesReceived >= 0 then
      ServerBytesReceivedComplete := ServerBytesReceivedComplete + BytesReceived;

    if ServerBytesReceivedComplete >= 128*1024 then
    begin
      // Fine, received 128KB or more. PostMessage WM_SERVER_HAS_RECEIVED_DATA... just for logging...
      CountPackets := CountPackets+1;
      ServerBytesReceivedComplete := ServerBytesReceivedComplete - 128*1024;
      PostMessage(Form1.Handle, WM_SERVER_HAS_RECEIVED_DATA, CountPackets, 0);

      // Send AnsiString 'ACK' to Client
      AckAnsiString := 'ACK';
      Socket.Send(TWSocketData(@AckAnsiString[1]), 3);
    end;
  end
  else
    Info('TServerThread.ScDataAvailable: ErrCode=%d', [ErrCode]);
end;

Client:

procedure TClientThread.ClientDataAvailable(Sender: TObject; ErrCode: Word);
var
  Socket: TWSocket;
  pBuffer: PByte;
  BytesReceived: Integer;
begin
  // Mal so wie in D:\development\!Delphi\Components\Overbyte ICS\trunk\Samples\Delphi\SslInternet\OverbyteIcsSimpleSslCli.dproj
  if ErrCode = 0 then
  begin
    Socket := TwSocketClient(Sender);

    Getmem(pBuffer, 128);
    BytesReceived := Socket.Receive(pBuffer, 128);
    FreeMem(pBuffer); // Only a Test, purge the Bytes but count them...

    if BytesReceived > 0 then
    begin
      // Count them
      ClientBytesReceivedComplete := ClientBytesReceivedComplete + BytesReceived;
      if ClientBytesReceivedComplete >= Length('ACK') then
      begin
        ClientBytesReceivedComplete := ClientBytesReceivedComplete - Length('ACK');

        // to keep it simple: that was 3 Bytes, in my testcase nothing else will send by the server...
        PostMessage(Form1.Handle, WM_CLIENT_HAS_RECEIVED_DATA, BytesReceived, 0);
        // Reaction in Form1: WM_CLIENT_HAS_RECEIVED_DATA -> ClientThread.Client.Send(AnsiStringWith128KB)
      end;
    end;

  end
  else
    Info('TClientThread.ClientDataAvailable: ErrCode=%d', [ErrCode]);
end;

 

Main (VCL-Thread):

procedure TForm1.MessageHandlerClientReceivedData(var Msg: TMessage);
begin
  Info('MessageHandler: Client has received an ACK');
  if CheckBoxAutoSendAfterReceivingAck.Checked then
  	btSendDataClick(nil); // Send 128KB-Packet to Server
end;

and:

procedure TForm1.btSendDataClick(Sender: TObject);
var
  i: Integer;
  Text: AnsiString;
  BytesSend: Integer;
begin
  if Assigned(Client) then
  begin
    SetLength(Text, 128 * 1024); // 128KB
    for i := 1 to Length(Text) do
      Text[i] := AnsiChar(Ord('A')+ (i mod 26)); // ABCDEFG...XYZABCDEFG...

    BytesSend := Client.ClientSocket.Send(TWSocketData(@Text[1]), Length(Text));

    if BytesSend = Length(Text) then
    begin
      Info('Sende 128KB, Paket #%d', [GesendetePakete]);   // always comes...
      Inc(GesendetePakete);
    end else
    begin
      Info('Fehler: Paket konnte nicht gesendet werden');  // never comes...
    end;

  end
  else
    Info('Fehler: Client=nil');
end;

What am I doing wrong?

 

 

[Angus Robertson 574]

We have explained why threads are very rarely necessary in ICS applications a few times in this forum.  I don't debug such applications. 

 

Angus

 

[Fr0sT.Brutal 900]

13 minutes ago, idontknow said:

But even if i don't use a while loop, the client hangs after some packets... the last run was more than 18000 Packets, then the same thing...

I'd advice you to get rid of threads and try very-very simple case. Like Angus said, threads in ICS are pretty advanced thing

[Guest]

I tried your example and i agree with Agnus and Fr0sT.Brutal, few will have spare hours to track this,

So if you need help, i suggest to simplify that test with one thread for client and one for server and separate them, unless being in the same application is the cause, because i have good news or lets say something to start with.

 

I didn't fire My WireShark as your example already eating most of disk storage with huge logs, and i don't want to close my IDE and reinstall a workaround for loop back or start to debug over internet, but i used the next good thing, Process Monitor

After thousands of sending it always stop with this

 

Those packets !, i don't think belongs to ICS per se but most likely to OpenSSL, either some sort of renegotiating or heartbeat or something else..

Those what you need to track in WireShark, if you managed to capture them bring them here for autopsy, just those two 176 bytes and 25 bytes, do you have them with no SSL/TLS connection ?

 

Sorry couldn't help more, but if it is coming form OpenSSL then this is serious, or even worse if it is coming from being client and server in same application.

[Angus Robertson 574]

Quote

i will look in the example code, especially the possibility to automatically order certificates sounds very good. 

That is actually part of TSslSocketServer providing you are using IcsHosts to configure it which handles all the SSL stuff for you, even creating a self signed certificate automatically if nothing supplied so it can start and order one from Let's Encrypt.

 

Angus

 

[idontknow 0]

The problem seems to be the usage of TwSocket from inside a Thread.

 

I have left the ServerThread unchanged, but the Client is running in the VCL-Thread Context now.

 

I have no problems anymore, the test is still running and has transferred more than 1200000 packets right now, i will test it over night.

 

I created the TwSocket from inside Thread.Execute, told him it shall use MultiThreading, and had a message loop running inside the TClientThread.

 

But maybe my approach to send from the vcl thread like TClientThread.Client.Send(...) was the problem, but i don't know how to send from within the ClientThread Context, if the ClientThread is running its messageloop.

 

Thanks and Good Night,

 

Oliver

[aehimself 396]

2 hours ago, Kas Ob. said:

Those packets !, i don't think belongs to ICS per se but most likely to OpenSSL, either some sort of renegotiating or heartbeat or something else..

That was my initial thought when I started to read this thread. In cases like this I try to disable as much 3-rd party dependencies as I possibly can to see if the problem still occurs. SSL would be my first to go in this case.

[aehimself 396]

3 minutes ago, idontknow said:

I created the TwSocket from inside Thread.Execute, told him it shall use MultiThreading, and had a message loop running inside the TClientThread.

Aren't those two are effectively the same thing? Afaik, .MultiThreaded := True only means the socket will use it's internal message pump.

You easily can create a deadlock in any VCL application if you have two "While xxx Do Application.ProcessMessages" blocks running "simultaneously". Maybe this is the case here...?

[Guest]

4 minutes ago, idontknow said:

The problem seems to be the usage of TwSocket from inside a Thread.

When i was trying to monitor it, it did happen, it worked for long time ( over 5 minutes) so i had to stop it, all other runs worked less than 30 second.

 

There is a bug in there, it is serious and should be discovered and handled, so i suggest to try to reproduce it and track it in multithreaded if needed.

 

On side note : i never liked OpenSSL, it does have many unexplained things and default values, if i would suggest replacement then it would be one of two

1) BoringSSL the OpenSSL forked by Google.

2) NSS from Mozilla which is the best of them all, it does everything you need from OpenSSL, but very similar interfaced and well written and tested, it is not slower than OpenSSL.

That was a suggestion as food for thoughts, someone might take this and port the interface to Pascal/Delphi.

[idontknow 0]

The problem was how I sent, it seems sending needs to be from within the context of the Thread where TSslWSocket is attached to to work stable.

 

I solved the problem by deriving from TSslWSocket and adding a new Message FMsg_WM_SEND_ASYNC. If the Component receives this Message, it runs the OnSendAsync-Method from its own ThreadContext, and that's where data is send...

 

It seems to work...

TSendAnsiItem = record
    Data: AnsiString;
  end;
  pSendItem = ^TSendAnsiItem;

  TSendAnsiText = procedure(Sender: TObject; Data: AnsiString) of object;

  TMySslWSocket = class(TSslWSocket)
  protected
    FMsg_WM_SEND_ASYNC: UINT;
    FonSendAnsiAsync: TSendAnsiText;
    procedure AllocateMsgHandlers; override;
    procedure FreeMsgHandlers; override;
    procedure WndProc(var MsgRec: TMessage); override;
  public
    procedure SendAnsiASync(const Data: AnsiString);
    property OnSendAnsiAsync: TSendAnsiText read FonSendAnsiAsync write FonSendAnsiAsync;
  end;

procedure TClientThread.NoMessagePump(Sender: TObject);
begin
  // Nothing. Empty Message Pump.
end;

procedure TClientThread.SendAnsiText(Sender: TObject; Data: AnsiString);
var
  BytesSent: Integer;
begin
  BytesSent := TMySslWSocket(Sender).Send(TwSocketData(@Data[1]), Length(Data));
  if BytesSent <> Length(Data) then
    Info('Fehler: Problem beim Senden!');
end;

procedure TClientThread.Execute;
begin
  ClientSocket := TMySslWSocket.Create(nil);
  ClientSocket.MultiThreaded := TRUE;
  ClientSocket.OnMessagePump := NoMessagePump; // Thread will do ClientSocket.MessageLoop later...

  ClientSocket.OnSendAnsiAsync := SendAnsiText;

	...
  
  ClientSocket.MessageLoop;
end;

procedure TMySslWSocket.AllocateMsgHandlers;
begin
  inherited AllocateMsgHandlers;
  FMsg_WM_SEND_ASYNC := FWndHandler.AllocateMsgHandler(Self);
end;

procedure TMySslWSocket.FreeMsgHandlers;
begin
  if Assigned(FWndHandler) then begin
    FWndHandler.UnregisterMessage(FMsg_WM_SEND_ASYNC);
  end;
  inherited FreeMsgHandlers;
end;

procedure TMySslWSocket.SendAnsiASync(const Data: AnsiString);
var
  pItem: pSendItem;
begin
  New(pItem);
  pItem^.Data := Data;
  PostMessage(Handle, FMsg_WM_SEND_ASYNC, 0, lParam(pItem));
end;

procedure TMySslWSocket.WndProc(var MsgRec: TMessage);
var
  pItem: pSendItem;
begin
  try
    with MsgRec do begin
      if Msg = FMsg_WM_SEND_ASYNC then
      begin
        pItem := PSendItem(MsgRec.lParam);
        if Assigned(FonSendAnsiAsync) then
          FonSendAnsiAsync(Self, pItem^.Data);
        System.Dispose(pItem);
      end
      else
        inherited WndProc(MsgRec);
    end;
  except
    on E: Exception do
      HandleBackGroundException(E, 'TMySslWSocket.WndProc');
  end;
end;