From c20415360406e50a9a8853f10eac22373fcde8fc Mon Sep 17 00:00:00 2001 From: michael Date: Fri, 11 Jul 2014 08:19:23 +0000 Subject: [PATCH] * Improved exception handling. Introduced StatusCode/Text in EHTTPError, is used to set HTTP status code/text when sending the response. git-svn-id: trunk@28196 - --- packages/fcl-web/src/base/cgiapp.pp | 12 ++-- packages/fcl-web/src/base/custcgi.pp | 2 + packages/fcl-web/src/base/custfcgi.pp | 18 +++--- packages/fcl-web/src/base/custweb.pp | 75 +++++++++++++++++------ packages/fcl-web/src/base/fpapache.pp | 2 +- packages/fcl-web/src/base/fpapache24.pp | 2 +- packages/fcl-web/src/base/fphtml.pp | 12 ++-- packages/fcl-web/src/base/fphttp.pp | 6 +- packages/fcl-web/src/base/fphttpclient.pp | 3 +- packages/fcl-web/src/base/fphttpserver.pp | 4 +- packages/fcl-web/src/base/fpweb.pp | 2 +- packages/fcl-web/src/base/httpdefs.pp | 28 ++++++++- packages/fcl-web/src/base/webpage.pp | 2 +- 13 files changed, 119 insertions(+), 49 deletions(-) diff --git a/packages/fcl-web/src/base/cgiapp.pp b/packages/fcl-web/src/base/cgiapp.pp index c2a6e182aa..753d34dbcd 100644 --- a/packages/fcl-web/src/base/cgiapp.pp +++ b/packages/fcl-web/src/base/cgiapp.pp @@ -21,7 +21,7 @@ unit cgiapp; Interface uses - CustApp,Classes,SysUtils; + CustApp,Classes, SysUtils, httpdefs; Const CGIVarCount = 23 deprecated; @@ -128,6 +128,8 @@ Type Property Response : TStream Read FResponse; deprecated; end; + ECGI = Class(Exception); + ResourceString SWebMaster = 'webmaster' deprecated; SCGIError = 'CGI Error' deprecated; @@ -428,13 +430,13 @@ var begin R:=RequestMethod; if (R='') then - Raise Exception.Create(SErrNoRequestMethod); + Raise ECGI.Create(SErrNoRequestMethod); if CompareText(R,'POST')=0 then InitPostVars else if CompareText(R,'GET')=0 then InitGetVars else - Raise Exception.CreateFmt(SErrInvalidRequestMethod,[R]); + Raise ECGI.CreateFmt(SErrInvalidRequestMethod,[R]); end; Procedure TCgiApplication.ProcessURLEncoded(M : TMemoryStream); @@ -622,7 +624,7 @@ begin FI:=TFormItem(L[i]); FI.Process; If (FI.Name='') then - Raise Exception.CreateFmt('Invalid multipart encoding: %s',[FI.Data]); + Raise ECGI.CreateFmt('Invalid multipart encoding: %s',[FI.Data]); Key:=FI.Name; If Not FI.IsFile Then begin @@ -691,7 +693,7 @@ begin else if CompareText(ContentType,'APPLICATION/X-WWW-FORM-URLENCODED')=0 then ProcessUrlEncoded(M) else - Raise Exception.CreateFmt(SErrUnsupportedContentType,[ContentType]); + Raise ECGI.CreateFmt(SErrUnsupportedContentType,[ContentType]); finally M.Free; end; diff --git a/packages/fcl-web/src/base/custcgi.pp b/packages/fcl-web/src/base/custcgi.pp index 85d3fa29e8..f699c21bca 100644 --- a/packages/fcl-web/src/base/custcgi.pp +++ b/packages/fcl-web/src/base/custcgi.pp @@ -118,6 +118,8 @@ Type Property RequestVariableCount : Integer Read GetRequestVariableCount; end; + ECGI = Class(EFPWebError); + Var CGIRequestClass : TCGIRequestClass = TCGIRequest; CGIResponseClass : TCGIResponseClass = TCGIResponse; diff --git a/packages/fcl-web/src/base/custfcgi.pp b/packages/fcl-web/src/base/custfcgi.pp index ecf607b2e0..311cec3f72 100644 --- a/packages/fcl-web/src/base/custfcgi.pp +++ b/packages/fcl-web/src/base/custfcgi.pp @@ -293,7 +293,7 @@ begin FUR(Self,AFCGIRecord) else if poFailonUnknownRecord in FPO then - Raise EFPWebError.CreateFmt('Unknown FASTCGI record type: %s',[AFCGIRecord^.reqtype]); + TFCgiHandler.DoError('Unknown FASTCGI record type: %s',[AFCGIRecord^.reqtype]); end; end; @@ -429,7 +429,7 @@ var ErrorCode, begin if Not (Request is TFCGIRequest) then - Raise Exception.Create(SErrNorequest); + TFCgiHandler.DoError(SErrNorequest); R:=TFCGIRequest(Request); BytesToWrite := BEtoN(ARecord^.contentLength) + ARecord^.paddingLength+sizeof(FCGI_Header); P:=PByte(Arecord); @@ -439,7 +439,7 @@ begin begin // TODO : Better checking on ErrorCode R.FKeepConnectionAfterRequest:=False; - Raise HTTPError.CreateFmt(SErrWritingSocket,[ErrorCode]); + TFCgiHandler.DoError(SErrWritingSocket,[ErrorCode]); end; Inc(P,BytesWritten); Dec(BytesToWrite,BytesWritten); @@ -697,7 +697,7 @@ function TFCgiHandler.Read_FCGIRecord : PFCGI_Header; Inc(Result,Count); end else if (Count<0) then - Raise HTTPError.CreateFmt(SErrReadingSocket,[Count]); + DoError(SErrReadingSocket,[Count]); until (ByteAmount=0) or (Count=0); end; @@ -719,7 +719,7 @@ begin // TODO : if connection closed gracefully, the request should no longer be handled. // Need to discard request/response else If (BytesRead<>Sizeof(Header)) then - Raise HTTPError.CreateFmt(SErrReadingHeader,[BytesRead]); + DoError(SErrReadingHeader,[BytesRead]); ContentLength:=BetoN(Header.contentLength); PaddingLength:=Header.paddingLength; Getmem(ResRecord,BytesRead+ContentLength+PaddingLength); @@ -758,7 +758,7 @@ begin AddressLength:=Sizeof(IAddress); Socket := fpsocket(AF_INET,SOCK_STREAM,0); if Socket=-1 then - raise EFPWebError.CreateFmt(SNoSocket,[socketerror]); + DoError(SNoSocket,[socketerror]); IAddress.sin_family:=AF_INET; IAddress.sin_port:=htons(Port); if FAddress<>'' then @@ -775,7 +775,7 @@ begin CloseSocket(socket); Socket:=0; Terminate; - raise Exception.CreateFmt(SBindFailed,[port,socketerror]); + DoError(SBindFailed,[port,socketerror]); end; if (FLingerTimeout>0) then begin @@ -798,7 +798,7 @@ begin CloseSocket(socket); Socket:=0; Terminate; - raise Exception.CreateFmt(SListenFailed,[port,socketerror]); + DoError(SListenFailed,[port,socketerror]); end; end; @@ -994,7 +994,7 @@ begin if not terminated then begin Terminate; - raise Exception.CreateFmt(SNoInputHandle,[socketerror]); + DoError(SNoInputHandle,[socketerror]); end end; repeat diff --git a/packages/fcl-web/src/base/custweb.pp b/packages/fcl-web/src/base/custweb.pp index e28ef87847..0e42fe67a4 100644 --- a/packages/fcl-web/src/base/custweb.pp +++ b/packages/fcl-web/src/base/custweb.pp @@ -106,6 +106,8 @@ Type FOnLog : TLogEvent; FPreferModuleName : Boolean; protected + Class Procedure DoError(Msg : String; AStatusCode : Integer = 0; AStatusText : String = ''); + Class Procedure DoError(Fmt : String; Const Args : Array of const;AStatusCode : Integer = 0; AStatusText : String = ''); procedure Terminate; virtual; Function GetModuleName(Arequest : TRequest) : string; function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; virtual; abstract; @@ -205,7 +207,7 @@ Type Property PreferModuleName : Boolean Read GetPreferModuleName Write SetPreferModuleName; end; - EFPWebError = Class(Exception); + EFPWebError = Class(EFPHTTPError); procedure ExceptionToHTML(S: TStrings; const E: Exception; const Title, Email, Administrator: string); @@ -254,7 +256,7 @@ begin end; end; -procedure TWebHandler.Run; +Procedure TWebHandler.Run; var ARequest : TRequest; AResponse : TResponse; begin @@ -267,16 +269,29 @@ begin end; end; -procedure TWebHandler.Log(EventType: TEventType; const Msg: String); +Procedure TWebHandler.Log(EventType: TEventType; Const Msg: String); begin If Assigned(FOnLog) then FOnLog(EventType,Msg); end; procedure TWebHandler.ShowRequestException(R: TResponse; E: Exception); + + Function GetStatusCode : integer; + + begin + if (E is EHTTP) then + Result:=EHTTP(E).StatusCode + else + Result:=E.HelpContext; + if (Result=0) then + Result:=500; + end; + Var - S : TStrings; - handled: boolean; + S : TStrings; + handled: boolean; + CT : String; begin if R.ContentSent then exit; @@ -294,8 +309,14 @@ begin end; If (not R.HeadersSent) then begin - R.Code:=500; - R.CodeText:='Application error '+E.ClassName; + R.Code:=GetStatusCode; + if (E is EHTTP) Then + CT:=EHTTP(E).StatusText + else + CT:=''; + if (CT='') then + CT:='Application error '+E.ClassName;; + R.CodeText:=CT; R.ContentType:='text/html'; end; If (R.ContentType='text/html') then @@ -311,27 +332,27 @@ begin end; end; -procedure TWebHandler.InitRequest(ARequest: TRequest); +Procedure TWebHandler.InitRequest(ARequest: TRequest); begin ARequest.OnUnknownEncoding:=Self.OnUnknownRequestEncoding; end; -procedure TWebHandler.InitResponse(AResponse: TResponse); +Procedure TWebHandler.InitResponse(AResponse: TResponse); begin // Do nothing end; -function TWebHandler.GetEmail: String; +Function TWebHandler.GetEmail: String; begin Result := FEmail; end; -function TWebHandler.GetAdministrator: String; +Function TWebHandler.GetAdministrator: String; begin Result := FAdministrator; end; -procedure TWebHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse); +Procedure TWebHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse); Var MC : TCustomHTTPModuleClass; M : TCustomHTTPModule; @@ -350,7 +371,7 @@ begin MN:=GetModuleName(ARequest); MI:=ModuleFactory.FindModule(MN); if (MI=Nil) then - Raise EFPWebError.CreateFmt(SErrNoModuleForRequest,[MN]); + DoError(SErrNoModuleForRequest,[MN],400,'Not found'); MC:=MI.ModuleClass; end; M:=FindModule(MC); // Check if a module exists already @@ -386,6 +407,24 @@ begin Result:=ARequest.ScriptName; end; +Class Procedure TWebHandler.DoError(Msg : String;AStatusCode : Integer = 0; AStatusText : String = ''); + +Var + E : EFPWebError; + +begin + E:=EFPWebError.Create(Msg); + E.StatusCode:=AStatusCode; + E.StatusText:=AStatusText; + Raise E; +end; + +Class Procedure TWebHandler.DoError(Fmt: String; Const Args: Array of const; + AStatusCode: Integer = 0; AStatusText: String = ''); +begin + DoError(Format(Fmt,Args),AStatusCode,AStatusText); +end; + procedure TWebHandler.Terminate; begin FTerminated := true; @@ -393,7 +432,7 @@ begin FOnTerminate(Self); end; -function TWebHandler.GetModuleName(Arequest: TRequest): string; +Function TWebHandler.GetModuleName(Arequest: TRequest): string; Function GetDefaultModuleName : String; @@ -426,7 +465,7 @@ begin If (Result='') then begin if Not AllowDefaultModule then - Raise EFPWebError.Create(SErrNoModuleNameForRequest); + DoError(SErrNoModuleNameForRequest,400,'Not found'); Result:=GetDefaultModuleName end; end; @@ -450,8 +489,8 @@ begin Result:=Nil; end; -procedure TWebHandler.SetBaseURL(AModule: TCustomHTTPModule; - Const AModuleName : String; ARequest: TRequest); +Procedure TWebHandler.SetBaseURL(AModule: TCustomHTTPModule; + Const AModuleName: String; ARequest: TRequest); Var S,P : String; @@ -469,7 +508,7 @@ begin AModule.BaseURL:=S+P; end; -procedure TWebHandler.DoHandleRequest(ARequest: TRequest; AResponse: TResponse); +Procedure TWebHandler.DoHandleRequest(ARequest: TRequest; AResponse: TResponse); begin Try HandleRequest(ARequest,AResponse); diff --git a/packages/fcl-web/src/base/fpapache.pp b/packages/fcl-web/src/base/fpapache.pp index c29751e2d8..346ba6da6a 100644 --- a/packages/fcl-web/src/base/fpapache.pp +++ b/packages/fcl-web/src/base/fpapache.pp @@ -157,7 +157,7 @@ Type end; - EFPApacheError = Class(Exception); + EFPApacheError = Class(EHTTP); Var Application : TCustomApacheApplication = Nil; diff --git a/packages/fcl-web/src/base/fpapache24.pp b/packages/fcl-web/src/base/fpapache24.pp index cf37c3aa25..25beabee5e 100644 --- a/packages/fcl-web/src/base/fpapache24.pp +++ b/packages/fcl-web/src/base/fpapache24.pp @@ -157,7 +157,7 @@ Type end; - EFPApacheError = Class(Exception); + EFPApacheError = Class(EHTTP); Var Application : TCustomApacheApplication = Nil; diff --git a/packages/fcl-web/src/base/fphtml.pp b/packages/fcl-web/src/base/fphtml.pp index 88f4a3adbc..d848b06fe4 100644 --- a/packages/fcl-web/src/base/fphtml.pp +++ b/packages/fcl-web/src/base/fphtml.pp @@ -516,7 +516,7 @@ type Property OnCreateWriter; end; - EHTMLError = Class(Exception); + EHTMLError = Class(EHTTP); const SimpleOkButton: array[0..0] of TWebButton = ((buttontype: btok;caption: 'Ok';onclick: '')); @@ -603,12 +603,12 @@ end; procedure TJavaScriptStack.RedrawContentProducer(AContentProducer: THTMLContentProducer); begin - raise exception.Create('RedrawContentProducer not supported by current WebController'); + raise EHTMLError.Create('RedrawContentProducer not supported by current WebController'); end; procedure TJavaScriptStack.CallServerEvent(AHTMLContentProducer: THTMLContentProducer; AEvent: Integer; APostVariable: string = ''); begin - raise exception.Create('SendServerEvent not supported by current WebController'); + raise EHTMLError.Create('SendServerEvent not supported by current WebController'); end; procedure TJavaScriptStack.Clear; @@ -786,7 +786,7 @@ begin else begin for i := 0 to high(Events) do if assigned(events[i].csCallback) or assigned(events[i].ServerEvent) then - raise exception.Create('There is no webcontroller available, which is necessary to use events.'); + raise EHTMLError.Create('There is no webcontroller available, which is necessary to use events.'); end; end; end; @@ -832,7 +832,7 @@ begin end; end; if ExceptIfNotAvailable then - raise Exception.Create('No webcontroller available'); + raise EHTMLError.Create('No webcontroller available'); end; procedure THTMLContentProducer.BeforeGenerateContent; @@ -1478,7 +1478,7 @@ var begin i := length(FIterationIDs); if i=0 then - raise Exception.Create('DecrementIterationLevel can not be called more times then IncrementIterationLevel'); + raise EHTMLError.Create('DecrementIterationLevel can not be called more times then IncrementIterationLevel'); SetLength(FIterationIDs,i-1); end; diff --git a/packages/fcl-web/src/base/fphttp.pp b/packages/fcl-web/src/base/fphttp.pp index cd5c78eaf6..837bf8aaa0 100644 --- a/packages/fcl-web/src/base/fphttp.pp +++ b/packages/fcl-web/src/base/fphttp.pp @@ -207,7 +207,9 @@ Type Property Modules [Index : Integer]: TModuleItem Read GetModule Write SetModule;default; end; - EFPHTTPError = Class(Exception); + { EFPHTTPError } + + EFPHTTPError = Class(EHTTP); Procedure RegisterHTTPModule(ModuleClass : TCustomHTTPModuleClass; SkipStreaming : Boolean = False); Procedure RegisterHTTPModule(Const ModuleName : String; ModuleClass : TCustomHTTPModuleClass; SkipStreaming : Boolean = False); @@ -227,6 +229,7 @@ Resourcestring SErrRequestNotHandled = 'Web request was not handled by actions.'; SErrNoSessionFactoryClass = 'No session manager class available. Include iniwebsession unit and recompile.'; SErrNoSessionOutsideRequest = 'Default session not available outside handlerequest'; + Implementation {$ifdef cgidebug} @@ -248,6 +251,7 @@ begin Result:=GSM; end; + { TCustomHTTPModule } procedure TCustomHTTPModule.DoAfterInitModule(ARequest: TRequest); diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp index 647ff26d56..7c2bcf2728 100644 --- a/packages/fcl-web/src/base/fphttpclient.pp +++ b/packages/fcl-web/src/base/fphttpclient.pp @@ -268,7 +268,8 @@ Type Property OnHeaders; Property OnGetSocketHandler; end; - EHTTPClient = Class(Exception); + + EHTTPClient = Class(EHTTP); Function EncodeURLElement(S : String) : String; Function DecodeURLElement(Const S : String) : String; diff --git a/packages/fcl-web/src/base/fphttpserver.pp b/packages/fcl-web/src/base/fphttpserver.pp index f32d6527fd..6691e736a0 100644 --- a/packages/fcl-web/src/base/fphttpserver.pp +++ b/packages/fcl-web/src/base/fphttpserver.pp @@ -195,7 +195,7 @@ Type Property OnRequestError; end; - EHTTPServer = Class(Exception); + EHTTPServer = Class(EHTTP); Function GetStatusCode (ACode: Integer) : String; @@ -475,7 +475,7 @@ begin Request.PathInfo:=Request.URL; S:=GetNextWord(AStartLine); If (Pos('HTTP/',S)<>1) then - Raise Exception.Create(SErrMissingProtocol); + Raise EHTTPServer.CreateHelp(SErrMissingProtocol,400); Delete(S,1,5); Request.ProtocolVersion:=trim(S); end; diff --git a/packages/fcl-web/src/base/fpweb.pp b/packages/fcl-web/src/base/fpweb.pp index 8084498a33..bbf995f40b 100644 --- a/packages/fcl-web/src/base/fpweb.pp +++ b/packages/fcl-web/src/base/fpweb.pp @@ -155,7 +155,7 @@ Type Property AfterInitModule; end; - EFPWebError = Class(HTTPError); + EFPWebError = Class(EHTTP); resourcestring SErrInvalidVar = 'Invalid template variable name : "%s"'; diff --git a/packages/fcl-web/src/base/httpdefs.pp b/packages/fcl-web/src/base/httpdefs.pp index c59ab79eff..276bf372ef 100644 --- a/packages/fcl-web/src/base/httpdefs.pp +++ b/packages/fcl-web/src/base/httpdefs.pp @@ -494,8 +494,21 @@ type TRequestEvent = Procedure (Sender: TObject; ARequest : TRequest) of object; TResponseEvent = Procedure (Sender: TObject; AResponse : TResponse) of object; - - HTTPError = Class(Exception); + + { EHTTP } + + EHTTP = Class(Exception) + private + FStatusCode: Integer; + FStatusText: String; + function GetStatusCode: Integer;virtual; + Public + // These are transformed to the HTTP status code and text. Helpcontext is taken as the default for statuscode. + Property StatusCode : Integer Read GetStatusCode Write FStatusCode; + Property StatusText : String Read FStatusText Write FStatusText; + end; + + HTTPError = EHTTP; Function HTTPDecode(const AStr: String): String; Function HTTPEncode(const AStr: String): String; @@ -668,6 +681,15 @@ Type Procedure Process(Stream : TStream); override; end; +{ EHTTP } + +function EHTTP.GetStatusCode: Integer; +begin + Result:=FStatusCode; + if Result=0 then + Result:=HelpContext; +end; + procedure THTTPMimeItem.SetHeader(AIndex: Integer; const AValue: String); begin @@ -1521,7 +1543,7 @@ begin {$endif} R:=Method; if (R='') then - Raise Exception.Create(SErrNoRequestMethod); + Raise EHTTP.CreateHelp(SErrNoRequestMethod,400); // Always process QUERYSTRING. InitGetVars; // POST and PUT, force post var treatment. diff --git a/packages/fcl-web/src/base/webpage.pp b/packages/fcl-web/src/base/webpage.pp index dd86ac125e..c6bffa7197 100644 --- a/packages/fcl-web/src/base/webpage.pp +++ b/packages/fcl-web/src/base/webpage.pp @@ -375,7 +375,7 @@ end; function TWebPage.GetWebController: TWebController; begin if not assigned(FWebController) then - raise exception.create('No webcontroller available'); + raise EHTTP.create('No webcontroller available'); result := FWebController; end;