pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Enable hostname verification in OpenSSL (bug #75 by dokkie8844)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@274 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2023-11-07 10:37:28 +00:00
parent 5e5b55ea12
commit c529150b61
6 changed files with 60 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
ssl_openssl.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Ararat Synapse | 001.004.000 |
| Project : Ararat Synapse | 001.004.001 |
|==============================================================================|
| Content: SSL support by OpenSSL |
|==============================================================================|
@ -539,7 +539,10 @@ begin
Exit;
end;
if SNIHost<>'' then
begin
SSLCtrl(Fssl, SSL_CTRL_SET_TLSEXT_HOSTNAME, TLSEXT_NAMETYPE_host_name, PAnsiChar(AnsiString(SNIHost)));
SslSet1Host(Fssl, PAnsiChar(AnsiString(SNIHost)));
end;
if FSocket.ConnectionTimeout <= 0 then //do blocking call of SSL_Connect
begin
x := sslconnect(FSsl);

5
ssl_openssl11.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Ararat Synapse | 002.000.000 |
| Project : Ararat Synapse | 002.000.001 |
|==============================================================================|
| Content: SSL support by OpenSSL |
|==============================================================================|
@ -507,7 +507,10 @@ begin
Exit;
end;
if SNIHost<>'' then
begin
SSLCtrl(Fssl, SSL_CTRL_SET_TLSEXT_HOSTNAME, TLSEXT_NAMETYPE_host_name, PAnsiChar(AnsiString(SNIHost)));
SslSet1Host(Fssl, PAnsiChar(AnsiString(SNIHost)));
end;
if FSocket.ConnectionTimeout <= 0 then //do blocking call of SSL_Connect
begin
x := sslconnect(FSsl);

14
ssl_openssl11_lib.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Ararat Synapse | 004.000.000 |
| Project : Ararat Synapse | 004.000.001 |
|==============================================================================|
| Content: SSL support by OpenSSL 1.1 |
|==============================================================================|
@ -281,6 +281,7 @@ var
function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
function SSLGetVerifyResult(ssl: PSSL):Integer;
function SSLCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer;
function SslSet1Host(ssl: PSSL; hostname: PAnsiChar):Integer;
// libeay.dll
@ -398,6 +399,7 @@ type
TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl;
TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl;
TSSLCtrl = function(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer; cdecl;
TSslSet1Host = function(ssl: PSSL; hostname: PAnsiChar):Integer; cdecl;
TSSLSetTlsextHostName = function(ssl: PSSL; buf: PAnsiChar):Integer; cdecl;
@ -864,6 +866,14 @@ begin
Result := X509_V_ERR_APPLICATION_VERIFICATION;
end;
function SslSet1Host(ssl: PSSL; hostname: PAnsiChar):Integer;
begin
if InitSSLInterface and Assigned(_SslSet1Host) then
Result := _SslSet1Host(ssl, hostname)
else
Result := 0;
end;
// libeay.dll
function X509New: PX509;
begin
@ -1321,6 +1331,7 @@ begin
_SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits');
_SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result');
_SslCtrl := GetProcAddr(SSLLibHandle, 'SSL_ctrl');
_SslSet1Host := GetProcAddr(SSLLibHandle, 'SSL_set1_host');
_OPENSSL_sk_new_null:= GetProcAddr(SSLUtilHandle, 'OPENSSL_sk_new_null');
_OPENSSL_sk_num:= GetProcAddr(SSLUtilHandle, 'OPENSSL_sk_num');
@ -1470,6 +1481,7 @@ begin
_SslCipherGetBits := nil;
_SslGetVerifyResult := nil;
_SslCtrl := nil;
_SslSet1Host := nil;
_SslCtxSetMinProtoVersion := nil;
_SslCtxSetMaxProtoVersion := nil;

9
ssl_openssl3.pas
View File

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 001.000.000 |
| Project : Ararat Synapse | 001.000.001 |
|==============================================================================|
| Content: SSL support by OpenSSL |
|==============================================================================|
| Copyright (c)1999-2022, Lukas Gebauer |
| Copyright (c)1999-2023, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2005-2022. |
| Portions created by Lukas Gebauer are Copyright (c)2005-2023. |
| Portions created by Petr Fejfar are Copyright (c)2011-2012. |
| All Rights Reserved. |
|==============================================================================|
@ -507,7 +507,10 @@ begin
Exit;
end;
if SNIHost<>'' then
begin
SSLCtrl(Fssl, SSL_CTRL_SET_TLSEXT_HOSTNAME, TLSEXT_NAMETYPE_host_name, PAnsiChar(AnsiString(SNIHost)));
SslSet1Host(Fssl, PAnsiChar(AnsiString(SNIHost)));
end;
if FSocket.ConnectionTimeout <= 0 then //do blocking call of SSL_Connect
begin
x := sslconnect(FSsl);

19
ssl_openssl3_lib.pas
View File

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 001.000.000 |
| Project : Ararat Synapse | 001.000.001 |
|==============================================================================|
| Content: SSL support by OpenSSL 3.0 |
|==============================================================================|
| Copyright (c)1999-2022, Lukas Gebauer |
| Copyright (c)1999-2023, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2002-2022. |
| Portions created by Lukas Gebauer are Copyright (c)2002-2023. |
| Portions created by Petr Fejfar are Copyright (c)2011-2012. |
| All Rights Reserved. |
|==============================================================================|
@ -282,6 +282,7 @@ var
function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
function SSLGetVerifyResult(ssl: PSSL):Integer;
function SSLCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer;
function SslSet1Host(ssl: PSSL; hostname: PAnsiChar):Integer;
// libeay.dll
@ -397,6 +398,7 @@ type
TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl;
TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl;
TSSLCtrl = function(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer; cdecl;
TSslSet1Host = function(ssl: PSSL; hostname: PAnsiChar):Integer; cdecl;
TSSLSetTlsextHostName = function(ssl: PSSL; buf: PAnsiChar):Integer; cdecl;
@ -498,6 +500,7 @@ var
_SSLCipherGetBits: TSSLCipherGetBits = nil;
_SSLGetVerifyResult: TSSLGetVerifyResult = nil;
_SSLCtrl: TSSLCtrl = nil;
_SslSet1Host: TSslSet1Host = nil;
// libeay.dll
@ -845,6 +848,14 @@ begin
Result := X509_V_ERR_APPLICATION_VERIFICATION;
end;
function SslSet1Host(ssl: PSSL; hostname: PAnsiChar):Integer;
begin
if InitSSLInterface and Assigned(_SslSet1Host) then
Result := _SslSet1Host(ssl, hostname)
else
Result := 0;
end;
// libeay.dll
function X509New: PX509;
begin
@ -1300,6 +1311,7 @@ begin
_SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits');
_SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result');
_SslCtrl := GetProcAddr(SSLLibHandle, 'SSL_ctrl');
_SslSet1Host := GetProcAddr(SSLLibHandle, 'SSL_set1_host');
_OPENSSL_sk_new_null:= GetProcAddr(SSLUtilHandle, 'OPENSSL_sk_new_null');
_OPENSSL_sk_num:= GetProcAddr(SSLUtilHandle, 'OPENSSL_sk_num');
@ -1449,6 +1461,7 @@ begin
_SslCipherGetBits := nil;
_SslGetVerifyResult := nil;
_SslCtrl := nil;
_SslSet1Host := nil;
_X509New := nil;
_X509Free := nil;

15
ssl_openssl_lib.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Ararat Synapse | 003.009.000 |
| Project : Ararat Synapse | 003.009.001 |
|==============================================================================|
| Content: SSL support by OpenSSL |
|==============================================================================|
@ -812,6 +812,7 @@ var
function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
function SSLGetVerifyResult(ssl: PSSL):Integer;
function SSLCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer;
function SslSet1Host(ssl: PSSL; hostname: PAnsiChar):Integer;
// libeay.dll
function X509New: PX509;
@ -938,6 +939,7 @@ type
TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl;
TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl;
TSSLCtrl = function(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer; cdecl;
TSslSet1Host = function(ssl: PSSL; hostname: PAnsiChar):Integer; cdecl;
TSSLSetTlsextHostName = function(ssl: PSSL; buf: PAnsiChar):Integer; cdecl;
@ -1046,6 +1048,7 @@ var
_SSLCipherGetBits: TSSLCipherGetBits = nil;
_SSLGetVerifyResult: TSSLGetVerifyResult = nil;
_SSLCtrl: TSSLCtrl = nil;
_SslSet1Host: TSslSet1Host = nil;
// libeay.dll
_X509New: TX509New = nil;
@ -1463,6 +1466,14 @@ begin
Result := X509_V_ERR_APPLICATION_VERIFICATION;
end;
function SslSet1Host(ssl: PSSL; hostname: PAnsiChar):Integer;
begin
if InitSSLInterface and Assigned(_SslSet1Host) then
Result := _SslSet1Host(ssl, hostname)
else
Result := 0;
end;
// libeay.dll
function X509New: PX509;
begin
@ -2010,6 +2021,7 @@ begin
_SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits');
_SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result');
_SslCtrl := GetProcAddr(SSLLibHandle, 'SSL_ctrl');
_SslSet1Host := GetProcAddr(SSLLibHandle, 'SSL_set1_host');
_X509New := GetProcAddr(SSLUtilHandle, 'X509_new');
_X509Free := GetProcAddr(SSLUtilHandle, 'X509_free');
@ -2200,6 +2212,7 @@ begin
_SslCipherGetBits := nil;
_SslGetVerifyResult := nil;
_SslCtrl := nil;
_SslSet1Host := nil;
_X509New := nil;
_X509Free := nil;