* Patch from Dokkie8844 to set hostname when verifying peer certificate. Fixes issue #40479

(cherry picked from commit 69414092952f07e8b80842463055b21301cddceb)

packages/openssl/src/fpopenssl.pp

@@ -108,6 +108,7 @@ Type
     function CipherBits: integer;
     function CipherAlgBits: integer;
     Function VerifyResult : Integer;
+    function Set1Host(const hostname: string): Integer;
     Property SSL: PSSL Read FSSL;
   end;
 
@@ -810,5 +811,10 @@ begin
   Result:=SslGetVerifyResult(FSsl);
 end;
 
+function TSSL.Set1Host(const hostname: string): Integer;
+begin
+  Result := SslSet1Host(FSsl, hostname);
+end;
+
 end.
 

packages/openssl/src/openssl.pas

@@ -1130,6 +1130,7 @@ var
   function SSLGetServername(ssl: PSSL; _type: cInt = TLSEXT_NAMETYPE_host_name): string;
   procedure SslCtxCallbackCtrl(ssl: PSSL; _type: cInt; cb: PCallbackCb);
   function SslSetSslCtx(ssl: PSSL; ctx: PSSL_CTX): PSSL;
+  function SslSet1Host(ssl: PSSL; hostname: string): cInt;
 
 // libeay.dll
   function OPENSSL_INIT_new : POPENSSL_INIT_SETTINGS;
@@ -1633,6 +1634,7 @@ type
   TSSLGetServername = function(ssl: PSSL; _type: cInt = TLSEXT_NAMETYPE_host_name): PChar; cdecl;
   TSSLCtxCallbackCtrl = procedure(ctx: PSSL_CTX; _type: cInt; cb: PCallbackCb); cdecl;
   TSSLSetSslCtx = function(ssl: PSSL; ctx: PSSL_CTX): PSSL; cdecl;
+  TSslSet1Host = function(ssl: PSSL; hostname: string): cInt; cdecl;
 
 // libeay.dll
   TERR_load_crypto_strings = procedure; cdecl;
@@ -1879,6 +1881,7 @@ var
   _SSLGetServername: TSSLGetServername = nil;
   _SslCtxCallbackCtrl: TSSLCtxCallbackCtrl = nil;
   _SslSetSslCtx: TSSLSetSslCtx = nil;
+  _SslSet1Host: TSslSet1Host = nil;
 
 // libeay.dll
   _OPENSSL_cleanup : TOPENSSL_cleanup = Nil;
@@ -2626,6 +2629,14 @@ begin
     result := nil;
 end;
 
+function SslSet1Host(ssl: PSSL; hostname: string): cInt;
+begin
+  if InitSSLInterface and Assigned(_SslSet1Host) then
+    result := _SslSet1Host(ssl, hostname)
+  else
+    result := 0;
+end;
+
 // libeay.dll
 function SSLeayversion(t: cInt): string;
 begin
@@ -5036,6 +5047,7 @@ begin
   _SslGetServername := GetProcAddr(SSLLibHandle, 'SSL_get_servername');
   _SslCtxCallbackCtrl := GetProcAddr(SSLLibHandle, 'SSL_CTX_callback_ctrl');
   _SslSetSslCtx := GetProcAddr(SSLLibHandle, 'SSL_set_SSL_CTX');
+  _SslSet1Host := GetProcAddr(SSLLibHandle, 'SSL_set1_host');
 end;
 
 Procedure LoadUtilEntryPoints;
@@ -5392,6 +5404,7 @@ begin
   _SslGetServername := nil;
   _SslCtxCallbackCtrl := nil;
   _SslSetSslCtx := nil;
+  _SslSet1Host := nil;
   _PKCS7_ISSUER_AND_SERIAL_new:=nil;
   _PKCS7_ISSUER_AND_SERIAL_free:=nil;
   _PKCS7_ISSUER_AND_SERIAL_digest:=nil;

packages/openssl/src/opensslsockets.pp

@@ -88,6 +88,8 @@ begin
      begin
      if SendHostAsSNI  and (Socket is TInetSocket) then
        FSSL.Ctrl(SSL_CTRL_SET_TLSEXT_HOSTNAME,TLSEXT_NAMETYPE_host_name,PAnsiChar(AnsiString((Socket as TInetSocket).Host)));
+     if VerifyPeerCert and (Socket is TInetSocket) then
+       FSSL.Set1Host((Socket as TInetSocket).Host);
      Result:=CheckSSL(FSSL.Connect);
      //if Result and VerifyPeerCert then
      //  Result:=(FSSL.VerifyResult<>0) or (not DoVerifyCert);