diff --git a/packages/fcl-web/src/base/custfcgi.pp b/packages/fcl-web/src/base/custfcgi.pp index f3ccbe29fc..fb1fb419ec 100644 --- a/packages/fcl-web/src/base/custfcgi.pp +++ b/packages/fcl-web/src/base/custfcgi.pp @@ -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; diff --git a/packages/fcl-web/src/base/custweb.pp b/packages/fcl-web/src/base/custweb.pp index 6bd7b52055..b591e7997d 100644 --- a/packages/fcl-web/src/base/custweb.pp +++ b/packages/fcl-web/src/base/custweb.pp @@ -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);