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

fcl-web: TWSFramePayload.ReadData: check for endless loop and wait for new data

Browse Source
This commit is contained in:
mattias 2023-06-22 12:30:40 +02:00
parent f047c40bca
commit 74e24a3864
1 changed files with 17 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
packages/fcl-web/src/websocket/fpwebsocket.pp
View File

@ -881,21 +881,33 @@ Const
Var Var
Buf : TBytes; Buf : TBytes;
aPos,toRead : QWord; aPos,toRead : QWord;
aCount : Longint; aCount, FailCnt : Longint;
begin begin
Buf:=[]; Buf:=[];
ToRead:=DataLength; ToRead:=DataLength;
aPos:=0; aPos:=0;
FailCnt:=0;
Repeat Repeat
aCount:=ToRead; aCount:=ToRead;
if aCount>MaxBufSize then if aCount>MaxBufSize then
aCount:=MaxBufSize; aCount:=MaxBufSize;
SetLength(Buf,aCount); SetLength(Buf,aCount);
aCount := aTransport.ReadBytes(Buf,aCount); aCount := aTransport.ReadBytes(Buf,aCount);
if aCount>0 then
begin
Move(Buf[0],Content[aPos],aCount); Move(Buf[0],Content[aPos],aCount);
Inc(aPos,aCount); Inc(aPos,aCount);
ToRead:=DataLength-aPos; ToRead:=DataLength-aPos;
FailCnt:=0;
end
else
begin
sleep(1);
inc(FailCnt);
if FailCnt>100 then
raise Exception.Create('20230316102741 TWSFramePayload.ReadData');
end;
Until (ToRead<=0); Until (ToRead<=0);
end; end;