304 lines
12 KiB
ObjectPascal
304 lines
12 KiB
ObjectPascal
{ 2020/05/11 5.01 Move tests from unit flcTests into seperate units. }
|
|
|
|
{$INCLUDE flcTCPTest.inc}
|
|
|
|
unit flcTCPTest_ClientServerTLS;
|
|
|
|
interface
|
|
|
|
|
|
|
|
{ }
|
|
{ Test }
|
|
{ }
|
|
{$IFDEF TCPCLIENTSERVER_TEST_TLS}
|
|
procedure Test;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
implementation
|
|
|
|
{$IFDEF TCPCLIENTSERVER_TEST_TLS}
|
|
uses
|
|
SysUtils,
|
|
|
|
flcTLSTransportTypes,
|
|
flcTLSTransportClient,
|
|
|
|
flcSocketLib,
|
|
flcTCPConnection,
|
|
flcTCPClient,
|
|
flcTCPServer,
|
|
|
|
flcTCPTest_ClientServer;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Test }
|
|
{ }
|
|
{$IFDEF TCPCLIENTSERVER_TEST_TLS}
|
|
{$ASSERTIONS ON}
|
|
procedure TestClientServerTLS_ReadWrite(
|
|
const TestClientCount: Integer;
|
|
const TestLargeBlock: Boolean;
|
|
const TLSOptions: TTCPClientTLSOptions = DefaultTCPClientTLSOptions;
|
|
const TLSClientOptions: TTCPClientTLSClientOptions = DefaultTLSClientOptions;
|
|
const TLSVersionOptions: TTCPClientTLSVersionOptions = DefaultTLSClientVersionOptions;
|
|
const TLSKeyExchangeOptions: TTCPClientTLSKeyExchangeOptions = DefaultTLSClientKeyExchangeOptions;
|
|
const TLSCipherOptions: TTCPClientTLSCipherOptions = DefaultTLSClientCipherOptions;
|
|
const TLSHashOptions: TTCPClientTLSHashOptions = DefaultTLSClientHashOptions
|
|
);
|
|
|
|
procedure WaitClientConnected(const Client: TF5TCPClient);
|
|
var I : Integer;
|
|
begin
|
|
// wait for client to connect and finish TLS
|
|
I := 0;
|
|
repeat
|
|
Inc(I);
|
|
Sleep(1);
|
|
until (I >= 8000) or
|
|
(
|
|
(Client.State in [csReady, csClosed])
|
|
and
|
|
(
|
|
not Client.TLSEnabled or
|
|
(Client.TLSClient.IsFinishedState or Client.TLSClient.IsReadyState)
|
|
)
|
|
);
|
|
Assert(Client.State = csReady);
|
|
Assert(Client.Connection.State = cnsConnected);
|
|
Assert(not Client.TLSEnabled or Client.TLSClient.IsReadyState);
|
|
end;
|
|
|
|
var C : TF5TCPClientArray;
|
|
S : TF5TCPServer;
|
|
T : TTCPServerClientArray;
|
|
TSC : TTCPServerClient;
|
|
I, K : Integer;
|
|
// CtL : TTLSCertificateList;
|
|
DebugObj : TTCPClientServerTestObj;
|
|
begin
|
|
DebugObj := TTCPClientServerTestObj.Create;
|
|
S := TF5TCPServer.Create(nil);
|
|
SetLength(C, TestClientCount);
|
|
SetLength(T, TestClientCount);
|
|
for K := 0 to TestClientCount - 1 do
|
|
begin
|
|
C[K] := TF5TCPClient.Create(nil);
|
|
// init client
|
|
C[K].Tag := K + 1;
|
|
C[K].OnLog := DebugObj.ClientLog;
|
|
C[K].TLSOptions := TLSOptions;
|
|
C[K].TLSClientOptions := TLSClientOptions;
|
|
C[K].TLSVersionOptions := TLSVersionOptions;
|
|
C[K].TLSKeyExchangeOptions := TLSKeyExchangeOptions;
|
|
C[K].TLSCipherOptions := TLSCipherOptions;
|
|
C[K].TLSHashOptions := TLSHashOptions;
|
|
end;
|
|
try
|
|
// init server
|
|
S.OnLog := DebugObj.ServerLog;
|
|
S.AddressFamily := iaIP4;
|
|
S.BindAddress := '127.0.0.1';
|
|
S.ServerPort := 12545;
|
|
S.MaxClients := -1;
|
|
S.TLSEnabled := True;
|
|
|
|
(*
|
|
S.TLSServer.PrivateKeyRSAPEM := // from stunnel pem file
|
|
'MIICXAIBAAKBgQCxUFMuqJJbI9KnB8VtwSbcvwNOltWBtWyaSmp7yEnqwWel5TFf' +
|
|
'cOObCuLZ69sFi1ELi5C91qRaDMow7k5Gj05DZtLDFfICD0W1S+n2Kql2o8f2RSvZ' +
|
|
'qD2W9l8i59XbCz1oS4l9S09L+3RTZV9oer/Unby/QmicFLNM0WgrVNiKywIDAQAB' +
|
|
'AoGAKX4KeRipZvpzCPMgmBZi6bUpKPLS849o4pIXaO/tnCm1/3QqoZLhMB7UBvrS' +
|
|
'PfHj/Tejn0jjHM9xYRHi71AJmAgzI+gcN1XQpHiW6kATNDz1r3yftpjwvLhuOcp9' +
|
|
'tAOblojtImV8KrAlVH/21rTYQI+Q0m9qnWKKCoUsX9Yu8UECQQDlbHL38rqBvIMk' +
|
|
'zK2wWJAbRvVf4Fs47qUSef9pOo+p7jrrtaTqd99irNbVRe8EWKbSnAod/B04d+cQ' +
|
|
'ci8W+nVtAkEAxdqPOnCISW4MeS+qHSVtaGv2kwvfxqfsQw+zkwwHYqa+ueg4wHtG' +
|
|
'/9+UgxcXyCXrj0ciYCqURkYhQoPbWP82FwJAWWkjgTgqsYcLQRs3kaNiPg8wb7Yb' +
|
|
'NxviX0oGXTdCaAJ9GgGHjQ08lNMxQprnpLT8BtZjJv5rUOeBuKoXagggHQJAaUAF' +
|
|
'91GLvnwzWHg5p32UgPsF1V14siX8MgR1Q6EfgKQxS5Y0Mnih4VXfnAi51vgNIk/2' +
|
|
'AnBEJkoCQW8BTYueCwJBALvz2JkaUfCJc18E7jCP7qLY4+6qqsq+wr0t18+ogOM9' +
|
|
'JIY9r6e1qwNxQ/j1Mud6gn6cRrObpRtEad5z2FtcnwY=';
|
|
TLSCertificateListAppend(CtL,
|
|
MIMEBase64Decode( // from stunnel pem file
|
|
'MIICDzCCAXigAwIBAgIBADANBgkqhkiG9w0BAQQFADBCMQswCQYDVQQGEwJQTDEf' +
|
|
'MB0GA1UEChMWU3R1bm5lbCBEZXZlbG9wZXJzIEx0ZDESMBAGA1UEAxMJbG9jYWxo' +
|
|
'b3N0MB4XDTk5MDQwODE1MDkwOFoXDTAwMDQwNzE1MDkwOFowQjELMAkGA1UEBhMC' +
|
|
'UEwxHzAdBgNVBAoTFlN0dW5uZWwgRGV2ZWxvcGVycyBMdGQxEjAQBgNVBAMTCWxv' +
|
|
'Y2FsaG9zdDCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAsVBTLqiSWyPSpwfF' +
|
|
'bcEm3L8DTpbVgbVsmkpqe8hJ6sFnpeUxX3Djmwri2evbBYtRC4uQvdakWgzKMO5O' +
|
|
'Ro9OQ2bSwxXyAg9FtUvp9iqpdqPH9kUr2ag9lvZfIufV2ws9aEuJfUtPS/t0U2Vf' +
|
|
'aHq/1J28v0JonBSzTNFoK1TYissCAwEAAaMVMBMwEQYJYIZIAYb4QgEBBAQDAgZA' +
|
|
'MA0GCSqGSIb3DQEBBAUAA4GBAAhYFTngWc3tuMjVFhS4HbfFF/vlOgTu44/rv2F+' +
|
|
'ya1mEB93htfNxx3ofRxcjCdorqONZFwEba6xZ8/UujYfVmIGCBy4X8+aXd83TJ9A' +
|
|
'eSjTzV9UayOoGtmg8Dv2aj/5iabNeK1Qf35ouvlcTezVZt2ZeJRhqUHcGaE+apCN' +
|
|
'TC9Y'));
|
|
S.TLSServer.CertificateList := CtL;
|
|
*)
|
|
|
|
S.TLSServer.PEMText :=
|
|
'-----BEGIN CERTIFICATE-----' +
|
|
'MIIDQjCCAiqgAwIBAgIJAKDslQh3d8kdMA0GCSqGSIb3DQEBBQUAMB8xHTAbBgNV' +
|
|
'BAMTFHd3dy5ldGVybmFsbGluZXMuY29tMB4XDTExMTAxODEwMzYwOVoXDTIxMTAx' +
|
|
'NTEwMzYwOVowHzEdMBsGA1UEAxMUd3d3LmV0ZXJuYWxsaW5lcy5jb20wggEiMA0G' +
|
|
'CSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCw/7d6zyehR69DaJCGbk3oMP7pSWya' +
|
|
'U1tDMG+CdqikLqHoo3SBshbvquOVFcy9yY8fECTbNXfOjhV0M6SJgGQ/SP/nfZgx' +
|
|
'MHAK9sWc5G6V5sqPqrTRgkv0Wu25mdO6FRh8DIxOMY0Ppqno5hHZ0emSj1amvtWX' +
|
|
'zBD6pXNGgrFln6HL2eyCwqlL0wTXWO/YrvblF/83Ln9i6luVQ9NtACQBiPcYqoNM' +
|
|
'1OG142xYNpRNp7zrHkNCQeXVxmC6goCgj0BmcSqrUPayLdgkgv8hniUwLYQIt91r' +
|
|
'cxJwGNWxlbLgqQqTdhecKp01JVgO8jy3yFpMEoqCj9+BuuxVqDfvHK1tAgMBAAGj' +
|
|
'gYAwfjAdBgNVHQ4EFgQUbLgD+S3ZSNlU1nxTsjTmAQIfpCQwTwYDVR0jBEgwRoAU' +
|
|
'bLgD+S3ZSNlU1nxTsjTmAQIfpCShI6QhMB8xHTAbBgNVBAMTFHd3dy5ldGVybmFs' +
|
|
'bGluZXMuY29tggkAoOyVCHd3yR0wDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUF' +
|
|
'AAOCAQEACSQTcPC8ga5C/PysnoTNAk4OB+hdgMoS3Fv7ROUV9GqgYED6rJo0+CxD' +
|
|
'g19GLlKt/aBlglh4Ddc7X84dWtftS4JIjjVVkWevt8/sDoZ+ISd/tC9aDX3gOAlW' +
|
|
'RORhfp3Qtyy0AjZcIOAGNkzkotuMG/uOVifPFhTNXwa8hHOGN60riGXEj5sNFFop' +
|
|
'EaxplTfakVq8TxlQivnIETjrEbVX8XkOl4nlsHevC2suXE1ZkQIbQoaAy0WzGGUR' +
|
|
'54GBIzXf32t80S71w5rs/mzVaGOeTZYcHtv5Epd9CNVrEle6w0NW9R7Ov4gXI9n8' +
|
|
'GV9jITGfsOdqu7j9Iaf7MVj+JRE7Dw==' +
|
|
'-----END CERTIFICATE-----' +
|
|
'-----BEGIN RSA PRIVATE KEY-----' +
|
|
'MIIEpQIBAAKCAQEAsP+3es8noUevQ2iQhm5N6DD+6UlsmlNbQzBvgnaopC6h6KN0' +
|
|
'gbIW76rjlRXMvcmPHxAk2zV3zo4VdDOkiYBkP0j/532YMTBwCvbFnORulebKj6q0' +
|
|
'0YJL9FrtuZnTuhUYfAyMTjGND6ap6OYR2dHpko9Wpr7Vl8wQ+qVzRoKxZZ+hy9ns' +
|
|
'gsKpS9ME11jv2K725Rf/Ny5/YupblUPTbQAkAYj3GKqDTNThteNsWDaUTae86x5D' +
|
|
'QkHl1cZguoKAoI9AZnEqq1D2si3YJIL/IZ4lMC2ECLfda3MScBjVsZWy4KkKk3YX' +
|
|
'nCqdNSVYDvI8t8haTBKKgo/fgbrsVag37xytbQIDAQABAoIBAQCdnZnOCtrHjAZO' +
|
|
'iLbqfx9xPPBC3deQNdp3IpKqIvBaBAy6FZSSSfySwCKZiCgieXKxvraTXjGqBmyk' +
|
|
'ZbiHmYWrtV3szrLQWsnreYTQCbtQUYzgEquiRd1NZAt907XvZwm+rY3js8xhu5Bi' +
|
|
'jT4oMf1FPc9z/UxHOLmF+f+FMqy2SM2Fxh3jAsxJBaMVEJXpqdQDI86CATgYrqVY' +
|
|
'mlAWQcQ8pL0wwRctZ+XgjQH52V3sk4cIzqIBTO+MN6emmxDl9JdrGZKRei9YEIhG' +
|
|
'mFeXH7rsGg+TZtfvu1M9Kfy2fdgNwTUoTTn93v8gcrwCbyvl5JCzKy07Om/aOXFr' +
|
|
'I8bSWXIhAoGBANu07hegU99zIhvTWmh2Fuml0Lr+cHcZTObh+oeZg1xaDUrlnFOY' +
|
|
'3fyA5x5Jxib3V7OOAeIz/AsmcYq/649nR8NfeiizY5or84Fy1mazRR8diGDV3nUG' +
|
|
'ZATv6yaOY/z31FOLaxT95tDvqWK+Qr5cykq4e6XDDp9P8odCIjJmUdt7AoGBAM48' +
|
|
'vCjtGQ99BVwkcFIj0IacRj3YKzsp06W6V2Z+czlKctJAMAQN8hu9IcXMEIUsi9GD' +
|
|
'MkyzzxjvGRdmIuS58IFqRbr/fIAQLVpY9SPAL771ZCFHmIrKrCYiLYAcg/BSoR29' +
|
|
'me6aFaEcLBFvzHPFNymdyMsaOHSRMZYUlq6VUbI3AoGBAINJeMURf00VRZqPD4VA' +
|
|
'm6x+813qUVY5/iQxgT2qVD7JaQwKbQHfZTdP58vHlesO/o9DGokLO1+GV27sBF0r' +
|
|
'AE0VLrBHkgs8nEQMVWYFVhaj1SzYYBhZ+0af/0qI5+LwTSanNxPSLS1JKVTiEIwk' +
|
|
'cpV37Bs/letJIMoGkNzBG8UlAoGBAKrSfZt8f3RnvmfKusoeZhsJF9kj0vMHOwob' +
|
|
'ZUc8152Nf7uMdPj2wCGfr3iRBOH5urnH7ILBsHjbmjHaZG6FYKMg7i7sbSf5vkcG' +
|
|
'Rc3d4u5NfSlfjwbuxlYzmvJxLAuDtXXX1MdgEyhGGG485uDBamZrDaTEzBwpIyRH' +
|
|
'W2OxxGBTAoGAZHJQKTajcqQQoRSgPPWWU3X8zdlu5hCgNU54bXaPAfJ6IBWvicMZ' +
|
|
'QLw+9mtshtz+Xy0aBbkxUeUlwwzexb9rg1KZppTq/yRqkOlEkI3ZdqiclTK13BCh' +
|
|
'6r6dC2qqq+DVm9Nlm/S9Gab9YSIA0g5MFg5WLwu1KNwuOODE4Le/91c=' +
|
|
'-----END RSA PRIVATE KEY-----';
|
|
|
|
Assert(S.State = ssInit);
|
|
Assert(not S.Active);
|
|
// start server
|
|
S.Start;
|
|
Assert(S.Active);
|
|
I := 0;
|
|
repeat
|
|
Inc(I);
|
|
Sleep(1);
|
|
until (S.State <> ssStarting) or (I >= 5000);
|
|
Sleep(100);
|
|
Assert(S.State = ssReady);
|
|
Assert(S.ClientCount = 0);
|
|
for K := 0 to TestClientCount - 1 do
|
|
begin
|
|
// init client
|
|
C[K].AddressFamily := cafIP4;
|
|
C[K].Host := '127.0.0.1';
|
|
C[K].Port := '12545';
|
|
C[K].TLSEnabled := True;
|
|
Assert(C[K].State = csInit);
|
|
Assert(not C[K].Active);
|
|
// start client
|
|
C[K].WaitForStartup := True;
|
|
C[K].Start;
|
|
Assert(Assigned(C[K].Connection));
|
|
Assert(C[K].Active);
|
|
end;
|
|
for K := 0 to TestClientCount - 1 do
|
|
// wait for client to connect
|
|
WaitClientConnected(C[K]);
|
|
// wait for server connections
|
|
I := 0;
|
|
repeat
|
|
Inc(I);
|
|
Sleep(1);
|
|
until (S.ClientCount >= TestClientCount) or (I >= 5000);
|
|
Assert(S.ClientCount = TestClientCount);
|
|
// wait for server clients
|
|
TSC := S.ClientIterateFirst;
|
|
for K := 0 to TestClientCount - 1 do
|
|
begin
|
|
T[K] := TSC;
|
|
Assert(Assigned(T[K]));
|
|
Assert(T[K].State in [scsStarting, scsNegotiating, scsReady]);
|
|
Assert(T[K].Connection.State in [cnsProxyNegotiation, cnsConnected]);
|
|
I := 0;
|
|
repeat
|
|
Inc(I);
|
|
Sleep(1);
|
|
until (T[K].Connection.State = cnsConnected) or (I >= 5000);
|
|
Assert(T[K].Connection.State = cnsConnected);
|
|
Assert(not C[K].TLSEnabled or T[K].TLSClient.IsReadyState);
|
|
TSC.ReleaseReference;
|
|
TSC := S.ClientIterateNext(TSC);
|
|
end;
|
|
// test read/write
|
|
TestClientServer_ReadWrite_Blocks(
|
|
TestClientCount,
|
|
TestLargeBlock,
|
|
DebugObj,
|
|
C, T);
|
|
// release reference
|
|
for K := 0 to TestClientCount - 1 do
|
|
T[K].ReleaseReference;
|
|
// stop clients
|
|
for K := TestClientCount - 1 downto 0 do
|
|
begin
|
|
C[K].Stop;
|
|
Assert(C[K].State = csStopped);
|
|
end;
|
|
I := 0;
|
|
repeat
|
|
Inc(I);
|
|
Sleep(1);
|
|
until (S.ClientCount = 0) or (I >= 5000);
|
|
Assert(S.ClientCount = 0);
|
|
// stop server
|
|
S.Stop;
|
|
Assert(not S.Active);
|
|
finally
|
|
for K := TestClientCount - 1 downto 0 do
|
|
begin
|
|
C[K].Finalise;
|
|
FreeAndNil(C[K]);
|
|
end;
|
|
S.Finalise;
|
|
FreeAndNil(S);
|
|
DebugObj.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure Test_ClientServerTLS_ReadWrite;
|
|
begin
|
|
// TestClientServerTLS_ReadWrite(tmTLS, 1, True, [ctoDisableTLS10, ctoDisableTLS11, ctoDisableTLS12]); // SSL 3.0
|
|
TestClientServerTLS_ReadWrite(1, True, DefaultTCPClientTLSOptions, DefaultTLSClientOptions,
|
|
[tlsvoTLS12]); // TLS 1.2
|
|
TestClientServerTLS_ReadWrite(1, True, DefaultTCPClientTLSOptions, DefaultTLSClientOptions,
|
|
[tlsvoTLS11]); // TLS 1.1
|
|
TestClientServerTLS_ReadWrite(1, True, DefaultTCPClientTLSOptions, DefaultTLSClientOptions,
|
|
[tlsvoTLS10]); // TLS 1.0
|
|
end;
|
|
|
|
procedure Test;
|
|
begin
|
|
Test_ClientServerTLS_ReadWrite;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
end.
|