fcl-web: TFPHTTPServer could not be correctly stopped when running in Threaded mode
Original Reporter info from Mantis: uaply
-
Reporter name:
Original Reporter info from Mantis: uaply
- Reporter name:
Description:
When web server based on TFPHTTPServer/THTTPApplication is running in Threaded mode, problem arise with stopping it correctly.
Main process of such application is running in blocking mode - process waits on socket accept() for new connections. And it can be stopped only from another thread. Even in the case we trying to stop it from HTTP request handler, anyway it would be another thread, because main loop create a new thread for each request - we working in threaded mode. This is important because current implementation for stopping TFPHTTPServer is not thread-safe.
The problem arises when we set property Active:=False in this procedure:
procedure TFPCustomHttpServer.SetActive(const AValue: Boolean); begin If AValue=GetActive then exit; FLoadActivate:=AValue; if not (csDesigning in Componentstate) then if AValue then begin CreateServerSocket; SetupSocket; StartServerSocket; &LtPos;-- this is still running in main thread end else FreeServerSocket; &LtPos;-- and this is called from a new thread end;
And the bug is FreeServerSocket
is called from another thread while main thread still running StartServerSocket
procedure. It would be not so bad, if FreeServerSocket
will not free memory on stopping:
procedure TFPCustomHttpServer.FreeServerSocket; begin FServer.StopAccepting; FreeAndNil(FServer); &LtPos;-- frees memory while other thread is still running!!! end;
My fix to this problem is not to free objects while setting Active:=false, but let main thread to do it. A patch is attached.
------------
And here comes another problem. In such scenario main thread remains blocked by waiting for socket accept(). If we don't abort forcefully this waiting state, actual stop will occur only when next client will connect. This could be fast if server is highly visited, but could also never happen if no one is trying to connect.
There is no platform-independent solution for aborting blocked sockets for my knowledge.
Under Windows simple CloseSocket() is enough to make accept() instantly return with 10004 error code.
Under Unix accept() could be aborted by sending signal to application (which is cumbersome).
Or it can be done by calling shutdown() on socket (much more good-looking solution). I used second option, and in this case accept() is instantly aborted with EINVAL (22) code.
To make such abort possible some modification of TSocketServer.StartAccepting
procedure from 'ssockets.pp' is needed, please take a look at second patch file.
Steps to reproduce:
I've used such code to test this case:
program simplehttpserver; {$mode objfpc}{$H+} {$define UseCThreads} uses {$IFDEF UNIX} {$IFDEF UseCThreads} cthreads, {$ENDIF} {$ENDIF} SysUtils, Classes, fphttpserver, ssockets, fpmimetypes; type { TTestHTTPServer } TTestHTTPServer = class(TFPHTTPServer) public procedure HandleRequest(var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse); override; end; var Serv: TTestHTTPServer; { TTestHTTPServer } procedure TTestHTTPServer.HandleRequest(var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse); var F: TFileStream; FN: string; i: integer; begin writeln('setting active to false'); Self.Active:=False; end; {$R *.res} begin Serv := TTestHTTPServer.Create(nil); try Serv.Threaded := True; Serv.Port := 8080; writeln('starting server'); Serv.Active := True; writeln('server stopped'); finally Serv.Free; end; end.