Einzelnen Beitrag anzeigen

WladiD

Registriert seit: 27. Jan 2006
Ort: Celle
141 Beiträge
 
Delphi 11 Alexandria
 
#4

AW: CETP over TLS - TI-Konnektor

  Alt 12. Jul 2022, 10:08
Falls jemand mal auf dieses Thema kommt, wollte ich auch eine Lösung liefern, die mit Indy und OpenSSL doch nun funktioniert hat...

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 <> 'CETPthen
      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.
Waldemar Derr
  Mit Zitat antworten Zitat