paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 19:39:31 +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

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

@ -881,21 +881,33 @@ Const
Var
Buf : TBytes;
aPos,toRead : QWord;
aCount : Longint;
aCount, FailCnt : Longint;
begin
Buf:=[];
ToRead:=DataLength;
aPos:=0;
FailCnt:=0;
Repeat
aCount:=ToRead;
if aCount>MaxBufSize then
aCount:=MaxBufSize;
SetLength(Buf,aCount);
aCount := aTransport.ReadBytes(Buf,aCount);
Move(Buf[0],Content[aPos],aCount);
Inc(aPos,aCount);
ToRead:=DataLength-aPos;
if aCount>0 then
begin
Move(Buf[0],Content[aPos],aCount);
Inc(aPos,aCount);
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);
end;
@ -912,7 +924,7 @@ begin
LenFlag := buffer[1] and FlagLengthMask;
Case LenFlag of
FlagTwoBytes:
FlagTwoBytes:
begin
aTransport.ReadBytes(Buffer,2);
Paylen16:=Buffer.ToWord(0);