454 lines
13 KiB
ObjectPascal
454 lines
13 KiB
ObjectPascal
{******************************************************************************}
|
|
{ }
|
|
{ 2011/06/11 0.01 Initial version. }
|
|
{ 2011/06/23 0.02 Simple test case. }
|
|
{ 2016/01/09 5.03 Revised for Fundamentals 5. }
|
|
{ }
|
|
{ Supported compilers: }
|
|
{ }
|
|
{ Delphi 7 Win32 5.03 2019/02/24 }
|
|
{ Delphi XE7 Win32 5.03 2016/01/09 }
|
|
{ Delphi XE7 Win64 5.03 2016/01/09 }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{$INCLUDE flcHTTP.inc}
|
|
|
|
{$IFDEF HTTP_TEST}
|
|
{$DEFINE HTTP_TEST_LOG_TO_CONSOLE}
|
|
{$DEFINE HTTPSERVER_TEST}
|
|
{$DEFINE HTTPCLIENT_TEST}
|
|
{.DEFINE HTTPCLIENT_TEST_WEB1}
|
|
{.DEFINE HTTPCLIENT_TEST_WEB2}
|
|
{$DEFINE HTTPCLIENTSERVER_TEST}
|
|
{$IFDEF HTTP_TLS}
|
|
{$DEFINE HTTPCLIENTSERVER_TEST_HTTPS}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
unit flcHTTPTests;
|
|
|
|
interface
|
|
|
|
uses
|
|
flcHTTPUtils,
|
|
flcHTTPClient,
|
|
flcHTTPServer;
|
|
|
|
|
|
|
|
{ }
|
|
{ Test cases }
|
|
{ }
|
|
{$IFDEF HTTP_TEST}
|
|
procedure Test;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
SyncObjs,
|
|
flcUtils,
|
|
flcBase64,
|
|
flcSocketLib
|
|
{$IFDEF HTTP_TLS},
|
|
flcTLSCertificate,
|
|
flcTLSHandshake
|
|
{$ENDIF};
|
|
|
|
|
|
|
|
{$IFDEF HTTP_TEST}
|
|
{$ASSERTIONS ON}
|
|
|
|
{ }
|
|
{ Test cases - Server }
|
|
{ }
|
|
{$IFDEF HTTPSERVER_TEST}
|
|
type
|
|
THTTPServerTestObj = class
|
|
Lock : TCriticalSection;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure HTTPServerLog(const Server: TF5HTTPServer; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer);
|
|
end;
|
|
|
|
constructor THTTPServerTestObj.Create;
|
|
begin
|
|
inherited Create;
|
|
Lock := TCriticalSection.Create;
|
|
end;
|
|
|
|
destructor THTTPServerTestObj.Destroy;
|
|
begin
|
|
FreeAndNil(Lock);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure THTTPServerTestObj.HTTPServerLog(const Server: TF5HTTPServer; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer);
|
|
begin
|
|
{$IFDEF HTTP_TEST_LOG_TO_CONSOLE}
|
|
Lock.Acquire;
|
|
try
|
|
Writeln(Msg);
|
|
finally
|
|
Lock.Release;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure Test_Server;
|
|
var
|
|
Srv : TF5HTTPServer;
|
|
Tst : THTTPServerTestObj;
|
|
begin
|
|
Tst := THTTPServerTestObj.Create;
|
|
Srv := TF5HTTPServer.Create(nil);
|
|
try
|
|
Srv.OnLog := Tst.HTTPServerLog;
|
|
Srv.AddressFamily := safIP4;
|
|
Srv.ServerPort := 8088;
|
|
Assert(not Srv.Active);
|
|
Srv.Active := True;
|
|
Assert(Srv.Active);
|
|
Sleep(100);
|
|
Assert(Srv.Active);
|
|
Srv.Active := False;
|
|
Assert(not Srv.Active);
|
|
finally
|
|
Srv.Free;
|
|
Tst.Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
|
|
{ }
|
|
{ Test cases - Client }
|
|
{ }
|
|
{$IFDEF HTTPCLIENT_TEST}
|
|
type
|
|
THTTPClientTestObj = class
|
|
Lock : TCriticalSection;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure HTTPClientLog(Client: TF5HTTPClient; LogType: THTTPClientLogType; Msg: String; Level: Integer);
|
|
end;
|
|
|
|
constructor THTTPClientTestObj.Create;
|
|
begin
|
|
inherited Create;
|
|
Lock := TCriticalSection.Create;
|
|
end;
|
|
|
|
destructor THTTPClientTestObj.Destroy;
|
|
begin
|
|
FreeAndNil(Lock);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure THTTPClientTestObj.HTTPClientLog(Client: TF5HTTPClient; LogType: THTTPClientLogType; Msg: String; Level: Integer);
|
|
begin
|
|
{$IFDEF HTTP_TEST_LOG_TO_CONSOLE}
|
|
Lock.Acquire;
|
|
try
|
|
Writeln(Msg);
|
|
finally
|
|
Lock.Release;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure Test_Client;
|
|
var H : TF5HTTPClient;
|
|
T : THTTPClientTestObj;
|
|
|
|
{$IFDEF HTTPCLIENT_TEST_WEB1}
|
|
// Test simple connect and request sequence
|
|
procedure TestWeb1;
|
|
begin
|
|
H.Host := 'www.google.com';
|
|
H.Port := '80';
|
|
H.Method := cmGET;
|
|
H.URI := '/';
|
|
Assert(not H.Active);
|
|
H.Active := True;
|
|
Assert(H.Active);
|
|
repeat
|
|
Sleep(10);
|
|
until H.State in [hcsStopping, hcsConnectFailed, hcsConnected_Ready];
|
|
Assert(H.State = hcsConnected_Ready);
|
|
Sleep(100);
|
|
H.Request;
|
|
repeat
|
|
Sleep(10);
|
|
until H.State in [hcsStopping, hcsConnectFailed, hcsResponseComplete, hcsResponseCompleteAndClosing, hcsConnected_Ready];
|
|
Assert(H.State = hcsResponseComplete);
|
|
H.Active := False;
|
|
Assert(not H.Active);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF HTTPCLIENT_TEST_WEB2}
|
|
// Test multiple requests
|
|
procedure TestWeb2;
|
|
begin
|
|
H.Host := 'www.google.com';
|
|
// H.Host := 'www.cnn.com';
|
|
H.Port := '80';
|
|
H.Method := cmGET;
|
|
H.URI := '/';
|
|
Assert(not H.Active);
|
|
H.Request;
|
|
repeat
|
|
Sleep(10);
|
|
until H.State in [hcsStopping, hcsConnectFailed, hcsResponseComplete, hcsResponseCompleteAndClosing];
|
|
Assert(H.State = hcsResponseComplete);
|
|
Sleep(500);
|
|
H.Request;
|
|
repeat
|
|
Sleep(10);
|
|
until H.State in [hcsStopping, hcsConnectFailed, hcsResponseComplete, hcsResponseCompleteAndClosing];
|
|
Assert(H.State = hcsResponseComplete);
|
|
H.Active := False;
|
|
Assert(not H.Active);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
T := THTTPClientTestObj.Create;
|
|
H := TF5HTTPClient.Create(nil);
|
|
try
|
|
H.OnLog := T.HTTPClientLog;
|
|
H.UserAgent := 'Experimental';
|
|
{$IFDEF HTTPCLIENT_TEST_WEB1}
|
|
TestWeb1;
|
|
{$ENDIF}
|
|
{$IFDEF HTTPCLIENT_TEST_WEB2}
|
|
TestWeb2;
|
|
{$ENDIF}
|
|
finally
|
|
H.Free;
|
|
T.Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Test cases - Client/Server }
|
|
{ }
|
|
{$IFDEF HTTPCLIENTSERVER_TEST}
|
|
type
|
|
THTTPClientServerTestObj = class
|
|
Lock : TCriticalSection;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Log(Msg: String);
|
|
procedure HTTPClientLog(Client: TF5HTTPClient; LogType: THTTPClientLogType; Msg: String; Level: Integer);
|
|
procedure HTTPClientResponseHeader(Client: TF5HTTPClient);
|
|
procedure HTTPClientResponseComplete(Client: TF5HTTPClient);
|
|
procedure HTTPServerLog(const Server: TF5HTTPServer; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer);
|
|
procedure HTTPServerPrepareResponse(const Server: TF5HTTPServer; const Client: THTTPServerClient);
|
|
procedure HTTPServerRequestComplete(const Server: TF5HTTPServer; const Client: THTTPServerClient);
|
|
end;
|
|
|
|
constructor THTTPClientServerTestObj.Create;
|
|
begin
|
|
inherited Create;
|
|
Lock := TCriticalSection.Create;
|
|
end;
|
|
|
|
destructor THTTPClientServerTestObj.Destroy;
|
|
begin
|
|
FreeAndNil(Lock);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure THTTPClientServerTestObj.Log(Msg: String);
|
|
begin
|
|
{$IFDEF HTTP_TEST_LOG_TO_CONSOLE}
|
|
Lock.Acquire;
|
|
try
|
|
Writeln(Msg);
|
|
finally
|
|
Lock.Release;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure THTTPClientServerTestObj.HTTPClientLog(Client: TF5HTTPClient; LogType: THTTPClientLogType; Msg: String; Level: Integer);
|
|
begin
|
|
Log('C:' + IntToStr(Level) + ':' + Msg);
|
|
end;
|
|
|
|
procedure THTTPClientServerTestObj.HTTPClientResponseHeader(Client: TF5HTTPClient);
|
|
begin
|
|
Assert(Client.ResponseCode = 200);
|
|
Assert(Client.ResponseRecord.Header.CommonHeaders.ContentType.Value = hctTextHtml);
|
|
end;
|
|
|
|
procedure THTTPClientServerTestObj.HTTPClientResponseComplete(Client: TF5HTTPClient);
|
|
begin
|
|
Assert(Client.ResponseContentStr = '<HTML>Test</HTML>');
|
|
end;
|
|
|
|
procedure THTTPClientServerTestObj.HTTPServerLog(const Server: TF5HTTPServer; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer);
|
|
begin
|
|
Log('S:' + IntToStr(LogLevel) + ':' + Msg);
|
|
end;
|
|
|
|
procedure THTTPClientServerTestObj.HTTPServerPrepareResponse(const Server: TF5HTTPServer; const Client: THTTPServerClient);
|
|
begin
|
|
Client.ResponseCode := 200;
|
|
Client.ResponseMsg := 'OK';
|
|
Client.ResponseContentType := 'text/html';
|
|
Client.ResponseContentMechanism := hctmString;
|
|
Client.ResponseContentStr := '<HTML>Test</HTML>';
|
|
Client.ResponseReady := True;
|
|
end;
|
|
|
|
procedure THTTPClientServerTestObj.HTTPServerRequestComplete(const Server: TF5HTTPServer; const Client: THTTPServerClient);
|
|
begin
|
|
end;
|
|
|
|
procedure Test_ClientServer_Simple(const HTTPS: Boolean);
|
|
var
|
|
Srv : TF5HTTPServer;
|
|
Cln : TF5HTTPClient;
|
|
Tst : THTTPClientServerTestObj;
|
|
T : Integer;
|
|
{$IFDEF HTTPCLIENTSERVER_TEST_HTTPS}
|
|
CtL : TTLSCertificateList;
|
|
{$ENDIF}
|
|
begin
|
|
Tst := THTTPClientServerTestObj.Create;
|
|
Srv := TF5HTTPServer.Create(nil);
|
|
Cln := TF5HTTPClient.Create(nil);
|
|
try
|
|
Srv.OnLog := Tst.HTTPServerLog;
|
|
Cln.OnLog := Tst.HTTPClientLog;
|
|
//
|
|
Srv.OnPrepareResponse := Tst.HTTPServerPrepareResponse;
|
|
Srv.OnRequestComplete := Tst.HTTPServerRequestComplete;
|
|
Srv.AddressFamily := safIP4;
|
|
Srv.ServerPort := 8795;
|
|
{$IFDEF HTTPCLIENTSERVER_TEST_HTTPS}
|
|
if HTTPS then
|
|
begin
|
|
Srv.TCPServer.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'));
|
|
Srv.TCPServer.TLSServer.CertificateList := CtL;
|
|
end;
|
|
Srv.HTTPSEnabled := HTTPS;
|
|
{$ENDIF}
|
|
Srv.Active := True;
|
|
Assert(Srv.Active);
|
|
//
|
|
Cln.OnResponseHeader := Tst.HTTPClientResponseHeader;
|
|
Cln.OnResponseComplete := Tst.HTTPClientResponseComplete;
|
|
Cln.ResponseContentMechanism := hcrmString;
|
|
Cln.AddressFamily := cafIP4;
|
|
Cln.Port := '8795';
|
|
Cln.Host := '127.0.0.1';
|
|
Cln.URI := '/';
|
|
Cln.Method := cmGET;
|
|
{$IFDEF HTTPCLIENTSERVER_TEST_HTTPS}
|
|
Cln.UseHTTPS := HTTPS;
|
|
{$ENDIF}
|
|
Cln.Active := True;
|
|
Cln.Request;
|
|
|
|
T := 0;
|
|
repeat
|
|
Sleep(1);
|
|
Inc(T);
|
|
until (T > 2000) or (Srv.ClientCount = 1);
|
|
Assert(Srv.ClientCount = 1);
|
|
|
|
T := 0;
|
|
repeat
|
|
Sleep(1);
|
|
Inc(T);
|
|
until (T > 2000) or (Cln.State in [hcsResponseComplete, hcsResponseCompleteAndClosed]);
|
|
Assert(Cln.State in [hcsResponseComplete, hcsResponseCompleteAndClosed]);
|
|
|
|
Cln.Active := False;
|
|
Assert(not Cln.Active);
|
|
|
|
T := 0;
|
|
repeat
|
|
Sleep(1);
|
|
Inc(T);
|
|
until (T > 2000) or (Srv.ClientCount = 0);
|
|
Assert(Srv.ClientCount = 0);
|
|
|
|
Srv.Active := False;
|
|
Assert(not Srv.Active);
|
|
finally
|
|
Cln.Free;
|
|
Srv.Free;
|
|
Tst.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure Test_ClientServer;
|
|
begin
|
|
Test_ClientServer_Simple(False);
|
|
{$IFDEF HTTPCLIENTSERVER_TEST_HTTPS}
|
|
Test_ClientServer_Simple(True);
|
|
{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure Test;
|
|
begin
|
|
{$IFDEF HTTPSERVER_TEST}
|
|
Test_Server;
|
|
{$ENDIF}
|
|
{$IFDEF HTTPCLIENT_TEST}
|
|
Test_Client;
|
|
{$ENDIF}
|
|
{$IFDEF HTTPCLIENTSERVER_TEST}
|
|
Test_ClientServer;
|
|
{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
end.
|
|
|