source upload

This commit is contained in:
Razor12911
2022-01-17 22:16:47 +02:00
parent 12936d065b
commit 098e8c48de
1778 changed files with 1206749 additions and 0 deletions

View File

@@ -0,0 +1,30 @@
{$INCLUDE ../../flcInclude.inc}
{$INCLUDE ../flcTCP.inc}
{$IFDEF DEBUG}
{$IFDEF TEST}
{$DEFINE TCP_TEST}
{$DEFINE TCP_TEST_LOG_TO_CONSOLE}
{$ENDIF}
{$ENDIF}
{$IFDEF TCP_TEST}
{$DEFINE TCPCLIENT_TEST}
{$DEFINE TCPSERVER_TEST}
{$DEFINE TCPCLIENTSERVER_TEST}
{$IFDEF TCPCLIENT_TLS}
{$DEFINE TCPCLIENT_TEST_TLS}
{$ENDIF}
{$IFDEF TCPSERVER_TLS}
{$DEFINE TCPSERVER_TEST_TLS}
{$ENDIF}
{$IFDEF TCPCLIENT_TLS}
{$IFDEF TCPSERVER_TLS}
{$DEFINE TCPCLIENTSERVER_TEST_TLS}
{$ENDIF}
{$ENDIF}
{$ENDIF}

View File

@@ -0,0 +1,94 @@
{ 2020/05/11 5.01 Move tests from unit flcTests into seperate units. }
{$INCLUDE flcTCPTest.inc}
unit flcTCPTest_Buffer;
interface
{ }
{ Test }
{ }
{$IFDEF TCP_TEST}
procedure Test;
{$ENDIF}
implementation
{$IFDEF TCP_TEST}
uses
flcStdTypes,
flcTCPBuffer;
{$ENDIF}
{ }
{ Test }
{ }
{$IFDEF TCP_TEST}
{$ASSERTIONS ON}
procedure Test_Buffer;
var A : TTCPBuffer;
B : Byte;
S : RawByteString;
I, L : Integer;
begin
TCPBufferInitialise(A, 1500, 1000);
Assert(TCPBufferUsed(A) = 0);
Assert(TCPBufferAvailable(A) = 1500);
TCPBufferSetMaxSize(A, 2000);
Assert(TCPBufferAvailable(A) = 2000);
S := 'Fundamentals';
L := Length(S);
TCPBufferAddBuf(A, S[1], L);
Assert(TCPBufferUsed(A) = L);
Assert(not TCPBufferEmpty(A));
S := '';
for I := 1 to L do
S := S + 'X';
Assert(S = 'XXXXXXXXXXXX');
TCPBufferPeek(A, S[1], 3);
Assert(S = 'FunXXXXXXXXX');
Assert(TCPBufferPeekByte(A, B));
Assert(B = Ord('F'));
S := '';
for I := 1 to L do
S := S + #0;
TCPBufferRemove(A, S[1], L);
Assert(S = 'Fundamentals');
Assert(TCPBufferUsed(A) = 0);
S := 'X';
for I := 1 to 2001 do
begin
S[1] := ByteChar(I mod 256);
TCPBufferAddBuf(A, S[1], 1);
Assert(TCPBufferUsed(A) = I);
Assert(TCPBufferAvailable(A) = 2000 - I);
end;
for I := 1 to 2001 do
begin
S[1] := 'X';
TCPBufferRemove(A, S[1], 1);
Assert(S[1] = ByteChar(I mod 256));
Assert(TCPBufferUsed(A) = 2001 - I);
end;
Assert(TCPBufferEmpty(A));
TCPBufferShrink(A);
Assert(TCPBufferEmpty(A));
TCPBufferFinalise(A);
end;
procedure Test;
begin
Test_Buffer;
end;
{$ENDIF}
end.

View File

@@ -0,0 +1,182 @@
{ 2020/05/11 5.01 Move tests from unit flcTests into seperate units. }
{$INCLUDE flcTCPTest.inc}
{$IFDEF TCPCLIENT_TEST}
{$DEFINE TCPCLIENT_TEST_WEB}
{$ENDIF}
unit flcTCPTest_Client;
interface
{$IFDEF TCPCLIENT_TEST}
uses
SysUtils,
SyncObjs,
flcStdTypes,
flcTCPClient;
{$ENDIF}
{$IFDEF TCPCLIENT_TEST}
{ }
{ TCP Client Test Object }
{ }
type
TTCPClientTestObj = class
States : array[TTCPClientState] of Boolean;
Connect : Boolean;
LogMsg : String;
Lock : TCriticalSection;
constructor Create;
destructor Destroy; override;
procedure ClientLog(Sender: TF5TCPClient; LogType: TTCPClientLogType; LogMsg: String; LogLevel: Integer);
procedure ClientConnect(Client: TF5TCPClient);
procedure ClientStateChanged(Client: TF5TCPClient; State: TTCPClientState);
end;
{ }
{ Test }
{ }
procedure Test;
{$ENDIF}
implementation
{$IFDEF TCPCLIENT_TEST}
uses
flcTCPConnection;
{$ENDIF}
{$IFDEF TCPCLIENT_TEST}
{$ASSERTIONS ON}
{ }
{ TCP Client Test Object }
{ }
constructor TTCPClientTestObj.Create;
begin
inherited Create;
Lock := TCriticalSection.Create;
end;
destructor TTCPClientTestObj.Destroy;
begin
FreeAndNil(Lock);
inherited Destroy;
end;
procedure TTCPClientTestObj.ClientLog(Sender: TF5TCPClient; LogType: TTCPClientLogType; LogMsg: String; LogLevel: Integer);
begin
{$IFDEF TCP_TEST_LOG_TO_CONSOLE}
Lock.Acquire;
try
Writeln(LogLevel:2, ' ', LogMsg);
finally
Lock.Release;
end;
{$ENDIF}
end;
procedure TTCPClientTestObj.ClientConnect(Client: TF5TCPClient);
begin
Connect := True;
end;
procedure TTCPClientTestObj.ClientStateChanged(Client: TF5TCPClient; State: TTCPClientState);
begin
States[State] := True;
end;
{ }
{ Test }
{ }
{$IFDEF TCPCLIENT_TEST_WEB}
procedure Test_Client_Web;
var
C : TF5TCPClient;
S : RawByteString;
A : TTCPClientTestObj;
begin
A := TTCPClientTestObj.Create;
C := TF5TCPClient.Create(nil);
try
// init
C.OnLog := A.ClientLog;
C.LocalHost := '0.0.0.0';
C.Host := 'www.google.com';
C.Port := '80';
C.OnStateChanged := A.ClientStateChanged;
C.OnConnected := A.ClientConnect;
C.WaitForStartup := True;
Assert(not C.Active);
Assert(C.State = csInit);
Assert(C.IsConnectionClosed);
Assert(not A.Connect);
// start
C.Active := True;
Assert(C.Active);
Assert(C.State <> csInit);
Assert(A.States[csStarting]);
Assert(C.IsConnectingOrConnected);
Assert(not C.IsConnectionClosed);
// wait connect
C.WaitForConnect(8000);
Assert(C.IsConnected);
Assert(C.State = csReady);
Assert(C.Connection.State = cnsConnected);
Assert(A.Connect);
Assert(A.States[csConnecting]);
Assert(A.States[csConnected]);
Assert(A.States[csReady]);
// send request
C.Connection.WriteByteString(
'GET / HTTP/1.1'#13#10 +
'Host: www.google.com'#13#10 +
'Date: 7 Nov 2013 12:34:56 GMT'#13#10 +
#13#10);
// wait response
C.BlockingConnection.WaitForReceiveData(1, 5000);
// read response
S := C.Connection.ReadByteString(C.Connection.ReadBufferUsed);
Assert(S <> '');
// close
C.Connection.Close;
C.WaitForClose(2000);
Assert(not C.IsConnected);
Assert(C.IsConnectionClosed);
Assert(C.Connection.State = cnsClosed);
// stop
C.Active := False;
Assert(not C.Active);
Assert(C.IsConnectionClosed);
finally
C.Finalise;
FreeAndNil(C);
A.Free;
end;
end;
{$ENDIF}
procedure Test;
begin
{$IFDEF TCPCLIENT_TEST_WEB}
Test_Client_Web;
{$ENDIF}
end;
{$ENDIF}
end.

View File

@@ -0,0 +1,863 @@
{ 2020/05/11 5.01 Move tests from unit flcTests into seperate units. }
{$INCLUDE flcTCPTest.inc}
unit flcTCPTest_ClientServer;
interface
{$IFDEF TCPCLIENTSERVER_TEST}
uses
{$IFDEF OS_MSWIN}
Windows,
{$ENDIF}
SysUtils,
SyncObjs,
Classes,
flcStdTypes,
flcTCPConnection,
flcTCPClient,
flcTCPServer;
{$ENDIF}
{$IFDEF TCPCLIENTSERVER_TEST}
{ }
{ TCP ClientServer Test Object }
{ }
type
TTCPClientServerTestObj = class
Lock : TCriticalSection;
constructor Create;
destructor Destroy; override;
procedure Log(Msg: String);
procedure ClientLog(Client: TF5TCPClient; LogType: TTCPClientLogType; Msg: String; LogLevel: Integer);
procedure ServerLog(Sender: TF5TCPServer; LogType: TTCPLogType; Msg: String; LogLevel: Integer);
end;
TTCPClientServerBlockTestObj = class
FinC, FinS : Boolean;
procedure ClientExec(Client: TF5TCPClient; Connection: TTCPBlockingConnection; var CloseOnExit: Boolean);
procedure ServerExec(Sender: TTCPServerClient; Connection: TTCPBlockingConnection; var CloseOnExit: Boolean);
end;
{ }
{ Test functions }
{ }
type
TF5TCPClientArray = array of TF5TCPClient;
TTCPServerClientArray = array of TTCPServerClient;
procedure TestClientServer_ReadWrite_Blocks(
const TestClientCount: Integer;
const TestLargeBlock: Boolean;
const DebugObj : TTCPClientServerTestObj;
const C: TF5TCPClientArray;
const T: TTCPServerClientArray);
{ }
{ Test }
{ }
procedure Test;
{$ENDIF}
implementation
{$IFDEF TCPCLIENTSERVER_TEST}
uses
flcSocketLib,
flcTimers;
{$ENDIF}
{$IFDEF TCPCLIENTSERVER_TEST}
{$ASSERTIONS ON}
{ }
{ TCP ClientServer Test Object }
{ }
{ TTCPClientServerTestObj }
constructor TTCPClientServerTestObj.Create;
begin
inherited Create;
Lock := TCriticalSection.Create;
end;
destructor TTCPClientServerTestObj.Destroy;
begin
FreeAndNil(Lock);
inherited Destroy;
end;
{$IFDEF TCP_TEST_LOG_TO_CONSOLE}
procedure TTCPClientServerTestObj.Log(Msg: String);
var S : String;
begin
S := FormatDateTime('hh:nn:ss.zzz', Now) + ' ' + Msg;
Lock.Acquire;
try
Writeln(S);
finally
Lock.Release;
end;
end;
{$ELSE}
procedure TTCPClientServerTestObj.Log(Msg: String);
begin
end;
{$ENDIF}
procedure TTCPClientServerTestObj.ClientLog(Client: TF5TCPClient; LogType: TTCPClientLogType; Msg: String; LogLevel: Integer);
begin
Log('C[' + IntToStr(Client.Tag) + ']:' + Msg);
end;
procedure TTCPClientServerTestObj.ServerLog(Sender: TF5TCPServer; LogType: TTCPLogType; Msg: String; LogLevel: Integer);
begin
Log('S:' + Msg);
end;
{ TTCPClientServerBlockTestObj }
procedure TTCPClientServerBlockTestObj.ClientExec(Client: TF5TCPClient;Connection: TTCPBlockingConnection; var CloseOnExit: Boolean);
var
B1 : LongWord;
begin
Sleep(200);
B1 := 1234;
Connection.Write(B1, 4, 10000);
B1 := 0;
Connection.Read(B1, 4, 10000);
Assert(B1 = 22222);
FinC := True;
end;
procedure TTCPClientServerBlockTestObj.ServerExec(Sender: TTCPServerClient; Connection: TTCPBlockingConnection; var CloseOnExit: Boolean);
var
B1 : LongWord;
begin
B1 := 0;
Connection.Read(B1, 4, 10000);
Assert(B1 = 1234);
B1 := 22222;
Connection.Write(B1, 4, 10000);
FinS := True;
end;
{ }
{ Test }
{ }
procedure TestClientServer_ReadWrite_Blocks(
const TestClientCount: Integer;
const TestLargeBlock: Boolean;
const DebugObj : TTCPClientServerTestObj;
const C: TF5TCPClientArray;
const T: TTCPServerClientArray);
const
LargeBlockSize = 256 * 1024;
var
K, I, J : Integer;
F : RawByteString;
B : Byte;
begin
// read & write (small block): client to server
for K := 0 to TestClientCount - 1 do
C[K].Connection.WriteByteString('Fundamentals');
for K := 0 to TestClientCount - 1 do
begin
DebugObj.Log('{RWS:' + IntToStr(K + 1) + ':A}');
I := 0;
repeat
Inc(I);
Sleep(1);
until (T[K].Connection.ReadBufferUsed >= 12) or (I >= 5000);
DebugObj.Log('{RWS:' + IntToStr(K + 1) + ':B}');
Assert(T[K].Connection.ReadBufferUsed = 12);
F := T[K].Connection.PeekByteString(3);
Assert(F = 'Fun');
Assert(T[K].Connection.PeekByte(B));
Assert(B = Ord('F'));
F := T[K].Connection.ReadByteString(12);
Assert(F = 'Fundamentals');
DebugObj.Log('{RWS:' + IntToStr(K + 1) + ':Z}');
end;
// read & write (small block): server to client
for K := 0 to TestClientCount - 1 do
T[K].Connection.WriteByteString('123');
for K := 0 to TestClientCount - 1 do
begin
C[K].BlockingConnection.WaitForReceiveData(3, 5000);
F := C[K].Connection.ReadByteString(3);
Assert(F = '123');
end;
if TestLargeBlock then
begin
// read & write (large block): client to server
F := '';
for I := 1 to LargeBlockSize do
F := F + #1;
for K := 0 to TestClientCount - 1 do
C[K].Connection.WriteByteString(F);
for K := 0 to TestClientCount - 1 do
begin
J := LargeBlockSize;
repeat
I := 0;
repeat
Inc(I);
Sleep(1);
Assert(C[K].State = csReady);
Assert(T[K].State = scsReady);
until (T[K].Connection.ReadBufferUsed > 0) or (I >= 5000);
Assert(T[K].Connection.ReadBufferUsed > 0);
F := T[K].Connection.ReadByteString(T[K].Connection.ReadBufferUsed);
Assert(Length(F) > 0);
for I := 1 to Length(F) do
Assert(F[I] = #1);
Dec(J, Length(F));
until J <= 0;
Assert(J = 0);
Sleep(2);
Assert(T[K].Connection.ReadBufferUsed = 0);
end;
// read & write (large block): server to client
F := '';
for I := 1 to LargeBlockSize do
F := F + #1;
for K := 0 to TestClientCount - 1 do
T[K].Connection.WriteByteString(F);
for K := 0 to TestClientCount - 1 do
begin
J := LargeBlockSize;
repeat
C[K].BlockingConnection.WaitForReceiveData(1, 5000);
Assert(C[K].State = csReady);
Assert(T[K].State = scsReady);
Assert(C[K].Connection.ReadBufferUsed > 0);
F := C[K].Connection.ReadByteString(C[K].Connection.ReadBufferUsed);
Assert(Length(F) > 0);
for I := 1 to Length(F) do
Assert(F[I] = #1);
Dec(J, Length(F));
until J <= 0;
Assert(J = 0);
Sleep(2);
Assert(C[K].Connection.ReadBufferUsed = 0);
end;
end;
end;
procedure TestClientServer_ReadWrite(
const TestClientCount: Integer;
const TestLargeBlock: Boolean
);
procedure WaitClientConnected(const Client: TF5TCPClient);
var I : Integer;
begin
I := 0;
repeat
Inc(I);
Sleep(1);
until (I >= 8000) or
(Client.State in [csReady, csClosed]);
Assert(Client.State = csReady);
Assert(Client.Connection.State = cnsConnected);
end;
var C : TF5TCPClientArray;
S : TF5TCPServer;
T : TTCPServerClientArray;
TSC : TTCPServerClient;
I, K : Integer;
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;
end;
try
// init server
S.OnLog := DebugObj.ServerLog;
S.AddressFamily := iaIP4;
S.BindAddress := '127.0.0.1';
S.ServerPort := 12545;
S.MaxClients := -1;
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';
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]);
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_ClientServer_StopStart;
const
TestClientCount = 10;
TestRepeatCount = 3;
var C : array of TF5TCPClient;
S : TF5TCPServer;
I, K : Integer;
J : Integer;
DebugObj : TTCPClientServerTestObj;
begin
DebugObj := TTCPClientServerTestObj.Create;
S := TF5TCPServer.Create(nil);
SetLength(C, 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;
end;
try
// init server
S.OnLog := DebugObj.ServerLog;
S.AddressFamily := iaIP4;
S.BindAddress := '127.0.0.1';
S.ServerPort := 12645;
S.MaxClients := -1;
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);
Assert(S.State = ssReady);
Assert(S.ClientCount = 0);
// init clients
for K := 0 to TestClientCount - 1 do
begin
C[K].AddressFamily := cafIP4;
C[K].Host := '127.0.0.1';
C[K].Port := '12645';
C[K].WaitForStartup := True;
Assert(C[K].State = csInit);
Assert(not C[K].Active);
end;
// test quickly starting and stopping clients
for J := 0 to TestRepeatCount - 1 do
begin
// start client
for K := 0 to TestClientCount - 1 do
begin
C[K].Start;
// connection must exist when Start exits
Assert(Assigned(C[K].Connection));
Assert(C[K].Active);
end;
// delay
if J > 0 then
Sleep(J - 1);
// stop clients
for K := TestClientCount - 1 downto 0 do
begin
C[K].Stop;
Assert(C[K].State = csStopped);
Assert(not Assigned(C[K].Connection));
end;
// delay
if J > 0 then
Sleep(J - 1);
// re-start client
for K := 0 to TestClientCount - 1 do
begin
C[K].Start;
// connection must exist when Start exits
Assert(Assigned(C[K].Connection));
Assert(C[K].Active);
end;
// delay
if J > 0 then
Sleep(J - 1);
// re-stop clients
for K := TestClientCount - 1 downto 0 do
begin
C[K].Stop;
Assert(C[K].State = csStopped);
Assert(not Assigned(C[K].Connection));
end;
end;
// 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_ClientServer_ReadWrite;
begin
TestClientServer_ReadWrite(1, True);
TestClientServer_ReadWrite(2, True);
TestClientServer_ReadWrite(5, True);
{$IFNDEF LINUX} // FAILS
TestClientServer_ReadWrite(30, False);
{$ENDIF}
end;
procedure Test_ClientServer_Shutdown;
var
S : TF5TCPServer;
C : TF5TCPClient;
T : TTCPServerClient;
B, X : RawByteString;
I, L, N, M : Integer;
begin
S := TF5TCPServer.Create(nil);
S.AddressFamily := iaIP4;
S.BindAddress := '127.0.0.1';
S.ServerPort := 12213;
S.MaxClients := -1;
S.Active := True;
Sleep(100);
C := TF5TCPClient.Create(nil);
C.LocalHost := '0.0.0.0';
C.Host := '127.0.0.1';
C.Port := '12213';
C.WaitForStartup := True;
C.UseWorkerThread := False;
C.Active := True;
Sleep(100);
Assert(C.State = csReady);
SetLength(B, 1024 * 1024);
for I := 1 to Length(B) do
B[I] := #1;
L := C.Connection.WriteByteString(B);
Assert(L > 1024);
Sleep(1);
Assert(not C.IsShutdownComplete);
C.Shutdown;
for I := 1 to 10 do
begin
if C.IsShutdownComplete then
break;
Sleep(50);
end;
Assert(C.IsShutdownComplete);
T := S.ClientIterateFirst;
Assert(Assigned(T));
SetLength(X, L);
M := 0;
repeat
N := T.Connection.Read(X[1], L);
Inc(M, N);
Sleep(10);
until N <= 0;
Assert(M = L);
Sleep(100);
Assert(C.State = csClosed);
Assert(T.State = scsClosed);
T.ReleaseReference;
C.Close;
C.Finalise;
C.Free;
S.Active := False;
S.Finalise;
S.Free;
end;
procedure Test_ClientServer_Block;
var
S : TF5TCPServer;
C : TF5TCPClient;
DebugObj : TTCPClientServerTestObj;
TestObj : TTCPClientServerBlockTestObj;
begin
DebugObj := TTCPClientServerTestObj.Create;
TestObj := TTCPClientServerBlockTestObj.Create;
S := TF5TCPServer.Create(nil);
S.OnLog := DebugObj.ServerLog;
S.AddressFamily := iaIP4;
S.BindAddress := '127.0.0.1';
S.ServerPort := 12145;
S.MaxClients := -1;
S.UseWorkerThread := True;
S.OnClientWorkerExecute := TestObj.ServerExec;
S.Active := True;
Sleep(50);
C := TF5TCPClient.Create(nil);
C.OnLog := DebugObj.ClientLog;
C.LocalHost := '0.0.0.0';
C.Host := '127.0.0.1';
C.Port := '12145';
C.WaitForStartup := True;
C.UseWorkerThread := True;
C.OnWorkerExecute := TestObj.ClientExec;
C.Active := True;
repeat
Sleep(1);
until TestObj.FinC and TestObj.FinS;
C.Active := False;
S.Active := False;
C.Finalise;
FreeAndNil(C);
S.Finalise;
FreeAndNil(S);
TestObj.Free;
DebugObj.Free;
end;
procedure Test_ClientServer_RetryConnect;
var
S : TF5TCPServer;
C : TF5TCPClient;
DebugObj : TTCPClientServerTestObj;
TestObj : TTCPClientServerBlockTestObj;
I : Integer;
begin
DebugObj := TTCPClientServerTestObj.Create;
TestObj := TTCPClientServerBlockTestObj.Create;
S := TF5TCPServer.Create(nil);
S.OnLog := DebugObj.ServerLog;
S.AddressFamily := iaIP4;
S.BindAddress := '127.0.0.1';
S.ServerPort := 12045;
S.MaxClients := -1;
S.UseWorkerThread := True;
S.OnClientWorkerExecute := TestObj.ServerExec;
C := TF5TCPClient.Create(nil);
C.OnLog := DebugObj.ClientLog;
C.LocalHost := '0.0.0.0';
C.Host := '127.0.0.1';
C.Port := '12045';
C.WaitForStartup := True;
C.UseWorkerThread := True;
C.OnWorkerExecute := TestObj.ClientExec;
C.RetryFailedConnect := True;
C.RetryFailedConnectDelaySec := 2;
C.RetryFailedConnectMaxAttempts := 3;
C.ReconnectOnDisconnect := False;
C.Active := True;
Sleep(2000);
S.Active := True;
I := 0;
repeat
Sleep(1);
Inc(I);
until (TestObj.FinC and TestObj.FinS) or (I > 4000);
Assert(TestObj.FinC and TestObj.FinS);
//S.Active := False;
//Sleep(100000);
C.Active := False;
S.Active := False;
C.Finalise;
FreeAndNil(C);
S.Finalise;
FreeAndNil(S);
TestObj.Free;
DebugObj.Free;
end;
procedure Test_ClientServer_Latency;
procedure DoYield;
begin
{$IFDEF DELPHI}
{$IFDEF OS_MSWIN}
Yield;
{$ELSE}
TThread.Yield;
{$ENDIF}
{$ELSE}
TThread.Yield;
{$ENDIF}
end;
procedure WaitClientConnected(const Client: TF5TCPClient);
var I : Integer;
begin
// wait for client to connect
I := 0;
repeat
Inc(I);
Sleep(1);
until (I >= 8000) or
(Client.State in [csReady, csClosed]);
Assert(Client.State = csReady);
Assert(Client.Connection.State = cnsConnected);
end;
var C : TF5TCPClient;
S : TF5TCPServer;
TSC : TTCPServerClient;
I, Nr : Integer;
F : RawByteString;
DebugObj : TTCPClientServerTestObj;
T : Word64;
Buf : array[0..15] of Byte;
const
Test1N = 5;
begin
DebugObj := TTCPClientServerTestObj.Create;
DebugObj.Log('');
DebugObj.Log('Test_ClientServer_Latency:');
S := TF5TCPServer.Create(nil);
C := TF5TCPClient.Create(nil);
// init client
C.Tag := 1;
C.OnLog := DebugObj.ClientLog;
try
// init server
S.OnLog := DebugObj.ServerLog;
S.AddressFamily := iaIP4;
S.BindAddress := '127.0.0.1';
Randomize;
S.ServerPort := 12513 + Random(1000);
S.MaxClients := -1;
Assert(S.State = ssInit);
Assert(not S.Active);
// start server
S.Start;
Assert(S.Active);
I := 0;
repeat
Inc(I);
Sleep(10);
until (S.State <> ssStarting) or (I >= 400);
Sleep(100);
Assert(S.State = ssReady);
Assert(S.ClientCount = 0);
// init client
C.AddressFamily := cafIP4;
C.Host := '127.0.0.1';
C.Port := IntToStr(S.ServerPort);
Assert(C.State = csInit);
Assert(not C.Active);
// start client
C.WaitForStartup := True;
C.Start;
Assert(Assigned(C.Connection));
Assert(C.Active);
// wait for client to connect
WaitClientConnected(C);
// wait for server connections
I := 0;
repeat
Inc(I);
Sleep(10);
until (S.ClientCount >= 1) or (I >= 10000);
Assert(S.ClientCount = 1);
// wait for server clients
TSC := S.ClientIterateFirst;
Assert(Assigned(TSC));
Assert(TSC.State in [scsStarting, scsNegotiating, scsReady]);
Assert(TSC.Connection.State in [cnsProxyNegotiation, cnsConnected]);
for Nr := 1 to Test1N do
begin
// read & write (small block): client to server
// read directly from connection before buffered
T := GetMicroTick;
C.Connection.WriteByteString('Fundamentals');
repeat
DoYield;
F := TSC.Connection.ReadByteString(12);
if F = 'Fundamentals' then
break;
until MicroTickDelta(T, GetMicroTick) >= 5000000; // 5s
T := MicroTickDelta(T, GetMicroTick);
DebugObj.Log(' Latency1_ClientToServer:' + IntToStr(T));
Assert(F = 'Fundamentals');
// read & write (small block): server to client
// read directly from connection before buffered
FillChar(Buf, SizeOf(Buf), 0);
T := GetMicroTick;
TSC.Connection.WriteByteString('123');
repeat
DoYield;
if C.Connection.Read(Buf[0], 3) = 3 then
if (Buf[0] = Ord('1')) and (Buf[1] = Ord('2')) and (Buf[2] = Ord('3')) then
break;
until MicroTickDelta(T, GetMicroTick) >= 5000000; // 5s
T := MicroTickDelta(T, GetMicroTick);
DebugObj.Log(' Latency2_ServerToClient:' + IntToStr(T));
Assert((Buf[0] = Ord('1')) and (Buf[1] = Ord('2')) and (Buf[2] = Ord('3')));
// read & write (small block): client to server
T := GetMicroTick;
C.Connection.WriteByteString('Fundamentals');
repeat
DoYield;
until (TSC.Connection.ReadBufferUsed >= 12) or (MicroTickDelta(T, GetMicroTick) >= 5000000);
T := MicroTickDelta(T, GetMicroTick);
DebugObj.Log(' Latency3_ClientToServer:' + IntToStr(T));
Assert(TSC.Connection.ReadBufferUsed = 12);
F := TSC.Connection.ReadByteString(12);
Assert(F = 'Fundamentals');
// read & write (small block): server to client
T := GetMicroTick;
TSC.Connection.WriteByteString('123');
repeat
DoYield;
until (C.Connection.ReadBufferUsed >= 3) or (MicroTickDelta(T, GetMicroTick) >= 5000000);
T := MicroTickDelta(T, GetMicroTick);
DebugObj.Log(' Latency4_ServerToClient:' + IntToStr(T));
F := C.Connection.ReadByteString(3);
Assert(F = '123');
end;
TSC.ReleaseReference;
finally
C.Free;
S.Free;
end;
FreeAndNil(DebugObj);
end;
procedure Test;
begin
Test_ClientServer_ReadWrite;
Test_ClientServer_StopStart;
Test_ClientServer_Shutdown;
Test_ClientServer_Block;
Test_ClientServer_RetryConnect;
Test_ClientServer_Block;
Test_ClientServer_ReadWrite;
Test_ClientServer_Latency;
end;
{$ENDIF}
end.

View File

@@ -0,0 +1,303 @@
{ 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.

View File

@@ -0,0 +1,172 @@
{ 2020/05/11 5.01 Move tests from unit flcTests into seperate units. }
{$INCLUDE flcTCPTest.inc}
{$IFDEF TCPCLIENT_TEST_TLS}
{$DEFINE TCPCLIENT_TEST_TLS_WEB}
{$ENDIF}
unit flcTCPTest_ClientTLS;
interface
{ }
{ Test }
{ }
{$IFDEF TCPCLIENT_TEST_TLS}
procedure Test;
{$ENDIF}
implementation
{$IFDEF TCPCLIENT_TEST_TLS}
uses
SysUtils,
flcTLSTransportTypes,
flcTLSTransportConnection,
flcTLSTransportClient,
flcTCPConnection,
flcTCPClient,
flcTCPTest_Client;
{$ENDIF}
{ }
{ Test }
{ }
{$IFDEF TCPCLIENT_TEST_TLS}
{$ASSERTIONS ON}
{$IFDEF TCPCLIENT_TEST_TLS_WEB}
const
TLSWebTestHost = 'www.rfc.org'; // DHE_RSA_WITH_AES_256_CBC_SHA
procedure Test_Client_TLS_Web(
const TLSOptions: TTCPClientTLSOptions = [];
const TLSClientOptions: TTCPClientTLSClientOptions = DefaultTLSClientOptions;
const TLSVersionOptions: TTCPClientTLSVersionOptions = DefaultTLSClientVersionOptions;
const TLSKeyExchangeOptions: TTCPClientTLSKeyExchangeOptions = DefaultTLSClientKeyExchangeOptions;
const TLSCipherOptions: TTCPClientTLSCipherOptions = DefaultTLSClientCipherOptions;
const TLSHashOptions: TTCPClientTLSHashOptions = DefaultTLSClientHashOptions
);
var
C : TF5TCPClient;
I, L : Integer;
S : RawByteString;
A : TTCPClientTestObj;
begin
A := TTCPClientTestObj.Create;
C := TF5TCPClient.Create(nil);
try
// init
C.OnLog := A.ClientLog;
C.TLSEnabled := True;
C.TLSOptions := TLSOptions;
C.TLSClientOptions := TLSClientOptions;
C.TLSVersionOptions := TLSVersionOptions;
C.TLSKeyExchangeOptions := TLSKeyExchangeOptions;
C.TLSCipherOptions := TLSCipherOptions;
C.TLSHashOptions := TLSHashOptions;
C.LocalHost := '0.0.0.0';
C.Host := TLSWebTestHost;
C.Port := '443';
// start
C.Active := True;
Assert(C.Active);
// wait connect
I := 0;
repeat
Sleep(1);
Inc(I);
until (
(C.State in [csReady, csClosed]) and
(C.TLSClient.ConnectionState in [tlscoApplicationData, tlscoErrorBadProtocol, tlscoCancelled, tlscoClosed]) and
(C.Connection.State = cnsConnected)
) or
(I = 5000);
Assert(C.State = csReady);
Assert(C.Connection.State = cnsConnected);
Assert(C.TLSClient.ConnectionState = tlscoApplicationData);
// send
S :=
'GET / HTTP/1.1'#13#10 +
'Host: ' + TLSWebTestHost + #13#10 +
'Date: 11 Oct 2011 12:34:56 GMT'#13#10 +
#13#10;
C.Connection.Write(S[1], Length(S));
C.BlockingConnection.WaitForTransmitFin(5000);
// read
C.BlockingConnection.WaitForReceiveData(1, 5000);
L := C.Connection.ReadBufferUsed;
Assert(L > 0);
SetLength(S, L);
Assert(C.Connection.Read(S[1], L) = L);
Assert(Copy(S, 1, 6) = 'HTTP/1');
// close
C.BlockingConnection.Shutdown(2000, 2000, 5000);
Assert(C.Connection.State = cnsClosed);
// stop
C.Active := False;
Assert(not C.Active);
finally
C.Finalise;
FreeAndNil(C);
A.Free;
end;
end;
procedure TestClientTLSWeb;
begin
//Test_Client_TLS_Web([ctoDisableTLS10, ctoDisableTLS11, ctoDisableTLS12]); // SSL 3
//Test_Client_TLS_Web([ctoDisableSSL3, ctoDisableTLS11, ctoDisableTLS12]); // TLS 1.0
//Test_Client_TLS_Web([ctoDisableSSL3, ctoDisableTLS10, ctoDisableTLS12]); // TLS 1.1
// TLS 1.2
{Test_Client_TLS_Web(
DefaultTCPClientTLSOptions,
DefaultTLSClientOptions,
[tlsvoTLS12],
DefaultTLSClientKeyExchangeOptions,
DefaultTLSClientCipherOptions,
DefaultTLSClientHashOptions);}
// TLS 1.2
Test_Client_TLS_Web(
DefaultTCPClientTLSOptions,
DefaultTLSClientOptions,
[tlsvoTLS12],
[tlskeoDHE_RSA],
DefaultTLSClientCipherOptions,
DefaultTLSClientHashOptions);
{ Test_Client_TLS_Web(
DefaultTCPClientTLSOptions,
DefaultTLSClientOptions,
[tlsvoTLS12],
[tlskeoRSA],
[tlsco3DES],
DefaultTLSClientHashOptions); }
//Test_Client_TLS_Web([]);
end;
{$ENDIF}
procedure Test;
begin
{$IFDEF TCPCLIENT_TEST_TLS_WEB}
TestClientTLSWeb;
{$ENDIF}
end;
{$ENDIF}
end.

View File

@@ -0,0 +1,223 @@
{ 2020/05/11 5.01 Move tests from unit flcTests into seperate units. }
{$INCLUDE flcTCPTest.inc}
unit flcTCPTest_Server;
interface
{ }
{ Test }
{ }
{$IFDEF TCPSERVER_TEST}
procedure Test;
{$ENDIF}
implementation
{$IFDEF TCPSERVER_TEST}
uses
SysUtils,
flcStdTypes,
flcSocketLib,
flcSocket,
flcTCPUtils,
flcTCPConnection,
flcTCPServer;
{$ENDIF}
{ }
{ Test }
{ }
{$IFDEF TCPSERVER_TEST}
{$ASSERTIONS ON}
procedure Test_Server_Simple;
var S : TF5TCPServer;
I : Integer;
begin
S := TF5TCPServer.Create(nil);
try
// init
S.AddressFamily := iaIP4;
S.ServerPort := 12745;
S.MaxClients := -1;
Assert(S.State = ssInit);
Assert(not S.Active);
// activate
S.Active := True;
Assert(S.Active);
I := 0;
repeat
Inc(I);
Sleep(1);
until (S.State <> ssStarting) or (I >= 5000);
Assert(S.State = ssReady);
Assert(S.ClientCount = 0);
// shut down
S.Active := False;
Assert(not S.Active);
Assert(S.State = ssClosed);
finally
S.Finalise;
FreeAndNil(S);
end;
S := TF5TCPServer.Create(nil);
try
// init
S.AddressFamily := iaIP4;
S.ServerPort := 12745;
S.MaxClients := -1;
Assert(S.State = ssInit);
for I := 1 to 10 do
begin
// activate
Assert(not S.Active);
S.Active := True;
Assert(S.Active);
// deactivate
S.Active := False;
Assert(not S.Active);
Assert(S.State = ssClosed);
end;
finally
S.Finalise;
FreeAndNil(S);
end;
end;
procedure Test_Server_Connections;
const
MaxConns = 10;
var
T : Word32;
S : TF5TCPServer;
C : array[1..MaxConns] of TSysSocket;
I : Integer;
begin
S := TF5TCPServer.Create(nil);
S.AddressFamily := iaIP4;
S.BindAddress := '127.0.0.1';
S.ServerPort := 12249;
S.MaxClients := -1;
S.Active := True;
for I := 1 to MaxConns do
begin
C[I] := TSysSocket.Create(iaIP4, ipTCP, False);
C[I].Bind('127.0.0.1', 0);
C[I].SetBlocking(False);
end;
T := TCPGetTick;
for I := 1 to MaxConns do
begin
C[I].Connect('127.0.0.1', '12249');
Sleep(5);
if I mod 100 = 0 then
Writeln(I, ' ', Word32(TCPGetTick - T) / I:0:2);
end;
I := 0;
repeat
Sleep(10);
Inc(I, 10);
until (S.ClientCount = MaxConns) or (I > 4000);
Assert(S.ClientCount = MaxConns);
T := Word32(TCPGetTick - T);
Writeln(T / MaxConns:0:2);
for I := 1 to MaxConns do
C[I].Close;
for I := 1 to MaxConns do
FreeAndNil(C[I]);
S.Active := False;
Sleep(100);
S.Finalise;
S.Free;
end;
procedure Test_Server_MultiServers_Connections;
const
MaxSrvrs = 20;
MaxConns = 10;
var
T : Word32;
S : array[1..MaxSrvrs] of TF5TCPServer;
C : array[1..MaxSrvrs] of array[1..MaxConns] of TSysSocket;
SySo : TSysSocket;
I, J : Integer;
begin
for I := 1 to MaxSrvrs do
begin
S[I] := TF5TCPServer.Create(nil);
S[I].AddressFamily := iaIP4;
S[I].BindAddress := '127.0.0.1';
S[I].ServerPort := 12300 + I;
S[I].MaxClients := -1;
S[I].Active := True;
end;
for J := 1 to MaxSrvrs do
for I := 1 to MaxConns do
begin
SySo := TSysSocket.Create(iaIP4, ipTCP, False);
C[J][I] := SySo;
SySo.Bind('127.0.0.1', 0);
SySo.SetBlocking(False);
end;
T := TCPGetTick;
for J := 1 to MaxSrvrs do
for I := 1 to MaxConns do
begin
C[J][I].Connect('127.0.0.1', RawByteString(IntToStr(12300 + J)));
if I mod 2 = 0 then
Sleep(1);
if I mod 100 = 0 then
Writeln(J, ' ', I, ' ', Word32(TCPGetTick - T) / (I + (J - 1) * MaxConns):0:2);
end;
I := 0;
Sleep(1000);
repeat
Sleep(1);
Inc(I);
until (S[MaxSrvrs].ClientCount = MaxConns) or (I > 10000);
Assert(S[MaxSrvrs].ClientCount = MaxConns);
T := Word32(TCPGetTick - T);
Writeln(T / (MaxConns * MaxSrvrs):0:2);
Sleep(1000);
for J := 1 to MaxSrvrs do
for I := 1 to MaxConns do
begin
C[J][I].Close;
C[J][I].Free;
end;
for I := 1 to MaxSrvrs do
S[I].Active := False;
for I := 1 to MaxSrvrs do
begin
S[I].Finalise;
S[I].Free;
end;
end;
procedure Test;
begin
Test_Server_Simple;
Test_Server_Connections;
Test_Server_MultiServers_Connections;
end;
{$ENDIF}
end.

View File

@@ -0,0 +1,63 @@
{ 2020/05/11 5.01 Move tests from unit flcTests into seperate units. }
{$INCLUDE flcTCPTest.inc}
unit flcTCPTest_ServerTLS;
interface
{$IFDEF TCPSERVER_TEST_TLS}
{ }
{ Test }
{ }
procedure Test;
{$ENDIF}
implementation
{$IFDEF TCPSERVER_TEST_TLS}
uses
SysUtils,
flcSocketLib,
flcTLSTestCertificates,
flcTCPServer;
{$ENDIF}
{ }
{ Test }
{ }
{$IFDEF TCPSERVER_TEST_TLS}
{$ASSERTIONS ON}
procedure Test_Server_TLS;
var
S : TF5TCPServer;
begin
S := TF5TCPServer.Create(nil);
try
// init
S.AddressFamily := iaIP4;
S.ServerPort := 12845;
S.TLSEnabled := True;
S.TLSServer.PrivateKeyRSAPEM := RSA_STunnel_PrivateKeyRSAPEM;
S.Active := True;
finally
S.Finalise;
FreeAndNil(S);
end;
end;
procedure Test;
begin
Test_Server_TLS;
end;
{$ENDIF}
end.

View File

@@ -0,0 +1,162 @@
{******************************************************************************}
{ }
{ Library: Fundamentals 5.00 }
{ File name: flcTCPTests.pas }
{ File version: 5.11 }
{ Description: TCP tests. }
{ }
{ Copyright: Copyright (c) 2007-2020, David J Butler }
{ All rights reserved. }
{ This file is licensed under the BSD License. }
{ See http://www.opensource.org/licenses/bsd-license.php }
{ Redistribution and use in source and binary forms, with }
{ or without modification, are permitted provided that }
{ the following conditions are met: }
{ Redistributions of source code must retain the above }
{ copyright notice, this list of conditions and the }
{ following disclaimer. }
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
{ POSSIBILITY OF SUCH DAMAGE. }
{ }
{ Github: https://github.com/fundamentalslib }
{ E-mail: fundamentals.library at gmail.com }
{ }
{ Revision history: }
{ }
{ 2010/12/15 0.01 Test for TLS client/server. }
{ 2011/01/02 0.02 Test for large buffers. }
{ 2011/04/22 0.03 Simple buffer tests. }
{ 2011/04/22 4.04 Test for multiple connections. }
{ 2011/10/13 4.05 SSL3 tests. }
{ 2012/04/19 4.06 Test for stopping and restarting client. }
{ 2015/04/26 4.07 Test for worker thread and blocking interface. }
{ 2016/01/08 5.08 Update for Fundamentals 5. }
{ 2018/09/08 5.09 Server tests with high connection count. }
{ 2019/04/16 5.10 Shutdown test. }
{ 2020/05/11 5.11 Move tests out into seperate units. }
{ }
{ Todo: }
{ - Test case socks proxy }
{ - Test case buffer full/empty events }
{ - Test case deferred shutdown }
{ - Test case throttling }
{ - Test case read/write rate reporting }
{ - Test case multiple proxies }
{ - Test case writing large chunks }
{ - Test case performance }
{ - Test case stress test (throughput and number of connections) }
{ - See SSL3 test case }
{******************************************************************************}
{$INCLUDE flcTCPTest.inc}
unit flcTCPTests;
interface
{ }
{ Test }
{ }
{$IFDEF TCP_TEST}
procedure Test;
{$ENDIF}
implementation
uses
flcTCPTest_Buffer
{$IFDEF TCPCLIENT_TEST},
flcTCPTest_Client
{$ENDIF}
{$IFDEF TCPCLIENT_TEST_TLS},
flcTCPTest_ClientTLS
{$ENDIF}
{$IFDEF TCPSERVER_TEST},
flcTCPTest_Server
{$ENDIF}
{$IFDEF TCPSERVER_TEST_TLS},
flcTCPTest_ServerTLS
{$ENDIF}
{$IFDEF TCPCLIENTSERVER_TEST},
flcTCPTest_ClientServer
{$ENDIF}
{$IFDEF TCPCLIENTSERVER_TEST_TLS},
flcTCPTest_ClientServerTLS
{$ENDIF}
;
{$IFDEF TCP_TEST}
{$ASSERTIONS ON}
procedure Test_Buffer;
begin
flcTCPTest_Buffer.Test;
end;
{$IFDEF TCPCLIENT_TEST}
procedure Test_Client;
begin
flcTCPTest_Client.Test;
{$IFDEF TCPCLIENT_TEST_TLS}
flcTCPTest_ClientTLS.Test;
{$ENDIF}
end;
{$ENDIF}
{$IFDEF TCPSERVER_TEST}
procedure Test_Server;
begin
flcTCPTest_Server.Test;
{$IFDEF TCPSERVER_TEST_TLS}
flcTCPTest_ServerTLS.Test;
{$ENDIF}
end;
{$ENDIF}
{$IFDEF TCPCLIENTSERVER_TEST}
procedure Test_ClientServer;
begin
flcTCPTest_ClientServer.Test;
{$IFDEF TCPCLIENTSERVER_TEST_TLS}
flcTCPTest_ClientServerTLS.Test;
{$ENDIF}
end;
{$ENDIF}
procedure Test;
begin
Test_Buffer;
{$IFDEF TCPSERVER_TEST}
Test_Server;
{$ENDIF}
{$IFDEF TCPCLIENT_TEST}
Test_Client;
{$ENDIF}
{$IFDEF TCPCLIENTSERVER_TEST}
Test_ClientServer;
{$ENDIF}
end;
{$ENDIF}
end.