paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-04 07:47:19 +01:00
Code Issues Packages Projects Releases Wiki Activity

* While reading POST data keep waiting for data until contentlength bytes are read, with a timeout of about 15 seconds.

Browse Source 
git-svn-id: trunk@14806 -
This commit is contained in:
joost 2010-01-26 11:50:41 +00:00
parent bb5891a560
commit 6aa6f7ebf4
1 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
packages/fcl-web/src/custcgi.pp
View File

@ -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