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