TCPClient+SSL, Blockierendes Read -> Disconnect -> AV

[idontknow]

Hallo. Dies ist mein allererster Post mit einer Frage an der ich jetzt schon ziemlich lange herummknabbere...

Kurze Beschreibung: Ich habe einen TCPClient, der in einem Thread (nennen wir ihn mal ReadThread) blockierend liest. Dieser Thread hat einen Parent-Thread, in dem u.a. der TCPClient zum Senden verwendet wird. Das Problem ist jetzt folgendes: Zu einem beliebigen Zeitpunkt möchte ich das Programm beenden, ich führe einTCPClient.Disconnect aus, damit der blockierende Thread eben nicht mehr blockiert und beendet werden kann. Funktioniert prima.

Baue ich jetzt, sensibilisiert durch Edward Snowden, SSL-Verschlüsselung ein, dann bekomme ich im Read-Thread eine Exception, und zwar keine liebliche: Exception-Klasse $C0000005 mit Meldung 'access violation at 0x005eb1ea: read of address 0x0000000c'.

Ich bin mir ziemlich sicher, daß ich etwas falsch mache, da ich zu diesem Thema bisher noch nichts finden konnte, andere das Problem also wohl nicht haben. Aber was? Ich habe mal ein Test-Programm angehängt, das einen TCP-Server mit SSL-Verschlüsselung startet und ausserdem die besagten Threads mit dem TCP-Client. Der Client schickt eine Nachricht an den Server. Der ReadThread liest wie gewünscht blockierend. Nach 5 Sekunden wird das Disconnect ausgeführt. Der ReadThread crasht daraufhin wie beschrieben. Alle möglichen Informationen werden als DebugOutput in der IDE ausgegeben.

Wenn ich den SSL-Handler rausnehme (tcpclient.iohandler := Nil und tcpserver.iohandler := Nil) funktioniert alles, wie es soll, von der fehlenden Verschlüsselung mal abgesehen.

Wäre toll, wenn jemand helfen könnte, ich bin mit meinem Latein am Ende...

Delphi-Quellcode:

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, IdTCPConnection, IdTCPClient, Vcl.StdCtrls, IdBaseComponent,
  IdComponent, IdCustomTCPServer, IdTCPServer, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,
  IdServerIOHandler;

type
  TClientThread = class(TThread)
  protected
    procedure Execute; override;
  public
    tcpclient: TIdTCPClient;
    ClientSSL:TIdSSLIOHandlerSocketOpenSSL;
    procedure ClientSSLGetPassword(var Password: AnsiString);
    procedure ClientSSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
    procedure ClientSSLStatusInfo(const AMsg: String);
  end;

  TClientReadThread = class(TThread)
  private
    ParentThread:TClientThread;
  protected
    procedure Execute; override;
  end;

  TForm2 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  public
    tcpserver: TIdTCPServer;
    ServerSSL:TIdServerIOHandlerSSLOpenSSL;
    ClientThread:TClientThread;
    procedure onExecute(AContext: TIdContext);
    procedure onConnect(AContext: TIdContext);
    procedure ServerSSLGetPassword(var Password: AnsiString);
    procedure ServerSSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
    procedure ServerSSLStatusInfo(const AMsg: string);
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure DebugOut(Text:String);
begin
  OutputDebugString(PWideChar(Text));
end;

procedure TForm2.ServerSSLGetPassword(var Password: AnsiString);
begin
  Password := '1234';
end;

procedure TForm2.ServerSSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
  DebugOut('ServerSSL Status: '+AStatusText);
end;

procedure TForm2.ServerSSLStatusInfo(const AMsg: string);
begin
  DebugOut('ServerSSL StatusInfo: '+AMsg);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  tcpserver := TIdTCPServer.Create(nil);

  ServerSSL := TIdServerIOHandlerSSLOpenSSL.Create(nil);
  ServerSSL.OnGetPassword := ServerSSLGetPassword;
  ServerSSL.OnStatus := ServerSSLStatus;
  ServerSSL.OnStatusInfo := ServerSSLStatusInfo;
  ServerSSL.SSLOptions.CertFile := ExtractFilePath(Application.ExeName) +'testcert.pem';
  ServerSSL.SSLOptions.KeyFile := ExtractFilePath(Application.ExeName) +'testkey.pem';
  ServerSSL.SSLOptions.Mode := sslmServer;
  ServerSSL.SSLOptions.Method := sslvTLSv1_2;
  ServerSSL.SSLOptions.SSLVersions := [sslvTLSv1_2];

  //tcpserver.IOHandler := nil;
  tcpserver.IOHandler := ServerSSL;

  tcpserver.Bindings.Clear;
  with tcpserver.Bindings.Add do begin
    IP := '192.168.1.26';
    Port := 9999;
  end;
  //tcpserver.DefaultPort := 9999;
  tcpserver.OnConnect := onConnect;
  tcpserver.OnExecute := onExecute;
  tcpserver.Active := TRUE;

  ClientThread := TClientThread.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  // Alles beenden
  ClientThread.Terminate;
  ClientThread.WaitFor;
  ClientThread.Free;

  tcpserver.Active := FALSE;
  tcpserver.Free;
  ServerSSL.Free;
end;

procedure TForm2.onExecute(AContext: TIdContext);
begin
  DebugOut('Der Server empfing: "' + AContext.Connection.IOHandler.ReadLn + '"'); // Das 'Hallo' wird ausgegeben.
end;

procedure TForm2.onConnect(AContext: TIdContext);
begin
  if (AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase) then
    TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough:= false;
end;


{ TTestThread }
procedure TClientReadThread.Execute;
var
  Test: AnsiString;
begin
  while not terminated do begin
    try
      DebugOut('Blockierendes Read ab jetzt...');
      Test := ParentThread.tcpclient.IOHandler.ReadString(10, TEncoding.ANSI);
      DebugOut('Test: '+Test);
    except
      on E:Exception do begin
        if ParentThread.tcpclient.Connected
        then DebugOut('TReadThread.Execute: '+E.Message);
      end;
    end;
  end;
end;

{ TTestThread1 }
procedure TClientThread.ClientSSLGetPassword(var Password: AnsiString);
begin
  Password := '1234';
end;

procedure TClientThread.ClientSSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
  DebugOut('ClientSSL Status: '+AStatusText);
end;
procedure TClientThread.ClientSSLStatusInfo(const AMsg: String);
begin
  DebugOut('ClientSSL StatusInfo: '+AMsg);
end;

procedure TClientThread.Execute;
var
  Test: AnsiString;
  ReadThread: TClientReadThread;
begin
  while not terminated do begin
    ClientSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
    ClientSSL.OnGetPassword := ClientSSLGetPassword;
    ClientSSL.OnStatus := ClientSSLStatus;
    ClientSSL.OnStatusInfo := ClientSSLStatusInfo;
    ClientSSL.SSLOptions.CertFile := ExtractFilePath(Application.ExeName) +'testcert.pem';
    ClientSSL.SSLOptions.Mode := sslmClient;
    ClientSSL.SSLOptions.Method := sslvTLSv1_2;
    ClientSSL.SSLOptions.SSLVersions := [sslvTLSv1_2];

    tcpclient := TIdTCPClient.Create(nil);

    tcpclient.IOHandler := ClientSSL;

    //tcpclient.IOHandler := nil;

    tcpclient.Host := '192.168.1.26';
    tcpclient.Port := 9999;
    try
      tcpclient.Connect;
      DebugOut('Connected');
      // Den Thread starten, in dessen Execute der TCP Client blockierend liest:
      ReadThread := TClientReadThread.Create(TRUE);
      ReadThread.ParentThread := Self;
      ReadThread.Start;

      tcpclient.IOHandler.WriteLn('Der Client sagt Hallo!');

    except
      on E:Exception do DebugOut('Connect nicht möglich...' + E.Message);
    end;

    sleep(5000); // Dieses Sleep simuliert: Tu irgendwas...

    // Jetzt soll das Programm irgendwann beendet werden:

    // Also: Disconnecten, um den Thread abbrechen zu können.
    // Der Thread crasht dabei leider mit einer AV.

    // Hier das Geheimnis zum Erfolg, also zum Abbruch des blockierenden Reads ohne AV:
    if Assigned(ReadThread) then ReadThread.Terminate; // 1.) Read-Thread terminieren, damit kein weiteres Read stattfindet.
    try
      DebugOut('Jetzt disconnecten...');
      tcpclient.Disconnect; // Hier gibts eine AV (Exception-Klasse $C0000005 mit Meldung 'access violation at 0x005eb1ea: read of address 0x0000000c'
      //ClientSSL.Close; // die gleiche AV
    except
      on E:Exception do DebugOut('IdTCPClient.Disconnect: '+E.Message);
    end;

    if Assigned(ReadThread) then ReadThread.WaitFor;    // 3.) Jetzt auf Threadende warten.
    if Assigned(ReadThread) then ReadThread.Free;

    tcpclient.Free; // 4.) und erst jetzt den tcpclient freigeben.
    ClientSSL.Free;
    DebugOut('Ende');
  end;
end;

end.

[mjustin]

Sehe ich es richtig, dass der Client und der Server im gleichen Programm (Prozess) ausgeführt werden?

[idontknow]

Ja, es handelt sich hier nur um ein Testprogramm, um das Verhalten zu demonstrieren. In der realen Applikation sind Server und Client auf verschiedene Programme verteilt.

[himitsu]

Wer hat eigentlich behauptet, daß diese Komponente threadsave sei?

So gesehn hattest du wohl eher nur Glück gehabt, daß es bisher nicht geknallt hatte.

[idontknow]

Ups, ist sie nicht? Wie gehe ich denn dann möglichst ressourcenschonend mit dem TidTCPClient um, wenn ich Pakete empfangen möchte, die aus "Int(Länge in Bytes) + Binäre Nutzdaten" bestehen? Es kann durchaus sein, daß mein Programm möglichst sofort Daten an den Server senden muss, obwohl es eben auch seit geraumer Zeit auf Daten wartet.

[mjustin]

Zitat von idontknow:

Ja, es handelt sich hier nur um ein Testprogramm, um das Verhalten zu demonstrieren. In der realen Applikation sind Server und Client auf verschiedene Programme verteilt.

Ok. Aber die TIdTCPClient Komponente sollte möglichst nur in ihrem eigenen Thread verwendet werden. Ein Zugriff aus mehreren Threads ist möglich, aber nur "nacheinander", unter Einsatz von z.B. TCriticalSection.

[mjustin]

Zitat von idontknow:

Ups, ist sie nicht? Wie gehe ich denn dann möglichst ressourcenschonend mit dem TidTCPClient um, wenn ich Pakete empfangen möchte, die aus "Int(Länge in Bytes) + Binäre Nutzdaten" bestehen? Es kann durchaus sein, daß mein Programm möglichst sofort Daten an den Server senden muss, obwohl es eben auch seit geraumer Zeit auf Daten wartet.

Theoretisch kann man mit einer Instanz der TidTCPClient Komponente zwar gleichzeitig senden und empfangen (lt. Indy Entwickler Remy Lebau kann man über einen Thread IOHandler.Read und aus einem anderen IOHandler.Write aufrufen).

Für den Anfang würde ich zwei Threads verwenden, die jeweils ihre eigene Instanz der Komponente enthalten. Dann ist es nicht mehr möglich, dass sie sich gegenseitig stören.

Es kann - je nach Anwendung - dabei eine Instanz auch im Hauptthread laufen. Zum Beispiel wenn das Senden nur aufgrund von Benutzereingaben und Buttondruck erfolgen soll, und Latenz/Antwortzeiten gering sind.

[himitsu]

Als Erstes mußt/solltest du also deine blockierende Lesevariante in eine Nichtblockierende umwandeln.

Und dann könnte man entweder das Lesen in den TClientThread verschieben, oder muß die Zugriffe absichern. (wie erwähnt, via CriticalSection oder Dergeleichen)
[add] Oder halt zwei TCPClients verwenden, aber auch da nicht blockierend Lesen.

[mjustin]

Zitat von himitsu:

Als Erstes mußt/solltest du also deine blockierende Lesevariante in eine Nichtblockierende umwandeln.

Da das Lesen schon in einem eigenen Thread läuft, wird der Hauptthread (sofern keine "Synchronize"-Fehler gemacht werden) nicht blockiert.

Delphi-Quellcode:

procedure TClientReadThread.Execute;
var
  Test: AnsiString;
begin
  while not terminated do begin
    try
      DebugOut('Blockierendes Read ab jetzt...');
      Test := ParentThread.tcpclient.IOHandler.ReadString(10, TEncoding.ANSI); // <--- Problem
      DebugOut('Test: '+Test);
    except
      on E:Exception do begin
        if ParentThread.tcpclient.Connected
        then DebugOut('TReadThread.Execute: '+E.Message);
      end;
    end;
  end;
end;

Die markierte Zeile muss nur sicherheitshalber auf eine im Thread enthaltene TCP Client Komponente zugreifen anstatt auf eine "globalere".

[idontknow]

Das ist ja blöd. Bleibt also nur, in Abständen einiger Millisekunden zu Pollen um noch eine vernünftige Reaktionszeit zu bekommen und alle Threads jederzeit beenden zu können?