feat(ssl): add mTLS server API (SetCACertificate / SetVerifyPeer)

Author: freitasjca

Net/Net.CrossSslSocket.Base.pas

@@ -173,6 +173,30 @@   TCrossSslSocketBase = class(TCrossSocket, ICrossSslSocket)
     procedure SetPrivateKey(const APKeyStr: string); overload; virtual;
     procedure SetPrivateKeyFile(const APKeyFile: string); virtual;
 
+    { ── MTLS-1: CA certificate loading for client-certificate verification ──
+      Loads a CA certificate that the server will use to verify presented
+      client certificates during the TLS handshake (mutual TLS).  Mirrors
+      the SetCertificate overload family above so consumers have the same
+      file/string/bytes/buffer surface they're already used to.
+
+      Concrete implementation in TCrossOpenSslSocket calls
+      SSL_CTX_add_client_CA + X509_STORE_add_cert to register the cert in
+      both the CertificateRequest CA list (sent to clients during the
+      handshake) and the trust store used to verify the presented chain. }
+    procedure SetCACertificate(const ACACertBuf: Pointer; const ACACertBufSize: Integer); overload; virtual; abstract;
+    procedure SetCACertificate(const ACACertBytes: TBytes); overload; virtual;
+    procedure SetCACertificate(const ACACertStr: string); overload; virtual;
+    procedure SetCACertificateFile(const ACACertFile: string); virtual;
+
+    { ── MTLS-2: enable / disable peer (client) certificate verification ──
+      When AVerify=True the server sets SSL_VERIFY_PEER |
+      SSL_VERIFY_FAIL_IF_NO_PEER_CERT — the handshake fails if the client
+      does not present a certificate signed by one of the CAs registered
+      above.  When False, reverts to SSL_VERIFY_NONE (the default).
+      Must be called AFTER SetCACertificate so the trust store is
+      populated before verify mode is enabled. }
+    procedure SetVerifyPeer(const AVerify: Boolean); virtual; abstract;
+
     property Ssl: Boolean read GetSsl;
     property SslMaxPendingWriteBytes: Int64 read GetSslMaxPendingWriteBytes write SetSslMaxPendingWriteBytes;
   end;
@@ -236,6 +260,23 @@ procedure TCrossSslSocketBase.SetPrivateKeyFile(const APKeyFile: string);
   SetPrivateKey(TFileUtils.ReadAllBytes(APKeyFile));
 end;
 
+{ ── MTLS-1: SetCACertificate overload chain (file → string → bytes → buffer) ── }
+
+procedure TCrossSslSocketBase.SetCACertificate(const ACACertBytes: TBytes);
+begin
+  SetCACertificate(Pointer(ACACertBytes), Length(ACACertBytes));
+end;
+
+procedure TCrossSslSocketBase.SetCACertificate(const ACACertStr: string);
+begin
+  SetCACertificate(TEncoding.ANSI.GetBytes(ACACertStr));
+end;
+
+procedure TCrossSslSocketBase.SetCACertificateFile(const ACACertFile: string);
+begin
+  SetCACertificate(TFileUtils.ReadAllBytes(ACACertFile));
+end;
+
 { TCrossSslConnectionBase }
 
 function TCrossSslConnectionBase.GetSsl: Boolean;

Net/Net.CrossSslSocket.OpenSSL.pas

@@ -19,6 +19,26 @@
 
   传输层安全协议:
   https://zh.wikipedia.org/wiki/%E5%82%B3%E8%BC%B8%E5%B1%A4%E5%AE%89%E5%85%A8%E5%8D%94%E8%AD%B0
+
+  ── mTLS additions ───────────────────────────────────────────────────────────
+  [MTLS-1] SetCACertificate(Pointer, Integer) override added.
+           Loads a CA certificate from a memory buffer and registers it with
+           the SSL context for client-certificate verification (mTLS server
+           mode).  Uses BIO_new_mem_buf + PEM_read_bio_X509 to parse the PEM
+           data, then calls SSL_CTX_add_client_CA (populates the CA list sent
+           to clients in the CertificateRequest handshake message) and
+           X509_STORE_add_cert (adds the cert to the trust store used to
+           verify the presented certificate chain).
+           Companion overloads (TBytes / string / file) inherited from the
+           base class (Net.CrossSslSocket.Base) mirror the SetCertificate
+           overload family.
+
+  [MTLS-2] SetVerifyPeer(Boolean) override added.
+           When AVerify=True, sets SSL_VERIFY_PEER | SSL_VERIFY_FAIL_IF_NO_PEER_CERT
+           so the server demands a valid client certificate.
+           When AVerify=False, reverts to SSL_VERIFY_NONE (default).
+           Must be called AFTER SetCACertificate — the trust store must be
+           populated before verify mode is enabled.
 }
 
 interface
@@ -158,6 +178,19 @@   TCrossOpenSslSocket = class(TCrossSslSocketBase)
 
     procedure SetCertificate(const ACertBuf: Pointer; const ACertBufSize: Integer); overload; override;
     procedure SetPrivateKey(const APKeyBuf: Pointer; const APKeyBufSize: Integer); overload; override;
+
+    { ── MTLS-1: load a CA certificate (PEM buffer) for client-cert verification.
+      Calls SSL_CTX_add_client_CA to register the CA name in the
+      CertificateRequest list the server sends to clients during the
+      handshake, and X509_STORE_add_cert to populate the trust store used to
+      verify the certificate chain presented by the client. }
+    procedure SetCACertificate(const ACACertBuf: Pointer; const ACACertBufSize: Integer); overload; override;
+
+    { ── MTLS-2: enable / disable client-certificate verification.
+      AVerify=True  → SSL_VERIFY_PEER | SSL_VERIFY_FAIL_IF_NO_PEER_CERT
+                      (handshake fails without a valid client cert)
+      AVerify=False → SSL_VERIFY_NONE (default) }
+    procedure SetVerifyPeer(const AVerify: Boolean); override;
   end;
 
 implementation
@@ -888,6 +921,70 @@ procedure TCrossOpenSslSocket.SetPrivateKey(const APKeyBuf: Pointer;
     TSSLTools.SetPrivateKey(FSslCtx, APKeyBuf, APKeyBufSize);
 end;
 
+{ ── MTLS-1: load a CA certificate (PEM buffer) into the SSL context ──────────
+  Registers the certificate with both the CertificateRequest CA list (sent to
+  clients in the TLS handshake to indicate which CAs the server trusts) and
+  the X509 trust store (used to verify the certificate chain presented by the
+  client).  Must be called before SetVerifyPeer(True). }
+procedure TCrossOpenSslSocket.SetCACertificate(const ACACertBuf: Pointer;
+  const ACACertBufSize: Integer);
+var
+  LBio:    PBIO;
+  LCACert: PX509;
+  LStore:  PX509_STORE;
+begin
+  if not Ssl or (FSslCtx = nil) then Exit;
+
+  // Wrap the caller's buffer in a read-only memory BIO — no copy is made.
+  LBio := BIO_new_mem_buf(ACACertBuf, ACACertBufSize);
+  if LBio = nil then
+    raise ESsl.Create('SetCACertificate: BIO_new_mem_buf failed');
+  try
+    // Parse the PEM-encoded X.509 certificate.
+    LCACert := PEM_read_bio_X509(LBio, nil, nil, nil);
+    if LCACert = nil then
+      raise ESsl.Create(
+        'SetCACertificate: PEM_read_bio_X509 failed — ' +
+        'ensure the buffer contains a valid PEM certificate');
+    try
+      // Register the CA name in the CertificateRequest list.
+      SSL_CTX_add_client_CA(FSslCtx, LCACert);
+
+      // Add the cert to the trust store for chain verification.
+      LStore := SSL_CTX_get_cert_store(FSslCtx);
+      if Assigned(LStore) then
+        X509_STORE_add_cert(LStore, LCACert);
+      // X509_STORE_add_cert returns 0 if the cert is already in the store
+      // (duplicate) — this is benign, so we do not raise on <= 0 here.
+    finally
+      // Decrement our local ref-count.  The context and store hold their own.
+      X509_free(LCACert);
+    end;
+  finally
+    BIO_free(LBio);
+  end;
+end;
+
+{ ── MTLS-2: enable or disable mandatory client-certificate verification ──────
+  SSL_VERIFY_NONE             — no client certificate is requested (default).
+  SSL_VERIFY_PEER             — request and verify, but allow connections
+                                without a cert (or with an invalid cert).
+  SSL_VERIFY_FAIL_IF_NO_PEER_CERT — combined with PEER, requires the client
+                                to present a valid cert; handshake fails
+                                otherwise.
+  This implementation uses PEER | FAIL_IF_NO_PEER_CERT for AVerify=True so
+  the server demands a valid mTLS handshake. }
+procedure TCrossOpenSslSocket.SetVerifyPeer(const AVerify: Boolean);
+begin
+  if not Ssl or (FSslCtx = nil) then Exit;
+
+  if AVerify then
+    SSL_CTX_set_verify(FSslCtx,
+      SSL_VERIFY_PEER or SSL_VERIFY_FAIL_IF_NO_PEER_CERT, nil)
+  else
+    SSL_CTX_set_verify(FSslCtx, SSL_VERIFY_NONE, nil);
+end;
+
 procedure TCrossOpenSslSocket.TriggerConnected(const AConnection: ICrossConnection);
 var
   LConnection: TCrossOpenSslConnection;