TFPHTTPServer in ThreadMode=tmThreadPool hangs when KeepConnections=True
Summary
If the TFPHTTPServer is set with ThreadMode=tmThreadPool and KeepConnections=True then it hangs with 100% load and no OnIdle callbacks if there are open connections.
System Information
- Operating system: Windows
- Processor architecture: x86
- Compiler version: trunk
- Device: Computer
Steps to reproduce
Run the example project (it is basically the server+client demo projects from FPC sources in one unit).
Example Project
program TestHttpServerThreadPool;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes, SysUtils, fphttpserver, fphttpclient
{ you can add units after this };
type
THTTPServerThread = class(TThread)
private
fServ: TFPHttpServer;
procedure ServOnIdle(Sender: TObject);
procedure ServRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
var AResponse: TFPHTTPConnectionResponse);
public
procedure Execute; override;
end;
{ THTTPServerThread }
procedure THTTPServerThread.Execute;
begin
fServ := TFPHttpServer.Create(Nil);
fServ.KeepConnections := True;
fServ.KeepConnectionTimeout := 60*1000;
fServ.ThreadMode := tmThreadPool; // set to tmThread to fix the issue
fServ.Port := 1234;
fServ.AcceptIdleTimeout := 1000;
fServ.OnAcceptIdle := @ServOnIdle;
fServ.OnRequest := @ServRequest;
fServ.Active := True;
fServ.Free;
fServ := nil;
end;
procedure THTTPServerThread.ServOnIdle(Sender: TObject);
begin
Write('i');
if Terminated then
fServ.Active := False;
end;
procedure THTTPServerThread.ServRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
var AResponse: TFPHTTPConnectionResponse);
begin
AResponse.Code := 200;
AResponse.Content := '';
AResponse.ContentLength := Length(AResponse.Content);
end;
var
Server: THTTPServerThread;
Client: TFPHTTPClient;
begin
Server := THTTPServerThread.Create(False);
while not (Assigned(Server.fServ) and Server.fServ.Active) do
Sleep(10);
Client := TFPHTTPClient.Create(nil);
Client.KeepConnection := True;
Client.Get('http://localhost:1234');
Writeln('press enter to exit');
ReadLn;
Server.Free;
Client.Free;
end.
What is the current bug behavior?
The server hangs with 100% processor load and no OnIdle callbacks.
What is the expected (correct) behavior?
0% processor load and OnIdle callbacks like it is for the tmThread ThreadMode.
Edited by Sven/Sarah Barth