paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-12 12:30:42 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
(cherry picked from commit 6941409295)
This commit is contained in:
Michaël Van Canneyt 2023-11-05 10:19:16 +01:00 committed by marcoonthegit
parent 7346c03417
commit 8b0889d45f
3 changed files with 21 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
packages/openssl/src/fpopenssl.pp
View File

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

13
packages/openssl/src/openssl.pas
View File

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

2
packages/openssl/src/opensslsockets.pp
View File

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