* Fixed some corner cases in readrecord

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@17204 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 58 insertions, 4 deletions

diff --git a/packages/fcl-web/src/base/custfcgi.pp b/packages/fcl-web/src/base/custfcgi.pp
index 9ca3a20d2e..4be71d53f1 100644
--- a/packages/fcl-web/src/base/custfcgi.pp
+++ b/packages/fcl-web/src/base/custfcgi.pp
@@ -21,7 +21,13 @@ unit custfcgi;
 Interface
 
 uses
-  Classes,SysUtils, httpdefs, Sockets, custweb, custcgi, fastcgi;
+  Classes,SysUtils, httpdefs, 
+{$ifdef unix}
+  BaseUnix, TermIO,
+{$else}
+  winsock2,
+{$endif}
+  Sockets, custweb, custcgi, fastcgi;
 
 Type
   { TFCGIRequest }
@@ -29,7 +35,8 @@ Type
   TFCGIRequest = Class;
   TFCGIResponse = Class;
 
-  TProtocolOption = (poNoPadding,poStripContentLength, poFailonUnknownRecord );
+  TProtocolOption = (poNoPadding,poStripContentLength, poFailonUnknownRecord,
+                     poReuseAddress, poUseSelect );
   TProtocolOptions = Set of TProtocolOption;
 
   TUnknownRecordEvent = Procedure (ARequest : TFCGIRequest; AFCGIRecord: PFCGI_Header) Of Object;
@@ -84,8 +91,10 @@ Type
     FHandle : THandle;
     Socket: longint;
     FAddress: string;
+    FTimeOut,
     FPort: integer;
     function Read_FCGIRecord : PFCGI_Header;
+    function DataAvailable : Boolean;
   protected
     function  ProcessRecord(AFCGI_Record: PFCGI_Header; out ARequest: TRequest;  out AResponse: TResponse): boolean; virtual;
     procedure SetupSocket(var IAddress: TInetSockAddr;  var AddressLength: tsocklen); virtual;
@@ -98,6 +107,7 @@ Type
     property Address: string read FAddress write FAddress;
     Property ProtocolOptions : TProtoColOptions Read FPO Write FPO;
     Property OnUnknownRecord : TUnknownRecordEvent Read FOnUnknownRecord Write FOnUnknownRecord;
+    Property TimeOut : Integer Read FTimeOut Write FTimeOut;
   end;
 
   { TCustomFCgiApplication }
@@ -136,6 +146,7 @@ Implementation
 uses
   dbugintf;
 {$endif}
+ 
 
 
 {$undef nosignal}
@@ -433,6 +444,7 @@ begin
   FRequestsAvail:=5;
   SetLength(FRequestsArray,FRequestsAvail);
   FHandle := THandle(-1);
+  FTimeOut:=50;
 end;
 
 destructor TFCgiHandler.Destroy;
@@ -539,7 +551,7 @@ begin
     PFCGI_Header(ResRecord)^:=Header;
     ReadBuf:=ResRecord+BytesRead;
     BytesRead:=ReadBytes(ReadBuf,ContentLength);
-    If (BytesRead=0) then
+    If (BytesRead=0) and (ContentLength>0) then
       begin
       FreeMem(resRecord);
       Exit // Connection closed gracefully.
@@ -547,7 +559,7 @@ begin
       end;
     ReadBuf:=ReadBuf+BytesRead;
     BytesRead:=ReadBytes(ReadBuf,PaddingLength);
-    If (BytesRead=0) then
+    If (BytesRead=0) and (PaddingLength>0) then
       begin
       FreeMem(resRecord);
       Exit // Connection closed gracefully.
@@ -573,6 +585,11 @@ begin
     Iaddress.sin_addr := StrToHostAddr(FAddress)
   else
     IAddress.sin_addr.s_addr:=0;
+    {$IFDEF Unix}
+    // remedy socket port locking on Posix platforms
+    If (poReuseAddress in ProtocolOptions) then
+      fpSetSockOpt(Socket, SOL_SOCKET, SO_REUSEADDR, @IAddress, SizeOf(IAddress));
+    {$ENDIF}
   if fpbind(Socket,@IAddress,AddressLength)=-1 then
     begin
     CloseSocket(socket);
@@ -589,6 +606,36 @@ begin
     end;
 end;
 
+{$ifdef unix}
+function TFCgiHandler.DataAvailable: Boolean;
+
+var
+  FDS: TFDSet;
+  TimeV: TTimeVal;
+
+begin
+  fpFD_Zero(FDS);
+  fpFD_Set(FHandle, FDS);
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  Result := fpSelect(FHandle + 1, @FDS, @FDS, @FDS, @TimeV) > 0;
+end;
+{$else}
+function TFCgiHandler.DataAvailable: Boolean;
+
+var
+  FDS: TFDSet;
+  TimeV: TTimeVal;
+
+begin
+  FD_Zero(FDS);
+  FD_Set(FHandle, FDS);
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  Result := Select(FHandle + 1, @FDS, @FDS, @FDS, @TimeV) <> 0;
+end;
+{$endif}
+
 function TFCgiHandler.ProcessRecord(AFCGI_Record  : PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean;
 
 var
@@ -652,7 +699,14 @@ begin
       end;
     end;
   repeat
+    If (poUseSelect in ProtocolOptions) then
+      begin
+      While Not DataAvailable do
+        If (OnIdle<>Nil) then
+          OnIdle(Self);
+      end;
     AFCGI_Record:=Read_FCGIRecord;
+
     if assigned(AFCGI_Record) then
     try
       Result:=ProcessRecord(AFCGI_Record,ARequest,AResponse);