--- Merging r14795 into '.':

U    packages/fcl-web/src/fpcgi.pp
--- Merging r14806 into '.':
U    packages/fcl-web/src/custcgi.pp
--- Merging r14817 into '.':
U    packages/fcl-web/src/custweb.pp
--- Merging r14992 into '.':
G    packages/fcl-web/src/custweb.pp
--- Merging r15108 into '.':
U    packages/fcl-web/src/custfcgi.pp
--- Merging r15176 into '.':
U    packages/paszlib/src/zipper.pp

git-svn-id: branches/fixes_2_4@15222 -

packages/fcl-web/src/custcgi.pp

@@ -320,14 +320,37 @@ var
   I : TIOStream;
   Cl : Integer;
   B : Byte;
+  retrycount: integer;
+  BytesRead, a: longint;
 begin
   Cl := ContentLength;
   I:=TIOStream.Create(iosInput);
   Try
     if (CL<>0) then
       begin
+      // It can be that the complete content is not yet send by the server so repeat the read
+      // until all data is really read
       SetLength(FContent,Cl);
-      I.Read(FContent[1],Cl);
+      BytesRead:=0;
+      repeat
+      a := I.Read(FContent[BytesRead+1],Cl-BytesRead);
+      BytesRead:=BytesRead+a;
+      if a=0 then // In fact this can not happen, but the content could be delayed...
+        begin
+        sleep(10);
+        a := I.Read(FContent[BytesRead+1],Cl-BytesRead);
+        if a=0 then for retrycount := 0 to 149 do // timeout of about 15 seconds
+          begin
+          sleep(100);
+          a := I.Read(FContent[BytesRead+1],Cl-BytesRead);
+          if a<>0 then break;
+          end;
+        BytesRead:=BytesRead+a;
+        end;
+      until (BytesRead>=Cl) or (a=0);
+      // In fact the request is incomplete, but this is not the place thrown an error for that
+      if BytesRead<Cl then
+        SetLength(FContent,BytesRead);
       end
     else
       begin

packages/fcl-web/src/custfcgi.pp

@@ -67,6 +67,8 @@ Type
     FRequestsArray : Array of TReqResp;
     FRequestsAvail : integer;
     FHandle : THandle;
+    Socket: longint;
+    FPort: integer;
     function Read_FCGIRecord : PFCGI_Header;
   protected
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
@@ -74,10 +76,14 @@ Type
   Public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    property Port: integer read FPort write FPort;
   end;
 
 ResourceString
   SNoInputHandle = 'Failed to open input-handle passed from server. Socket Error: %d';
+  SNoSocket      = 'Failed to open socket. Socket Error: %d';
+  SBindFailed    = 'Failed to bind to port %d. Socket Error: %d';
+  SListenFailed  = 'Failed to listen to port %d. Socket Error: %d';
 
 Implementation
 
@@ -319,6 +325,7 @@ begin
   EndRequest.header.contentLength:=NtoBE(8);
   EndRequest.header.paddingLength:=0;
   EndRequest.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
+  EndRequest.body.protocolStatus:=FCGI_REQUEST_COMPLETE;
   Write_FCGIRecord(PFCGI_Header(@EndRequest));
 end;
 
@@ -335,6 +342,8 @@ end;
 destructor TCustomFCgiApplication.Destroy;
 begin
   SetLength(FRequestsArray,0);
+  if port<>0 then
+    fpshutdown(Socket,2);
   inherited Destroy;
 end;
 
@@ -405,12 +414,33 @@ var
   ARequestID    : word;
   AFCGI_Record  : PFCGI_Header;
   ATempRequest  : TFCGIRequest;
+
 begin
   Result := False;
   AddressLength:=Sizeof(Address);
+
+  if Socket=0 then
+    begin
+    if Port<>0 then
+      begin
+      Socket := fpsocket(AF_INET,SOCK_STREAM,0);
+      if Socket=-1 then
+        raise Exception.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
+        raise Exception.CreateFmt(SBindFailed,[port,socketerror]);
+      if fplisten(Socket,1)=-1 then
+        raise Exception.CreateFmt(SListenFailed,[port,socketerror]);
+      end
+    else
+      Socket:=StdInputHandle;
+    end;
+
   if FHandle=-1 then
     begin
-    FHandle:=fpaccept(StdInputHandle,psockaddr(@Address),@AddressLength);
+    FHandle:=fpaccept(Socket,psockaddr(@Address),@AddressLength);
     if FHandle=-1 then
       raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
     end;

packages/fcl-web/src/custweb.pp

@@ -74,6 +74,7 @@ Type
   { TCustomWebApplication }
   TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
                                Var ModuleClass : TCustomHTTPModuleClass) of object;
+  TOnShowRequestException = procedure(AResponse: TResponse; AnException: Exception; var handled: boolean);
 
   TCustomWebApplication = Class(TCustomApplication)
   Private
@@ -82,6 +83,7 @@ Type
     FEmail: String;
     FModuleVar: String;
     FOnGetModule: TGetModuleEvent;
+    FOnShowRequestException: TOnShowRequestException;
     FRequest : TRequest;
     FHandleGetOnPost : Boolean;
     FRedirectOnError : Boolean;
@@ -97,7 +99,7 @@ Type
     Function GetAdministrator : String; virtual;
   Public
     constructor Create(AOwner: TComponent); override;
-    Procedure CreateForm(AClass : TComponentClass; Var Reference : TComponent);
+    Procedure CreateForm(AClass : TComponentClass; out Reference);
     Procedure Initialize; override;
     Procedure ShowException(E: Exception);override;
     Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse);
@@ -111,6 +113,7 @@ Type
     Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
     Property Email : String Read GetEmail Write FEmail;
     Property Administrator : String Read GetAdministrator Write FAdministrator;
+    property OnShowRequestException: TOnShowRequestException read FOnShowRequestException write FOnShowRequestException;
   end;
 
   EFPWebError = Class(Exception);
@@ -175,9 +178,16 @@ end;
 procedure TCustomWebApplication.ShowRequestException(R: TResponse; E: Exception);
 Var
  S : TStrings;
+ handled: boolean;
 
 begin
   if R.ContentSent then exit;
+  if assigned(OnShowRequestException) then
+    begin
+    handled:=false;
+    OnShowRequestException(R,E,Handled);
+    if handled then exit;
+    end;
   If RedirectOnError and not R.HeadersSent then
     begin
     R.SendRedirect(format(RedirectOnErrorURL,[HTTPEncode(E.Message)]));
@@ -331,9 +341,9 @@ begin
   FRedirectOnErrorURL := '';
 end;
 
-procedure TCustomWebApplication.CreateForm(AClass: TComponentClass; var Reference: TComponent);
+procedure TCustomWebApplication.CreateForm(AClass: TComponentClass; out Reference);
 begin
-  Reference:=AClass.Create(Self);
+  TComponent(Reference):=AClass.Create(Self);
 end;
 
 end.

packages/fcl-web/src/fpcgi.pp

@@ -32,10 +32,13 @@ Var
   
 Implementation
 
+uses CustApp;
+
 Procedure InitCGI;
 
 begin
   Application:=TCGIApplication.Create(Nil);
+  CustomApplication:=Application;
 end;
 
 Procedure DoneCGI;

packages/paszlib/src/zipper.pp

@@ -1459,6 +1459,7 @@ Procedure TZipper.ZipFiles(AFileName : String; FileList : TStrings);
 
 begin
   FFileName:=AFileName;
+  ZipFiles(FileList);
 end;
 
 procedure TZipper.ZipFiles(FileList: TStrings);