Arno Garrels wrote:
> Zvone wrote:
>> Also, is there a mechanism (in ICS) to check for invalid root
>> certificates (regarding the recent SSL issue with bad Comodo
>> certificates)?
>
> No there isn't.
> It's rather easy to fix TSslContext to include CRLs
> (Certificate Revocation Lists) in the certificate
> verification process.
> That's just adding a new property "SslVerifyFlags" and
> a call to f_X509_STORE_set_flags().
Here's the SVN patch if anybody wants to give it a trial:
Index: OverbyteIcsWSocket.pas
===================================================================
--- OverbyteIcsWSocket.pas (revision 691)
+++ OverbyteIcsWSocket.pas (working copy)
@@ -2003,6 +2003,16 @@
SslVerifyMode_CLIENT_ONCE);
TSslVerifyPeerModes = set of TSslVerifyPeerMode;
+ TSslVerifyFlag = (
+ sslX509_V_FLAG_CB_ISSUER_CHECK,
+ sslX509_V_FLAG_USE_CHECK_TIME,
+ sslX509_V_FLAG_CRL_CHECK,
+ sslX509_V_FLAG_CRL_CHECK_ALL,
+ sslX509_V_FLAG_IGNORE_CRITICAL,
+ sslX509_V_FLAG_X509_STRICT,
+ sslX509_V_FLAG_ALLOW_PROXY_CERTS);
+ TSslVerifyFlags = set of TSslVerifyFlag;
+
TSslOption = (sslOpt_CIPHER_SERVER_PREFERENCE,
sslOpt_MICROSOFT_SESS_ID_BUG,
sslOpt_NETSCAPE_CHALLENGE_BUG,
@@ -2099,6 +2109,7 @@
//FSslIntermCAPath : String;
FSslVerifyPeer : Boolean;
FSslVerifyDepth : Integer;
+ FSslVerifyFlags : Integer;
FSslOptionsValue : Longint;
FSslCipherList : String;
FSslSessCacheModeValue : Longint;
@@ -2149,6 +2160,8 @@
//procedure DebugLogInfo(const Msg: string); { V5.21 }
//procedure SetSslX509Trust(const Value: TSslX509Trust);
function GetIsCtxInitialized : Boolean;
+ function GetSslVerifyFlags: TSslVerifyFlags;
+ procedure SetSslVerifyFlags(const Value: TSslVerifyFlags);
{$IFNDEF OPENSSL_NO_ENGINE}
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
procedure SetCtxEngine(const Value: TSslEngine);
@@ -2193,6 +2206,8 @@
write SetSslVerifyPeer;
property SslVerifyDepth : Integer read FSslVerifyDepth
write FSslVerifyDepth;
+ property SslVerifyFlags : TSslVerifyFlags read GetSslVerifyFlags
+ write
SetSslVerifyFlags;
property SslOptions : TSslOptions read GetSslOptions
write SetSslOptions;
property SslVerifyPeerModes : TSslVerifyPeerModes
@@ -11788,6 +11803,19 @@
SSL_SESS_CACHE_NO_INTERNAL_LOOKUP,
SSL_SESS_CACHE_NO_INTERNAL_STORE);
+
+ SslIntVerifyFlags: array[TSslVerifyFlag] of Integer =
+ (X509_V_FLAG_CB_ISSUER_CHECK,
+ X509_V_FLAG_USE_CHECK_TIME,
+ X509_V_FLAG_CRL_CHECK,
+ X509_V_FLAG_CRL_CHECK_ALL,
+ X509_V_FLAG_IGNORE_CRITICAL,
+ X509_V_FLAG_X509_STRICT,
+ X509_V_FLAG_ALLOW_PROXY_CERTS);
+
+
+{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
+
constructor TSslContext.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -12740,6 +12768,9 @@
LoadCRLFromPath(FSslCRLPath);
//f_SSL_CTX_ctrl(FSslCtx, SSL_CTRL_MODE,
SSL_MODE_ENABLE_PARTIAL_WRITE, nil); // Test
+ f_X509_STORE_set_flags(f_SSL_CTX_get_cert_store(FSslCtx),
+ FSslVerifyFlags);
+
//raise Exception.Create('Test');
// Now the verify stuff
@@ -13091,15 +13122,58 @@
if FSslSessCacheModeValue and SslIntSessCacheModes[SessMode] <> 0
then
Include(Result, SessMode);
-{$IFNDEF NO_SSL_MT}
+{$IFNDEF NO_SSL_MT}
finally
Unlock;
end;
-{$ENDIF}
+{$ENDIF}
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
+function TSslContext.GetSslVerifyFlags: TSslVerifyFlags;
+var
+ VFlag: TSslVerifyFlag;
+begin
+{$IFNDEF NO_SSL_MT}
+ Lock;
+ try
+{$ENDIF}
+ Result := [];
+ for VFlag := Low(TSslVerifyFlag) to High(TSslVerifyFlag) do
+ if (FSslVerifyFlags and SslIntVerifyFlags[VFlag]) <> 0 then
+ Include(Result, VFlag);
+{$IFNDEF NO_SSL_MT}
+ finally
+ Unlock;
+ end;
+{$ENDIF}
+end;
+
+
+{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
+procedure TSslContext.SetSslVerifyFlags(
+ const Value: TSslVerifyFlags);
+var
+ VFlag: TSslVerifyFlag;
+begin
+{$IFNDEF NO_SSL_MT}
+ Lock;
+ try
+{$ENDIF}
+ FSslVerifyFlags := 0;
+ for VFlag := Low(TSslVerifyFlag) to High(TSslVerifyFlag) do
+ if VFlag in Value then
+ FSslVerifyFlags := FSslVerifyFlags or SslIntVerifyFlags[VFlag];
+{$IFNDEF NO_SSL_MT}
+ finally
+ Unlock;
+ end;
+{$ENDIF}
+end;
+
+
+{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslContext.SetSslCipherList(const Value: String);
begin
{$IFNDEF NO_SSL_MT}
--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be
