Menu

#22 Add virtual BeforeAccept & BeforeConnect to TSSLOpenSSL

Just_idea
open
nobody
TSSLOpenSSL (1)
5
2018-12-26
2018-12-26
No

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

Discussion


Log in to post a comment.