We found an issue, which caused incoming requests that had very long JSON-Strings (2 million characters+, such as a Base64 Image) to be processed for extreme durations (15-20 minutes for a 2 MB JSON).
We also found the cause of this issue:
The method ReadString() in Unit “uROJSONParser.pas” is written in such a way that upon reading a single character, the result string is expanded. This is very slow, when ran millions of times.
We did this third party change as a work-around:
Base code:
function ReadString(AStream: TStream):JSON_String;
var
LChar: JSON_Char;
s: JSON_String;
begin
Result:='';
lchar := ReadChar(AStream,False);
while lChar <> '"' do begin
if lchar = '\' then begin
lchar:=ReadChar(AStream,False);
if lchar = 'n' then Result := Result + #0010
else if lchar = 'r' then Result := Result + #0013
else if lchar = 't' then Result := Result + #0009
else if lchar = '"' then Result := Result + lchar
else if lchar = '\' then Result := Result + lchar
else if lchar = '/' then Result := Result + lchar
else if lchar = 'u' then begin
SetLength(s, 4);
AStream.ReadBuffer(Pointer(s)^,4*sizeOf(JSON_Char));
Result:=Result + HexCodetoChar(s);
end
else if lchar = 'b' then Result := Result + #0008
else if lchar = 'f' then Result := Result + #0012
else JSON_Error(AStream);
end
else
Result := Result + lChar;
lchar := ReadChar(AStream,False);
end;
end;
Adjusted Code:
function ReadString(AStream: TStream):JSON_String;
var
LChar: JSON_Char;
s: JSON_String;
aPos: integer;
aLen: integer;
begin
aPos := AStream.Position;
aLen := 0;
lchar := ReadChar(AStream,False);
while lChar <> '"' do begin
if lchar = '\' then begin
lchar:=ReadChar(AStream,False);
end;
lchar := ReadChar(AStream,False);
end;
aLen := AStream.Position - aPos;
AStream.Position := aPos;
Result := StringOfChar(#0, aLen);
aPos := 1;
lchar := ReadChar(AStream,False);
while lChar <> '"' do begin
if lchar = '\' then begin
lchar:=ReadChar(AStream,False);
if lchar = 'n' then Result[aPos] := #0010
else if lchar = 'r' then Result[aPos] := #0013
else if lchar = 't' then Result[aPos] := #0009
else if lchar = '"' then Result[aPos] := lchar
else if lchar = '\' then Result[aPos] := lchar
else if lchar = '/' then Result[aPos] := lchar
else if lchar = 'u' then begin
SetLength(s, 4);
AStream.ReadBuffer(Pointer(s)^,4*sizeOf(JSON_Char));
Result[aPos] := HexCodetoChar(s);
end
else if lchar = 'b' then Result[aPos] := #0008
else if lchar = 'f' then Result[aPos] := #0012
else JSON_Error(AStream);
Inc(aPos);
end
else
begin
Result[aPos] := lChar;
Inc(aPos);
end;
lchar := ReadChar(AStream,False);
end;
SetLength(Result, aPos - 1);
end;
It would be very helpful if this could be fixed in the original product, so that we can remove the third party change when we get an update in the future.
We also made a Unit Test to test this:
procedure TROJSONMessage_Test.Performance_Test;
const
cBigFileName = 'C:\test\image.json';
var
aFileStream: TFileStream;
aMessage : TROJSONMessage;
begin
aFileStream := TFileStream.Create(cBigFileName, fmOpenRead);
aMessage := TROJSONMessage.Create;
try
StartStopWatch;
aMessage.ReadFromStream(aFileStream);
StopStopWatch;
CheckLessThan(StopWatch.Elapsed, 200); // 50 ms lokal
CheckEquals('my_method', fMessage.RootObject.AsObject.GetStringValueByName('method'));
CheckEquals(1845527, Length(fMessage.RootObject.AsObject.GetObjectItemByName('params', false)
.GetObjectItemByName('module', false).GetStringValueByName('BitBase')));
finally
aFileStream.Free;
aMessage.Free;
end;
end;
image.json (1.8 MB)
