AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke CETP over TLS - TI-Konnektor
Thema durchsuchen
Ansicht
Themen-Optionen

CETP over TLS - TI-Konnektor

Ein Thema von WladiD · begonnen am 22. Apr 2021 · letzter Beitrag vom 12. Jul 2022
 
WladiD

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

AW: CETP over TLS - TI-Konnektor

  Alt 12. Jul 2022, 09: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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:47 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz