Hallo zusammen,

ich komme hier schon seit Tagen einfach nicht weiter. Das Thema ist sehr speziell, aber vielleicht gibt es ja doch einen Leidensgenossen hier, der im TI-Medizinwesen unterwegs ist.

CETP ist die Abkürzung für Connector Event Transport Protocol und wird vom TI-Konnektor bereitgestellt. Die Funktionsweise ist eigentlich ganz simpel, das PVS (Praxisverwaltungssystem) abonniert über einen SOAP-Call die gewünschten Ereignisse und teilt in diesem mit auf welchem Port es einen TCP-Server bereitstellt. Der Konnektor sendet dann die Nachrichten wenn das entsprechende Ereignis eintritt (z.B. wenn eine Karte ins Kartenterminal gesteckt wird).

Die unverschlüsselte CETP-Variante in unserem PVS funktioniert von Anfang an problemlos. Ihr ahnt es schon…die TLS-Variante kriege ich einfach nicht. Als Netzwerkkomponente kommt hier die aktuellste Indy-Version unter Delphi 10.1 zum Einsatz.

Die Anforderung von der Gematik ist wie folgt:
---
GS-A_4384 - TLS-Verbindungen
Alle Produkttypen, die Übertragungen mittels TLS durchführen, MÜSSEN die folgenden
Vorgaben erfüllen:
• Zur Authentifizierung MUSS eine X.509-Identität gemäß [gemSpec_Krypt#GS-A_4359] verwendet werden.
• Als Cipher Suite MUSS TLS_DHE_RSA_WITH_AES_128_CBC_SHA oder TLS_DHE_RSA_WITH_AES_256_CBC_SHA verwendet werden.
• Es MUSS für die Schlüsselaushandlung Gruppe 14 (definiert in [RFC-3526], verwendbar bis Ende 2023) verwendet werden.
• Der private DH-Exponent für den Schlüsselaustausch MUSS eine Länge von mindestens 256 Bit haben
---

Hier der aktuelle Code:

zusammenfalten · markieren

Delphi-Quellcode:

procedure TCommunicator.StartListener(Topics: TCETPEvents);

  function CreateIOHandler: TIdServerIOHandlerSSLOpenSSL;
  begin
    Result := TIdServerIOHandlerSSLOpenSSL.Create(FCETPServer);

    if FClientAuthMode = camCertificate then
    begin
      Result.SSLOptions.CertFile := 'C:\Dev-master\exe\kiwi.crt.pem';
      Result.SSLOptions.KeyFile := 'C:\Dev-master\exe\kiwi.key.pem';
      Result.OnGetPassword := CertificatePassEventHandler;
    end;

    Result.SSLOptions.Mode := sslmServer;
    Result.SSLOptions.Method := sslvTLSv1_2;
    Result.SSLOptions.SSLVersions := [sslvTLSv1_2];
    Result.SSLOptions.CipherList := 'DHE-RSA-AES256-SHA'; // TLS_DHE_RSA_WITH_AES_256_CBC_SHA
    Result.SSLOptions.DHParamsFile := 'C:\Dev-master\exe\dhparam.pem';
  end;

begin
  // Ausführung in Thread leiten
  if not InCurrentThread then
  begin
    FMethods.Add(
      procedure
      begin
        StartListener(Topics);
      end);
    Exit;
  end;

  if Assigned(FCETPServer) or (FCETPPort <= 0) then
    Exit;

  FCETPServer := TIdTCPServer.Create(nil);

  // Wenn es eine TLS-Pflicht gibt, dann muss auch CETP over TLS laufen
  if FTLSMandatory then
  begin
    FCETPServer.IOHandler := CreateIOHandler;
    FCETPServer.OnConnect := CETPServerConnect;
  end;

  FCETPServer.DefaultPort := FCETPPort;
  FCETPServer.ReuseSocket := rsOSDependent;
  FCETPServer.ListenQueue := 15;
  FCETPServer.UseNagle := True;
  FCETPServer.OnExecute := CETPResponseExecute;
  FCETPServer.Active := True;

  if Assigned(FOnStartListener) then
    Synchronize(
      procedure
      begin
        FOnStartListener(Self);
      end);

  if Topics = [] then
    SubscribeDefault
  else if Topics <> [ceUnknown] then
    SubscribeForCETPEvents(Topics);
end;

procedure TCommunicator.CertificatePassEventHandler(var Password: string);
begin
  Password := FClientAuthCertFilePass
end;

procedure TCommunicator.CETPServerConnect(AContext: TIdContext);
begin
  if FTLSMandatory and (AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase) then
    TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False;
   
  // An dieser Stelle wird eine Exception mit der Meldung 'Error accepting connection with SSL.' ausgelöst
end;

Mein großes Problem an der Sache, dass der Fehler von der OpenSSL-Funktion SSL_accept geworfen wird und ich somit überhaupt nicht nachvollziehen kann, an welcher Stelle genau und weshalb der Fehler auftritt. Die Meldung 'Error accepting connection with SSL.' ist überhaupt nicht aussagekräftig.

Hallo,

falls du mit Indy nicht weiter kommst, könntest du alternativ mal ICS probieren:
http://www.overbyte.eu

Grüße
TurboMagic

Hi TurboMagic,

vielen Dank für den Vorschlag!

Ich habe von ICS schon mal was gehört, ist jedenfalls einen Versuch wert.

Wobei ich mir nicht sicher bin, ob Indy etwas falsch macht oder eher ich.

Falls jemand mal auf dieses Thema kommt, wollte ich auch eine Lösung liefern, die mit Indy und OpenSSL doch nun funktioniert hat...

zusammenfalten · markieren

Delphi-Quellcode:

procedure TCetpServer.StartServer(Port: Integer);

  function CreateIOHandler: TIdServerIOHandlerSSLOpenSSL;
  begin
    Result := TIdServerIOHandlerSSLOpenSSL.Create(FServer);
    Result.SSLOptions.SSLVersions := [sslvTLSv1_2];
    Result.SSLOptions.CertFile := '<Eure-P12-Datei>';
    Result.SSLOptions.KeyFile := '<Eure-P12-Datei>';
    Result.SSLOptions.Mode := sslmServer;
    Result.SSLOptions.Method := sslvTLSv1_2;
    Result.SSLOptions.SSLVersions := [sslvTLSv1_2];
    Result.SSLOptions.VerifyMode := [];
    Result.OnGetPassword := YourPassEventHandler; // procedure(var Password: string);
  end;

var
  IoHandler: TIdServerIOHandlerSSLOpenSSL;
begin
  FServer := TIdTCPServer.Create(nil);
  IoHandler := CreateIOHandler;
  if Assigned(IoHandler) then
    FServer.IOHandler := IoHandler;
  FServer.DefaultPort := Port;
  FServer.ReuseSocket := rsOSDependent;
  FServer.ListenQueue := 15;
  FServer.UseNagle := True;
  FServer.OnAfterBind := CetpServerAfterBind;
  FServer.OnConnect := CetpServerConnect;
  FServer.OnExecute := CetpResponseExecute;
  FServer.Active := True;
end;

type
  TIdSSLContextRobin = class(TIdSSLContext);

procedure TCetpServer.CetpServerAfterBind(Sender: TObject);
begin
  if FServer.IOHandler is TIdServerIOHandlerSSLOpenSSL then
  begin
    // Das ist die entscheidende Zeile...
    //
    // Gefunden: <https://stackoverflow.com/questions/40454338/no-shared-cipher-at-ssl-accept-why>
    // "Some older OpenSSL versions require an explicit call to SSL_CTX_set_ecdh_auto() at
    // initialization stage to enable negotiation of advanced algorithms."
    SSL_CTX_set_ecdh_auto(
      TIdSSLContextRobin(TIdServerIOHandlerSSLOpenSSL(FServer.IOHandler).SSLContext).fContext, 1);
  end;
end;

procedure TCetpServer.CetpServerConnect(AContext: TIdContext);
begin
  // "PassThrough := False" ist bei TLS-Verbindungen notwendig
  if AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
    TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False;
end;

procedure TCetpServer.CetpResponseExecute(AContext: TIdContext);
const
  MaxContentLength = 1024 * 1024; // Maximal 1 MB
var
  CETPLine: string;
  ContentLength: Cardinal;
  IOHandler: TIdIOHandler;
  Header: TIdBytes;
  Content: TBytesStream;
begin
  Content := TBytesStream.Create;
  try
    IOHandler := AContext.Connection.IOHandler;

    SetLength(Header, 4);
    IOHandler.ReadBytes(Header, 4, False);
    CETPLine := TEncoding.ANSI.GetString(TBytes(Header));
    if CETPLine <> 'CETP' then
      raise ETICommunicator.Create('No CETP Header found');

    ContentLength := IOHandler.ReadUInt32(True);

    if ContentLength > MaxContentLength then
      raise ETICommunicator.CreateFmt(
        'Max content length of a CETP message must not exceed %d bytes', [MaxContentLength]);

    IOHandler.ReadStream(Content, ContentLength, False);
    Content.Position := 0;

    // Jetzt könnt ihr den Inhalt der CETP-Nachricht in Content verarbeiten...
  finally
    Content.Free;
  end;
end;

Die Code-Fragmente sind aus dem Produktiv-Code herausgeschnippelt, alles Wichtige für die Lösung des eingangs geschilderten Problems ist hier aber dabei.