pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

- new support for TLS SNI in OpenSSL.

Browse Source 
- improved certificate verification
- improved Cryptlib support

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@139 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2011-04-13 14:12:51 +00:00
parent ea46074261
commit c252dd707f
5 changed files with 197 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
blcksock.pas
View File

@ -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;

3
httpsend.pas
View File

@ -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;

128
ssl_cryptlib.pas
View File

@ -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.

4
ssl_openssl.pas
View File

@ -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;

24
ssl_openssl_lib.pas
View File

@ -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;