Add virtual BeforeAccept & BeforeConnect to TSSLOpenSSL
Pascal TCP/IP Library
Brought to you by:
geby
To be compliant with ** SSL/TLS level A+ regarding https://www.ssllabs.com/ssltest/ some patches must be applied to the SSL context via SslCtxCtrl(Fctx,SSL_CTRL_OPTIONS,SSL_OP_STRONG,nil);
Actually this is done by entirely overriding Connect & Accept** methods.
const
SSL_CTRL_OPTIONS = 32;
SSL_OP_NO_SSLv2 = $01000000;
SSL_OP_NO_SSLv3 = $02000000;
SSL_OP_NO_TLSv1 = $04000000;
SSL_OP_NO_TLSv1_2 = $08000000;
SSL_OP_NO_TLSv1_1 = $10000000;
SSL_OP_NO_TLSv1_3 = $20000000;
SSL_OP_NO_TICKET = $00004000;
SSL_OP_CRYPTOPRO_TLSEXT_BUG = $80000000;
SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS = $00000800;
SSL_OP_LEGACY_SERVER_CONNECT = $00000004;
SSL_OP_TLSEXT_PADDING = $00000010;
SSL_OP_SAFARI_ECDHE_ECDSA_BUG = $00000040;
SSL_OP_CIPHER_SERVER_PREFERENCE = $00400000;
SSL_OP_SINGLE_DH_USE = $00100000;
SSL_OP_SINGLE_ECDH_USE = $00080000;
SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION = $00010000;
SSL_OP_STRONG =
SSL_OP_ALL or
SSL_OP_NO_SSLv2 or SSL_OP_NO_SSLv3 or
SSL_OP_NO_TLSv1 or SSL_OP_NO_TLSv1_1 or
SSL_OP_CIPHER_SERVER_PREFERENCE or
SSL_OP_SINGLE_DH_USE or
SSL_OP_SINGLE_ECDH_USE or
SSL_OP_NO_TICKET or
SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION ;
function TSSLProvider.Accept: Boolean;
var
x : Integer;
begin
Result := False;
FSocket.SocksTimeout := 5000;
if FSocket.Socket=INVALID_SOCKET then Exit;
if Prepare(True) then
begin
{$IFDEF CIL}
if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
{$ELSE}
if sslsetfd(FSsl, FSocket.Socket) < 1 then
{$ENDIF}
begin
SSLCheck;
Exit;
end;
x := SslCtxCtrl(Fctx,SSL_CTRL_OPTIONS,SSL_OP_STRONG,nil);
if x<1 then
begin
SSLcheck;
Exit;
end;
x := sslAccept(FSsl);
if x<1 then
begin
SSLcheck;
Exit;
end;
FSSLEnabled := True;
Result := True;
end;
end;
Would the this method (Connect also) be modified to integrate to methods DoBeforeAccept(ssl: PSSL) & DoBeforeConnect(ssl: PSSL) to be used to configure the SSL context instead of rewriting entire methods?
Regards