paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 11:08:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-11-05 10:19:16 +01:00
parent f4da88726c
commit 6941409295
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

@ -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.

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

@ -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;

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

@ -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);