paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-21 21:50:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Exit process when a shutdown event is received from mod_fastcgi

Browse Source 
git-svn-id: trunk@18184 -
This commit is contained in:
michael 2011-08-12 21:20:02 +00:00
parent 8b58d69576
commit 992d01719a
1 changed files with 79 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
packages/fcl-web/src/base/custfcgi.pp
View File

@ -105,9 +105,15 @@ Type
FAddress: string; FAddress: string;
FTimeOut, FTimeOut,
FPort: integer; FPort: integer;
{$ifdef windowspipe} {$ifdef windowspipe}
FIsWinPipe: Boolean; FIsWinPipe: Boolean;
{$endif} {$endif}
{$IFDEF WINDOWS}
FShutdownThread : TThread;
Procedure CheckShutDownEvent;
Procedure HandleShutDownEvent(Sender : TObject);
{$ENDIF}
function AcceptConnection: Integer; function AcceptConnection: Integer;
procedure CloseConnection; procedure CloseConnection;
function Read_FCGIRecord : PFCGI_Header; function Read_FCGIRecord : PFCGI_Header;
@ -169,18 +175,53 @@ Implementation
uses uses
dbugintf; dbugintf;
{$endif} {$endif}
{$undef nosignal} {$undef nosignal}
{$if defined(FreeBSD) or defined(Linux)} {$if defined(FreeBSD) or defined(Linux)}
{$define nosignal} {$define nosignal}
{$ifend} {$ifend}
{$IFDEF WINDOWS}
Type
{ TShutdownThread }
TShutdownEvent = Procedure (Sender : TObject) Of Object;
TShutdownThread = Class(TThread)
Private
FEvent : THandle;
FOnShutDown : TShutdownEvent;
Public
Constructor CreateWithEvent(AEvent : THandle; AOnShutDown : TShutdownEvent);
Procedure Execute; override;
end;
{$ENDIF}
Const Const
NoSignalAttr = {$ifdef nosignal} MSG_NOSIGNAL{$else}0{$endif}; NoSignalAttr = {$ifdef nosignal} MSG_NOSIGNAL{$else}0{$endif};
{$IFDEF WINDOWS}
{ TShutdownThread }
constructor TShutdownThread.CreateWithEvent(AEvent: THandle; AOnShutDown : TShutdownEvent);
begin
Inherited Create(False);
FEvent:=AEvent;
FOnShutDown:=AOnShutDown;
OnTerminate:=AOnShutDown;
end;
procedure TShutdownThread.Execute;
begin
WaitForSingleObject(FEvent,INFINITE);
If Assigned(FOnShutDown) then
FOnShutDown(Self);
// This is very ugly, but there is no other way to stop the named pipe
// from accepting new connections.
// Using Halt(0) is not enough.
ExitProcess(0);
end;
{$ENDIF WINDOWS}
{ TFCGIHTTPRequest } { TFCGIHTTPRequest }
procedure TFCGIRequest.ReadContent; procedure TFCGIRequest.ReadContent;
@ -473,16 +514,27 @@ end;
{ TFCgiHandler } { TFCgiHandler }
constructor TFCgiHandler.Create(AOwner: TComponent); constructor TFCgiHandler.Create(AOwner: TComponent);
begin begin
Inherited Create(AOwner); Inherited Create(AOwner);
FRequestsAvail:=5; FRequestsAvail:=5;
SetLength(FRequestsArray,FRequestsAvail); SetLength(FRequestsArray,FRequestsAvail);
FHandle := THandle(-1); FHandle := THandle(-1);
FTimeOut:=50; FTimeOut:=50;
{$IFDEF WINDOWS}
CheckShutdownEvent;
{$ENDIF}
end; end;
destructor TFCgiHandler.Destroy; destructor TFCgiHandler.Destroy;
begin begin
{$IFDEF WINDOWS}
IF (FShutDownThread<>Nil) then
begin
TShutDownThread(FShutDownThread).FOnShutDown:=Nil;
TShutDownThread(FShutDownThread).OnTerminate:=Nil;
end;
{$ENDIF}
SetLength(FRequestsArray,0); SetLength(FRequestsArray,0);
if (Socket<>0) then if (Socket<>0) then
begin begin
@ -492,6 +544,30 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{$IFDEF WINDOWS}
Procedure TFCgiHandler.CheckShutdownEvent;
Var
H : THandle;
begin
// This is normally only used in mod_fastcgi.
// mod_fcgid just kills off the process...
H:=THandle(StrToIntDef(sysutils.GetEnvironmentVariable('_FCGI_SHUTDOWN_EVENT_'),0));
If (H<>0) then
FShutDownThread:=TShutdownThread.CreateWithEvent(H,@HandleShutDownEvent);
end;
procedure TFCgiHandler.HandleShutDownEvent(Sender : TOBject);
begin
TShutDownThread(Sender).FOnShutDown:=Nil;
TShutDownThread(Sender).OnTerminate:=Nil;
FShutDownThread:=Nil;
Terminate;
end;
{$ENDIF}
procedure TFCgiHandler.CloseConnection; procedure TFCgiHandler.CloseConnection;
Var Var
i : Integer; i : Integer;