Skip to content

Instantly share code, notes, and snippets.

@pavelmash

pavelmash/httpThreadAV.lpr

Created April 24, 2020 07:12
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save pavelmash/436eab987ece3d06b98ab6f0e62d5fdb to your computer and use it in GitHub Desktop.
Save pavelmash/436eab987ece3d06b98ab6f0e62d5fdb to your computer and use it in GitHub Desktop.
Download ZIP
HTTP AI thread AV
Raw
httpThreadAV.lpr
program httpThreadAV;
{$I Synopse.inc}
uses
Windows,
Classes,
SynCommons,
SynCrtSock,
SynLog;
const
ROOT = '/';
PORT = '8881';
DOMAIN_NAME = '+';
CLONES = 4;
// duration of real work inside HTTPThreadTerminate event
REAL_WORK_DURATION = 100;
type
TAvTest = class
private
fHttpServer: THttpApiServer;
protected
procedure HttpThreadStart(Sender: TThread);
procedure HttpThreadTerminate(Sender: TThread);
function DoOnRequest(Ctxt: THttpServerRequest): cardinal;
public
constructor Create();
destructor Destroy; override;
end;
var
tst: TAvTest;
terminatedCount: integer;
procedure TAvTest.HttpThreadStart(Sender: TThread);
begin
TSynLog.Add.Log(sllDebug, 'HttpThreadStart %', [Sender.threadID]);
end;
procedure TAvTest.HttpThreadTerminate(Sender: TThread);
begin
TSynLog.Add.Log(sllDebug, 'HttpThreadTerminate % - begin', [Sender.threadID]);
sleep(REAL_WORK_DURATION); // real work
interlockedIncrement(terminatedCount);
TSynLog.Add.Log(sllDebug, 'HttpThreadTerminate % - end', [Sender.threadID]);
end;
function TAvTest.DoOnRequest(Ctxt: THttpServerRequest): cardinal;
begin
Ctxt.OutContent := '<html><body><h1>It''s works!</h1></body></html>';
Ctxt.OutContentType := 'text/html';
Result := 200;
end;
constructor TAvTest.Create();
begin
fHttpServer := THttpApiServer.Create(True, '', HttpThreadStart, HttpThreadTerminate);
if fHTTPServer.AddUrl(ROOT, PORT, false, DOMAIN_NAME) <> NO_ERROR then
raise ESynException.CreateLastOSError('impossible to listen on %s (%s)', [PORT, DOMAIN_NAME]);
fHttpServer.Suspended := False;
fHttpServer.OnRequest := DoOnRequest;
fHttpServer.OnHttpThreadStart := HttpThreadStart;
fHttpServer.OnHttpThreadTerminate := HttpThreadTerminate;
fHttpServer.Clone(CLONES-1);
end;
destructor TAvTest.Destroy;
begin
fHttpServer.Free;
inherited Destroy;
end;
begin
TSynLog.Family.Level := SynLog.LOG_VERBOSE;
TSynLog.Add.Log(sllDebug, 'Start app', []);
tst := TAvTest.Create();
HttpGet('http://localhost:' + PORT + ROOT, nil, true);
TSynLog.Add.Log(sllDebug, 'Start free server', []);
terminatedCount := 0;
tst.Free;
TSynLog.Add.Log(sllDebug, 'End free server', []);
if terminatedCount <> CLONES then begin
writeln('ERROR! Server destroyed before all threads done. Teminated/expected ', terminatedCount, '/', CLONES);
writeln(' - in log files you can not see HttpThreadTerminate % - end lines for some of threads');
writeln(' - in case REAL_WORK_DURATION constart is 0 everything is OK');
writeln(' The reason is THttpApiServer.DestroyMainThread calls fClones[].free before all clones finish');
ExitCode := 1;
end;
tst := nil;
TSynLog.Add.Log(sllDebug, 'End app', []);
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment