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

* Implemented ProtocolOptions and OnUnknownRecord to handle unknown FastCGI records

Browse Source 
git-svn-id: trunk@15567 -
This commit is contained in:
michael 2010-07-14 14:31:50 +00:00
parent 0ee895f141
commit 2397fa8b40
1 changed files with 65 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -26,13 +26,22 @@ uses
Type
{ TFCGIRequest }
TCustomFCgiApplication = Class;
TFCGIRequest = Class;
TFCGIResponse = Class;
TProtocolOption = (poNoPadding,poStripContentLength, poFailonUnknownRecord );
TProtocolOptions = Set of TProtocolOption;
TUnknownRecordEvent = Procedure (ARequest : TFCGIRequest; AFCGIRecord: PFCGI_Header) Of Object;
TFCGIRequest = Class(TCGIRequest)
Private
FHandle: THandle;
FKeepConnectionAfterRequest: boolean;
FPO: TProtoColOptions;
FRequestID : Word;
FCGIParams : TSTrings;
FUR: TUnknownRecordEvent;
procedure GetNameValuePairsFromContentRecord(const ARecord : PFCGI_ContentRecord; NameValueList : TStrings);
Protected
Function GetFieldValue(Index : Integer) : String; override;
@ -43,16 +52,22 @@ Type
property RequestID : word read FRequestID write FRequestID;
property Handle : THandle read FHandle write FHandle;
property KeepConnectionAfterRequest : boolean read FKeepConnectionAfterRequest;
Property ProtocolOptions : TProtoColOptions read FPO Write FPO;
Property OnUnknownRecord : TUnknownRecordEvent Read FUR Write FUR;
end;
{ TFCGIResponse }
TFCGIResponse = Class(TCGIResponse)
private
FNoPadding: Boolean;
FPO: TProtoColOptions;
FStripCL: Boolean;
procedure Write_FCGIRecord(ARecord : PFCGI_Header);
Protected
Procedure DoSendHeaders(Headers : TStrings); override;
Procedure DoSendContent; override;
Property ProtocolOptions : TProtoColOptions Read FPO Write FPO;
end;
TReqResp = record
@ -64,6 +79,8 @@ Type
TCustomFCgiApplication = Class(TCustomWebApplication)
Private
FOnUnknownRecord: TUnknownRecordEvent;
FPO: TProtoColOptions;
FRequestsArray : Array of TReqResp;
FRequestsAvail : integer;
FHandle : THandle;
@ -77,6 +94,8 @@ Type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Port: integer read FPort write FPort;
Property ProtocolOptions : TProtoColOptions Read FPO Write FPO;
Property OnUnknownRecord : TUnknownRecordEvent Read FOnUnknownRecord Write FOnUnknownRecord;
end;
ResourceString
@ -146,6 +165,12 @@ begin
FContentRead:=True;
end;
end;
else
if Assigned(FUR) then
FUR(Self,AFCGIRecord)
else
if poFailonUnknownRecord in FPO then
Raise EFPWebError.CreateFmt('Unknown FASTCGI record type: %s',[AFCGIRecord^.reqtype]);
end;
end;
@ -194,6 +219,7 @@ begin
end;
end;
Function TFCGIRequest.GetFieldValue(Index : Integer) : String;
Type THttpToCGI = array[1..CGIVarCount] of byte;
@ -270,14 +296,26 @@ var
pl : byte;
str : String;
ARespRecord : PFCGI_ContentRecord;
I : Integer;
begin
str := Headers.Text;
For I:=Headers.Count-1 downto 0 do
If (Headers[i]='') then
Headers.Delete(I);
// IndexOfName Does not work ?
If (poStripContentLength in ProtocolOptions) then
For I:=Headers.Count-1 downto 0 do
If (Pos('Content-Length',Headers[i])<>0) then
Headers.Delete(i);
str := Headers.Text+sLineBreak;
cl := length(str);
pl := (cl mod 8);
if ((cl mod 8)=0) or (poNoPadding in ProtocolOptions) then
pl:=0
else
pl := 8-(cl mod 8);
ARespRecord:=nil;
Getmem(ARespRecord,8+cl+pl);
FillChar(ARespRecord^,8+cl+pl,0);
ARespRecord^.header.version:=FCGI_VERSION_1;
ARespRecord^.header.reqtype:=FCGI_STDOUT;
ARespRecord^.header.paddingLength:=pl;
@ -305,10 +343,11 @@ begin
end
else
str := Contents.Text;
cl := length(str);
pl := (cl mod 8);
if ((cl mod 8)=0) or (poNoPadding in ProtocolOptions) then
pl:=0
else
pl := 8-(cl mod 8);
ARespRecord:=Nil;
Getmem(ARespRecord,8+cl+pl);
ARespRecord^.header.version:=FCGI_VERSION_1;
@ -317,8 +356,10 @@ begin
ARespRecord^.header.contentLength:=NtoBE(cl);
ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
move(str[1],ARespRecord^.ContentData,cl);
Write_FCGIRecord(PFCGI_Header(ARespRecord));
Freemem(ARespRecord);
FillChar(EndRequest,SizeOf(FCGI_EndRequestRecord),0);
EndRequest.header.version:=FCGI_VERSION_1;
EndRequest.header.reqtype:=FCGI_END_REQUEST;
@ -342,8 +383,11 @@ end;
destructor TCustomFCgiApplication.Destroy;
begin
SetLength(FRequestsArray,0);
if port<>0 then
fpshutdown(Socket,2);
if (Socket<>0) then
begin
CloseSocket(Socket);
Socket:=0;
end;
inherited Destroy;
end;
@ -353,7 +397,7 @@ begin
begin
Assert(ARequest=Request);
Assert(AResponse=Response);
if not TFCGIRequest(ARequest).KeepConnectionAfterRequest then
if (not TFCGIRequest(ARequest).KeepConnectionAfterRequest) then
begin
fpshutdown(FHandle,SHUT_RDWR);
CloseSocket(FHandle);
@ -425,14 +469,22 @@ begin
begin
Socket := fpsocket(AF_INET,SOCK_STREAM,0);
if Socket=-1 then
raise Exception.CreateFmt(SNoSocket,[socketerror]);
raise EFPWebError.CreateFmt(SNoSocket,[socketerror]);
Address.sin_family:=AF_INET;
Address.sin_port:=htons(Port);
Address.sin_addr.s_addr:=0;
if fpbind(Socket,@Address,AddressLength)=-1 then
begin
CloseSocket(socket);
Socket:=0;
raise Exception.CreateFmt(SBindFailed,[port,socketerror]);
end;
if fplisten(Socket,1)=-1 then
begin
CloseSocket(socket);
Socket:=0;
raise Exception.CreateFmt(SListenFailed,[port,socketerror]);
end;
end
else
Socket:=StdInputHandle;
@ -463,12 +515,15 @@ begin
ATempRequest:=TFCGIRequest.Create;
ATempRequest.RequestID:=ARequestID;
ATempRequest.Handle:=FHandle;
ATempRequest.ProtocolOptions:=Self.Protocoloptions;
ATempRequest.OnUnknownRecord:=Self.OnUnknownRecord;
FRequestsArray[ARequestID].Request := ATempRequest;
end;
if FRequestsArray[ARequestID].Request.ProcessFCGIRecord(AFCGI_Record) then
begin
ARequest:=FRequestsArray[ARequestID].Request;
FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
AResponse:=FRequestsArray[ARequestID].Response;
Result := True;
Break;