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

packages/openssl/src/fpopenssl.pp

@@ -115,6 +115,7 @@ Type
     function CipherBits: integer;
     function CipherAlgBits: integer;
     Function VerifyResult : Integer;
+    function Set1Host(const hostname: string): Integer;
     Property SSL: PSSL Read FSSL;
   end;
 
@@ -822,5 +823,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

@@ -1141,6 +1141,7 @@ var
   function SSLGetServername(ssl: PSSL; _type: cInt = TLSEXT_NAMETYPE_host_name): AnsiString;
   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;
@@ -1644,6 +1645,7 @@ type
   TSSLGetServername = function(ssl: PSSL; _type: cInt = TLSEXT_NAMETYPE_host_name): PAnsiChar; 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;
@@ -1890,6 +1892,7 @@ var
   _SSLGetServername: TSSLGetServername = nil;
   _SslCtxCallbackCtrl: TSSLCtxCallbackCtrl = nil;
   _SslSetSslCtx: TSSLSetSslCtx = nil;
+  _SslSet1Host: TSslSet1Host = nil;
 
 // libeay.dll
   _OPENSSL_cleanup : TOPENSSL_cleanup = Nil;
@@ -2637,6 +2640,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): AnsiString;
 begin
@@ -5048,6 +5059,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;
@@ -5404,6 +5416,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

@@ -95,6 +95,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);