paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-02 14:29:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Better error handling in FastCGI in case writing response fails (bug ID 23564)

Browse Source 
git-svn-id: trunk@23327 -
This commit is contained in:
michael 2013-01-06 16:29:23 +00:00
parent 9777699c70
commit a701176c70
2 changed files with 36 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -50,7 +50,7 @@ Type
TUnknownRecordEvent = Procedure (ARequest : TFCGIRequest; AFCGIRecord: PFCGI_Header) Of Object;
TFastCGIReadEvent = Function (AHandle : THandle; Var ABuf; ACount : Integer) : Integer of Object;
TFastCGIWriteEvent = Function (AHandle : THandle; Const ABuf; ACount : Integer) : Integer of Object;
TFastCGIWriteEvent = Function (AHandle : THandle; Const ABuf; ACount : Integer; Out ExtendedErrorCode : Integer) : Integer of Object;
TFCGIRequest = Class(TCGIRequest)
Private
@ -110,7 +110,6 @@ Type
FAddress: string;
FTimeOut,
FPort: integer;
{$ifdef windowspipe}
FIsWinPipe: Boolean;
{$endif}
@ -127,7 +126,7 @@ Type
function CreateRequest : TFCGIRequest; virtual;
function CreateResponse(ARequest: TFCGIRequest) : TFCGIResponse; virtual;
Function DoFastCGIRead(AHandle : THandle; Var ABuf; ACount : Integer) : Integer; virtual;
Function DoFastCGIWrite(AHandle : THandle; Const ABuf; ACount : Integer) : Integer; virtual;
Function DoFastCGIWrite(AHandle : THandle; Const ABuf; ACount : Integer; Out ExtendedErrorCode : Integer) : Integer; virtual;
function ProcessRecord(AFCGI_Record: PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean; virtual;
procedure SetupSocket(var IAddress: TInetSockAddr; var AddressLength: tsocklen); virtual;
function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
@ -410,18 +409,21 @@ end;
{ TCGIResponse }
procedure TFCGIResponse.Write_FCGIRecord(ARecord : PFCGI_Header);
var BytesToWrite : Integer;
var ErrorCode,
BytesToWrite ,
BytesWritten : Integer;
P : PByte;
begin
BytesToWrite := BEtoN(ARecord^.contentLength) + ARecord^.paddingLength+sizeof(FCGI_Header);
P:=PByte(Arecord);
Repeat
BytesWritten:=FOnWrite(TFCGIRequest(Request).Handle, P^, BytesToWrite);
BytesWritten:=FOnWrite(TFCGIRequest(Request).Handle, P^, BytesToWrite,ErrorCode);
If (BytesWritten<0) then
begin
// TODO : Better checking for closed connection, EINTR
Raise HTTPError.CreateFmt(SErrWritingSocket,[BytesWritten]);
IF Assigned(Self.Request) and (Self.Request is TFCGIRequest) then
(Self.Request as TFCGIRequest).FKeepConnectionAfterRequest:=False;
Raise HTTPError.CreateFmt(SErrWritingSocket,[ErrorCode]);
end;
Inc(P,BytesWritten);
Dec(BytesToWrite,BytesWritten);
@ -835,14 +837,26 @@ begin
end;
function TFCgiHandler.DoFastCGIWrite(AHandle: THandle; const ABuf;
ACount: Integer): Integer;
ACount: Integer; Out ExtendedErrorCode : Integer): Integer;
begin
{$ifdef windowspipe}
if FIsWinPipe then
Result := FileWrite(AHandle, ABuf, ACount)
begin
ExtendedErrorCode:=0;
Result := FileWrite(AHandle, ABuf, ACount);
if (Result<0) then
ExtendedErrorCode:=GetLastOSError;
end
else
{$endif windows}
Result := sockets.fpsend(AHandle, @ABuf, ACount, NoSignalAttr);
begin
Repeat
ExtendedErrorCode:=0;
Result:=sockets.fpsend(AHandle, @ABuf, ACount, NoSignalAttr);
if (Result<0) then
ExtendedErrorCode:=sockets.socketerror;
until (Result>=0) {$ifdef unix} or (ExtendedErrorCode<>ESysEINTR);{$endif}
end;
end;
function TFCgiHandler.ProcessRecord(AFCGI_Record : PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean;

17
packages/fcl-web/src/base/custweb.pp
View File

@ -216,6 +216,7 @@ uses
resourcestring
SErrNoModuleNameForRequest = 'Could not determine HTTP module name for request';
SErrNoModuleForRequest = 'Could not determine HTTP module for request "%s"';
SErrSendingContent = 'An error (%s) happened while sending response content: %s';
SModuleError = 'Module Error';
SAppEncounteredError = 'The application encountered the following error:';
SError = 'Error: ';
@ -467,10 +468,18 @@ end;
procedure TWebHandler.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
begin
HandleRequest(ARequest,AResponse);
If Not AResponse.ContentSent then
AResponse.SendContent;
EndRequest(ARequest,AResponse);
Try
HandleRequest(ARequest,AResponse);
If Not AResponse.ContentSent then
try
AResponse.SendContent;
except
On E : Exception do
Log(etError,Format(SErrSendingContent,[E.ClassName,E.Message]));
end;
Finally
EndRequest(ARequest,AResponse);
end;
end;
constructor TWebHandler.Create(AOwner:TComponent);