From 80c9669fedc8978b13c59c4ea794e4187878c2c0 Mon Sep 17 00:00:00 2001
From: freitasjca <freitasjca@gmail.com>
Date: Sat, 29 Aug 2026 09:01:28 +0100
Subject: [PATCH] feat: add SetCipherList to override TLS 1.2 cipher list

Add an abstract SetCipherList method to TCrossSslSocketBase and
implement it in TCrossOpenSslSocket via SSL_CTX_set_cipher_list.

Empty string is a no-op. An unrecognised cipher string (no matching
ciphers) raises ESsl at call time rather than silently falling back
to the context default.
---
 Net/Net.CrossSslSocket.Base.pas    |  4 ++++
 Net/Net.CrossSslSocket.OpenSSL.pas | 20 ++++++++++++++++++++
 2 files changed, 24 insertions(+)

diff --git a/Net/Net.CrossSslSocket.Base.pas b/Net/Net.CrossSslSocket.Base.pas
index 7705ba3..1e740b0 100644
--- a/Net/Net.CrossSslSocket.Base.pas
+++ b/Net/Net.CrossSslSocket.Base.pas
@@ -283,6 +283,9 @@   TCrossSslSocketBase = class(TCrossSocket, ICrossSslSocket)
       const APassword: string = ''); virtual;
 
     procedure SetVerifyPeer(const AValue: Boolean); virtual;
+    { TLSOPT-2 (fork-only): override negotiated cipher list (TLS 1.2 and below).
+      ACipherList is an OpenSSL cipher-list string. Empty = keep _InitSslCtx default. }
+    procedure SetCipherList(const ACipherList: string); virtual; abstract;
 
     property Ssl: Boolean read GetSsl;
     property VerifyPeer: Boolean read GetVerifyPeer write SetVerifyPeer;
@@ -407,6 +410,7 @@ procedure TCrossSslSocketBase.SetVerifyPeer(const AValue: Boolean);
   end;
 end;
 
+
 procedure TCrossSslSocketBase.AddCACertificate(const ABuf: Pointer;
   const ASize: Integer);
 begin
diff --git a/Net/Net.CrossSslSocket.OpenSSL.pas b/Net/Net.CrossSslSocket.OpenSSL.pas
index 6ba34a5..5928837 100644
--- a/Net/Net.CrossSslSocket.OpenSSL.pas
+++ b/Net/Net.CrossSslSocket.OpenSSL.pas
@@ -170,6 +170,8 @@   TCrossOpenSslSocket = class(TCrossSslSocketBase)
       const ASize: Integer); overload; override;
     procedure SetPrivateKey(const APKeyBuf: Pointer; const APKeyBufSize: Integer;
       const APassword: string); overload; override;
+    { Override the TLS 1.2 cipher list via SSL_CTX_set_cipher_list. }
+    procedure SetCipherList(const ACipherList: string); override;
   end;
 
 {$IFDEF CROSS_OPENSSL_SELFTEST}
@@ -1170,6 +1172,24 @@ procedure TCrossOpenSslSocket.SetPrivateKey(const APKeyBuf: Pointer;
   end;
 end;
 
+procedure TCrossOpenSslSocket.SetCipherList(const ACipherList: string);
+var
+  LAnsi: AnsiString;
+begin
+  if not Ssl or (FSslCtx = nil) or (ACipherList = '') then Exit;
+
+  BeginTlsConfigUpdate;
+  try
+    LAnsi := AnsiString(ACipherList);
+    if SSL_CTX_set_cipher_list(FSslCtx, PAnsiChar(LAnsi)) <> 1 then
+      raise ESsl.Create(
+        'SetCipherList: SSL_CTX_set_cipher_list rejected "' + ACipherList +
+        '" (no matching ciphers)');
+  finally
+    EndTlsConfigUpdate;
+  end;
+end;
+
 procedure TCrossOpenSslSocket.TriggerConnected(const AConnection: ICrossConnection);
 var
   LConnection: TCrossOpenSslConnection;