From c252dd707f2336a3c2d08a9a2b9e277d2ec911d2 Mon Sep 17 00:00:00 2001 From: geby Date: Wed, 13 Apr 2011 14:12:51 +0000 Subject: [PATCH] - new support for TLS SNI in OpenSSL. - improved certificate verification - improved Cryptlib support git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@139 7c85be65-684b-0410-a082-b2ed4fbef004 --- blcksock.pas | 50 ++++++++++++++++- httpsend.pas | 3 ++ ssl_cryptlib.pas | 128 ++++++++++++++++++++++++++++++++++++++++---- ssl_openssl.pas | 4 +- ssl_openssl_lib.pas | 24 +++++++++ 5 files changed, 197 insertions(+), 12 deletions(-) diff --git a/blcksock.pas b/blcksock.pas index 81e10cd..6fdcd26 100644 --- a/blcksock.pas +++ b/blcksock.pas @@ -204,7 +204,13 @@ type insert your code after TCP socket has been sucessfully connected.} THookAfterConnect = procedure(Sender: TObject) of object; - {:This procedural type is used for hook OnHeartbeat. By this hook you can + {:This procedural type is used for hook OnVerifyCert. By this hook you can + insert your additional certificate verification code. Usefull to verify server + CN against URL. } + + THookVerifyCert = function(Sender: TObject):boolean of object; + + {:This procedural type is used for hook OnHeartbeat. By this hook you can call your code repeately during long socket operations. You must enable heartbeats by @Link(HeartbeatRate) property!} THookHeartbeat = procedure(Sender: TObject) of object; @@ -1199,7 +1205,9 @@ type Warning: not all methods and propertis can work in all existing SSL plugins! Please, read documentation of used SSL plugin.} TCustomSSL = class(TObject) + private protected + FOnVerifyCert: THookVerifyCert; FSocket: TTCPBlockSocket; FSSLEnabled: Boolean; FLastError: integer; @@ -1223,7 +1231,11 @@ type FSSHChannelType: string; FSSHChannelArg1: string; FSSHChannelArg2: string; + FCertComplianceLevel: integer; + FSNIHost: string; procedure ReturnError; + procedure SetCertCAFile(const Value: string); virtual; + function DoVerifyCert:boolean; function CreateSelfSignedCert(Host: string): Boolean; virtual; public {: Create plugin class. it is called internally from @link(TTCPBlockSocket)} @@ -1378,7 +1390,7 @@ type {:Used for loading CA certificates from disk file. See to plugin documentation if this method is supported and how!} - property CertCAFile: string read FCertCAFile write FCertCAFile; + property CertCAFile: string read FCertCAFile write SetCertCAFile; {:If @true, then is verified client certificate. (it is good for writing SSL/TLS servers.) When you are not server, but you are client, then if this @@ -1393,6 +1405,20 @@ type {:Second argument of channel type for possible SSH connections} property SSHChannelArg2: string read FSSHChannelArg2 write FSSHChannelArg2; + + {: Level of standards compliance level + (CryptLib: values in cryptlib.pas, -1: use default value ) } + property CertComplianceLevel:integer read FCertComplianceLevel write FCertComplianceLevel; + + {:This event is called when verifying the server certificate immediatally after + a successfull verification in the ssl library.} + property OnVerifyCert: THookVerifyCert read FOnVerifyCert write FOnVerifyCert; + + {: Server Name Identification. Host name to send to server. If empty the host name + found in URL will be used, which should be the normal use (http Header Host = SNI Host). + The value is cleared after the connection is established. + (SNI support requires OpenSSL 0.9.8k or later. Cryptlib not supported, yet ) } + property SNIHost:string read FSNIHost write FSNIHost; end; {:@abstract(Default SSL plugin with no SSL support.) @@ -4094,6 +4120,8 @@ begin FSSHChannelType := ''; FSSHChannelArg1 := ''; FSSHChannelArg2 := ''; + FCertComplianceLevel := -1; //default + FSNIHost := ''; end; procedure TCustomSSL.Assign(const Value: TCustomSSL); @@ -4114,6 +4142,8 @@ begin FPrivateKey := Value.PrivateKey; FPFX := Value.PFX; FPFXfile := Value.PFXfile; + FCertComplianceLevel := Value.CertComplianceLevel; + FSNIHost := Value.FSNIHost; end; procedure TCustomSSL.ReturnError; @@ -4167,6 +4197,11 @@ begin Result := integer(SOCKET_ERROR); end; +procedure TCustomSSL.SetCertCAFile(const Value: string); +begin + FCertCAFile := Value; +end; + function TCustomSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer; begin ReturnError; @@ -4229,6 +4264,17 @@ begin Result := 1; end; +function TCustomSSL.DoVerifyCert:boolean; +begin + if assigned(OnVerifyCert) then + begin + result:=OnVerifyCert(Self); + end + else + result:=true; +end; + + {======================================================================} function TSSLNone.LibVersion: String; diff --git a/httpsend.pas b/httpsend.pas index e74439a..7182db3 100644 --- a/httpsend.pas +++ b/httpsend.pas @@ -352,7 +352,10 @@ begin Exit; if needssl then begin + if (FSock.SSL.SNIHost='') then + FSock.SSL.SNIHost:=FTargetHost; FSock.SSLDoConnect; + FSock.SSL.SNIHost:=''; //don't need it anymore and don't wan't to reuse it in next connection if FSock.LastError <> 0 then Exit; end; diff --git a/ssl_cryptlib.pas b/ssl_cryptlib.pas index 84dd4d8..2d02522 100644 --- a/ssl_cryptlib.pas +++ b/ssl_cryptlib.pas @@ -98,6 +98,7 @@ type FPrivateKeyLabel: string; FDelCert: Boolean; FReadBuffer: string; + FTrustedCAs: array of integer; function SSLCheck(Value: integer): Boolean; function Init(server:Boolean): Boolean; function DeInit: Boolean; @@ -109,6 +110,8 @@ type {:See @inherited} constructor Create(const Value: TTCPBlockSocket); override; destructor Destroy; override; + {:Load trusted CA's in PEM format} + procedure SetCertCAFile(const Value: string); override; {:See @inherited} function LibVersion: String; override; {:See @inherited} @@ -139,6 +142,8 @@ type function GetPeerName: string; override; {:See @inherited} function GetPeerFingerprint: string; override; + {:See @inherited} + function GetVerifyCert: integer; override; published {:name of certificate/key within PKCS#15 file. It can hold more then one certificate/key and each certificate/key must have unique label within one file.} @@ -155,10 +160,12 @@ begin FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE); FPrivateKeyLabel := 'synapse'; FDelCert := false; + FTrustedCAs := nil; end; destructor TSSLCryptLib.Destroy; begin + SetCertCAFile(''); // destroy certificates DeInit; inherited Destroy; end; @@ -211,7 +218,11 @@ begin if FLastError <> 0 then begin Result := False; +{$IF CRYPTLIB_VERSION >= 3400} + FLastErrorDesc := GetString(FCryptSession, CRYPT_ATTRIBUTE_ERRORMESSAGE); +{$ELSE} FLastErrorDesc := GetString(FCryptSession, CRYPT_ATTRIBUTE_INT_ERRORMESSAGE); +{$IFEND} end; end; @@ -313,6 +324,12 @@ begin if x >= 0 then if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x)) then Exit; + + if (FCertComplianceLevel <> -1) then + if not SSLCheck(cryptSetAttribute (CRYPT_UNUSED, CRYPT_OPTION_CERT_COMPLIANCELEVEL, + FCertComplianceLevel)) then + Exit; + if FUsername <> '' then begin cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_USERNAME, @@ -409,6 +426,9 @@ begin Exit; if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then Exit; + if FverifyCert then + if (GetVerifyCert <> 0) or (not DoVerifyCert) then + Exit; FSSLEnabled := True; Result := True; FReadBuffer := ''; @@ -439,8 +459,8 @@ end; function TSSLCryptLib.BiShutdown: boolean; begin - if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then - cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0); +// if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then +// cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0); //no-op DeInit; FReadBuffer := ''; Result := True; @@ -511,7 +531,7 @@ begin if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then Exit; cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); - cryptSetAttribute(cert, CRYPT_CERTINFO_SUBJECTNAME, CRYPT_UNUSED); + cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME); Result := GetString(cert, CRYPT_CERTINFO_DN); cryptDestroyCert(cert); end; @@ -524,7 +544,7 @@ begin if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then Exit; cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); - cryptSetAttribute(cert, CRYPT_CERTINFO_ISSUERNAME, CRYPT_UNUSED); + cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME); Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME); cryptDestroyCert(cert); end; @@ -537,8 +557,8 @@ begin if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then Exit; cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); - cryptSetAttribute(cert, CRYPT_CERTINFO_ISSUERNAME, CRYPT_UNUSED); - Result := GetString(cert, CRYPT_CERTINFO_DN); + cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_ISSUERNAME); + Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME); cryptDestroyCert(cert); end; @@ -551,19 +571,109 @@ begin Exit; cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); Result := GetString(cert, CRYPT_CERTINFO_FINGERPRINT); - Result := MD5(Result); + cryptDestroyCert(cert); +end; + + +procedure TSSLCryptLib.SetCertCAFile(const Value: string); + +var F:textfile; + bInCert:boolean; + s,sCert:string; + cert: CRYPT_CERTIFICATE; + idx:integer; + +begin +if assigned(FTrustedCAs) then + begin + for idx := 0 to High(FTrustedCAs) do + cryptDestroyCert(FTrustedCAs[idx]); + FTrustedCAs:=nil; + end; +if Value<>'' then + begin + AssignFile(F,Value); + reset(F); + bInCert:=false; + idx:=0; + while not eof(F) do + begin + readln(F,s); + if pos('-----END CERTIFICATE-----',s)>0 then + begin + bInCert:=false; + cert:=0; + if (cryptImportCert(PAnsiChar(sCert),length(sCert)-2,CRYPT_UNUSED,cert)=CRYPT_OK) then + begin + cryptSetAttribute( cert, CRYPT_CERTINFO_TRUSTED_IMPLICIT, 1 ); + SetLength(FTrustedCAs,idx+1); + FTrustedCAs[idx]:=cert; + idx:=idx+1; + end; + end; + if bInCert then + sCert:=sCert+s+#13#10; + if pos('-----BEGIN CERTIFICATE-----',s)>0 then + begin + bInCert:=true; + sCert:=''; + end; + end; + CloseFile(F); + end; +end; + +function TSSLCryptLib.GetVerifyCert: integer; +var + cert: CRYPT_CERTIFICATE; + itype,ilocus:integer; +begin + Result := -1; + if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then + Exit; + cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); + result:=cryptCheckCert(cert,CRYPT_UNUSED); + if result<>CRYPT_OK then + begin + //get extended error info if available + cryptGetAttribute(cert,CRYPT_ATTRIBUTE_ERRORtype,itype); + cryptGetAttribute(cert,CRYPT_ATTRIBUTE_ERRORLOCUS,ilocus); + cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME); + FLastError := Result; + FLastErrorDesc := format('SSL/TLS certificate verification failed for "%s"'#13#10'Status: %d. ERRORTYPE: %d. ERRORLOCUS: %d.', + [GetString(cert, CRYPT_CERTINFO_COMMONNAME),result,itype,ilocus]); + end; cryptDestroyCert(cert); end; {==============================================================================} +var imajor,iminor,iver:integer; +// e: ESynapseError; + initialization if cryptInit = CRYPT_OK then SSLImplementation := TSSLCryptLib; cryptAddRandom(nil, CRYPT_RANDOM_SLOWPOLL); - + cryptGetAttribute (CRYPT_UNUSED, CRYPT_OPTION_INFO_MAJORVERSION,imajor); + cryptGetAttribute (CRYPT_UNUSED, CRYPT_OPTION_INFO_MINORVERSION,iminor); +// according to the documentation CRYPTLIB version has 3 digits. recent versions use 4 digits + if CRYPTLIB_VERSION >1000 then + iver:=CRYPTLIB_VERSION div 100 + else + iver:=CRYPTLIB_VERSION div 10; + if (iver <> imajor*10+iminor) then + begin + SSLImplementation :=TSSLNone; +// e := ESynapseError.Create(format('Error wrong cryptlib version (is %d.%d expected %d.%d). ', +// [imajor,iminor,iver div 10, iver mod 10])); +// e.ErrorCode := 0; +// e.ErrorMessage := format('Error wrong cryptlib version (%d.%d expected %d.%d)', +// [imajor,iminor,iver div 10, iver mod 10]); +// raise e; + end; finalization cryptEnd; - end. + diff --git a/ssl_openssl.pas b/ssl_openssl.pas index 1629bab..91123df 100644 --- a/ssl_openssl.pas +++ b/ssl_openssl.pas @@ -501,6 +501,8 @@ begin SSLCheck; Exit; end; + if SNIHost<>'' then + SSLCtrl(Fssl, SSL_CTRL_SET_TLSEXT_HOSTNAME, TLSEXT_NAMETYPE_host_name, pchar(SNIHost)); x := sslconnect(FSsl); if x < 1 then begin @@ -508,7 +510,7 @@ begin Exit; end; if FverifyCert then - if GetVerifyCert <> 0 then + if (GetVerifyCert <> 0) or (not DoVerifyCert) then Exit; FSSLEnabled := True; Result := True; diff --git a/ssl_openssl_lib.pas b/ssl_openssl_lib.pas index 337e7b0..dbe7186 100644 --- a/ssl_openssl_lib.pas +++ b/ssl_openssl_lib.pas @@ -218,6 +218,9 @@ const SSL_FILETYPE_PEM = 1; EVP_PKEY_RSA = 6; + SSL_CTRL_SET_TLSEXT_HOSTNAME = 55; + TLSEXT_NAMETYPE_host_name = 0; + var SSLLibHandle: TLibHandle = 0; SSLUtilHandle: TLibHandle = 0; @@ -420,6 +423,11 @@ var EntryPoint = 'SSL_get_verify_result')] function SSLGetVerifyResult(ssl: PSSL):Integer;external; + [DllImport(DLLSSLName, CharSet = CharSet.Ansi, + SetLastError = False, CallingConvention= CallingConvention.cdecl, + EntryPoint = 'SSL_ctrl')] + function SslCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: IntPtr): integer; external; + [DllImport(DLLUtilName, CharSet = CharSet.Ansi, SetLastError = False, CallingConvention= CallingConvention.cdecl, EntryPoint = 'X509_new')] @@ -712,6 +720,7 @@ var function SSLCipherGetName(c: SslPtr): AnsiString; 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; // libeay.dll function X509New: PX509; @@ -821,6 +830,9 @@ type TSSLCipherGetName = function(c: Sslptr):PAnsiChar; cdecl; 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; + + TSSLSetTlsextHostName = function(ssl: PSSL; buf: PAnsiChar):Integer; cdecl; // libeay.dll TX509New = function: PX509; cdecl; @@ -920,6 +932,7 @@ var _SSLCipherGetName: TSSLCipherGetName = nil; _SSLCipherGetBits: TSSLCipherGetBits = nil; _SSLGetVerifyResult: TSSLGetVerifyResult = nil; + _SSLCtrl: TSSLCtrl = nil; // libeay.dll _X509New: TX509New = nil; @@ -1301,6 +1314,15 @@ begin Result := X509_V_ERR_APPLICATION_VERIFICATION; end; + +function SSLCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer; +begin + if InitSSLInterface and Assigned(_SSLCtrl) then + Result := _SSLCtrl(ssl, cmd, larg, parg) + else + Result := X509_V_ERR_APPLICATION_VERIFICATION; +end; + // libeay.dll function X509New: PX509; begin @@ -1785,6 +1807,7 @@ begin _SslCipherGetName := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_name'); _SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits'); _SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result'); + _SslCtrl := GetProcAddr(SSLLibHandle, 'SSL_ctrl'); _X509New := GetProcAddr(SSLUtilHandle, 'X509_new'); _X509Free := GetProcAddr(SSLUtilHandle, 'X509_free'); @@ -1969,6 +1992,7 @@ begin _SslCipherGetName := nil; _SslCipherGetBits := nil; _SslGetVerifyResult := nil; + _SslCtrl := nil; _X509New := nil; _X509Free := nil;