THRIFT-4454 Large writes/reads may cause range check errors in debug mode
Client: Delphi
Patch: Jens Geyer
This closes #1466
diff --git a/lib/delphi/src/Thrift.Transport.Pipes.pas b/lib/delphi/src/Thrift.Transport.Pipes.pas
index aace4bb..fe96d72 100644
--- a/lib/delphi/src/Thrift.Transport.Pipes.pas
+++ b/lib/delphi/src/Thrift.Transport.Pipes.pas
@@ -328,6 +328,7 @@
procedure TPipeStreamBase.WriteDirect( const pBuf : Pointer; offset: Integer; count: Integer);
var cbWritten, nBytes : DWORD;
+ pData : PByte;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
@@ -336,11 +337,13 @@
// there's a system limit around 0x10000 bytes that we hit otherwise
// MSDN: "Pipe write operations across a network are limited to 65,535 bytes per write. For more information regarding pipes, see the Remarks section."
nBytes := Min( 15*4096, count); // 16 would exceed the limit
+ pData := pBuf;
+ Inc( pData, offset);
while nBytes > 0 do begin
- if not WriteFile( FPipe, PByteArray(pBuf)^[offset], nBytes, cbWritten, nil)
+ if not WriteFile( FPipe, pData^, nBytes, cbWritten, nil)
then raise TTransportExceptionNotOpen.Create('Write to pipe failed');
- Inc( offset, cbWritten);
+ Inc( pData, cbWritten);
Dec( count, cbWritten);
nBytes := Min( nBytes, count);
end;
@@ -350,6 +353,7 @@
procedure TPipeStreamBase.WriteOverlapped( const pBuf : Pointer; offset: Integer; count: Integer);
var cbWritten, dwWait, dwError, nBytes : DWORD;
overlapped : IOverlappedHelper;
+ pData : PByte;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
@@ -358,9 +362,11 @@
// there's a system limit around 0x10000 bytes that we hit otherwise
// MSDN: "Pipe write operations across a network are limited to 65,535 bytes per write. For more information regarding pipes, see the Remarks section."
nBytes := Min( 15*4096, count); // 16 would exceed the limit
+ pData := pBuf;
+ Inc( pData, offset);
while nBytes > 0 do begin
overlapped := TOverlappedHelperImpl.Create;
- if not WriteFile( FPipe, PByteArray(pBuf)^[offset], nBytes, cbWritten, overlapped.OverlappedPtr)
+ if not WriteFile( FPipe, pData^, nBytes, cbWritten, overlapped.OverlappedPtr)
then begin
dwError := GetLastError;
case dwError of
@@ -382,7 +388,7 @@
ASSERT( DWORD(nBytes) = cbWritten);
- Inc( offset, cbWritten);
+ Inc( pData, cbWritten);
Dec( count, cbWritten);
nBytes := Min( nBytes, count);
end;
@@ -393,6 +399,7 @@
var cbRead, dwErr, nRemaining : DWORD;
bytes, retries : LongInt;
bOk : Boolean;
+ pData : PByte;
const INTERVAL = 10; // ms
begin
if not IsOpen
@@ -427,14 +434,16 @@
result := 0;
nRemaining := count;
+ pData := pBuf;
+ Inc( pData, offset);
while nRemaining > 0 do begin
// read the data (or block INFINITE-ly)
- bOk := ReadFile( FPipe, PByteArray(pBuf)^[offset], nRemaining, cbRead, nil);
+ bOk := ReadFile( FPipe, pData^, nRemaining, cbRead, nil);
if (not bOk) and (GetLastError() <> ERROR_MORE_DATA)
then Break; // No more data, possibly because client disconnected.
Dec( nRemaining, cbRead);
- Inc( offset, cbRead);
+ Inc( pData, cbRead);
Inc( result, cbRead);
end;
end;
@@ -444,17 +453,20 @@
var cbRead, dwWait, dwError, nRemaining : DWORD;
bOk : Boolean;
overlapped : IOverlappedHelper;
+ pData : PByte;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called read on non-open pipe');
result := 0;
nRemaining := count;
+ pData := pBuf;
+ Inc( pData, offset);
while nRemaining > 0 do begin
overlapped := TOverlappedHelperImpl.Create;
// read the data
- bOk := ReadFile( FPipe, PByteArray(pBuf)^[offset], nRemaining, cbRead, overlapped.OverlappedPtr);
+ bOk := ReadFile( FPipe, pData^, nRemaining, cbRead, overlapped.OverlappedPtr);
if not bOk then begin
dwError := GetLastError;
case dwError of
@@ -477,7 +489,7 @@
ASSERT( cbRead > 0); // see TTransportImpl.ReadAll()
ASSERT( cbRead <= DWORD(nRemaining));
Dec( nRemaining, cbRead);
- Inc( offset, cbRead);
+ Inc( pData, cbRead);
Inc( result, cbRead);
end;
end;
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index 143611d..be6b8b5 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -71,6 +71,13 @@
);
TTestGroups = set of TTestGroup;
+ TTestSize = (
+ Empty, // Edge case: the zero-length empty binary
+ Normal, // Fairly small array of usual size (256 bytes)
+ ByteArrayTest, // THRIFT-4454 Large writes/reads may cause range check errors in debug mode
+ PipeWriteLimit // THRIFT-4372 Pipe write operations across a network are limited to 65,535 bytes per write.
+ );
+
private
FTransport : ITransport;
FProtocol : IProtocol;
@@ -95,7 +102,7 @@
{$ENDIF}
procedure JSONProtocolReadWriteTest;
- function PrepareBinaryData( aRandomDist, aHuge : Boolean) : TBytes;
+ function PrepareBinaryData( aRandomDist : Boolean; aSize : TTestSize) : TBytes;
{$IFDEF StressTest}
procedure StressTest(const client : TThriftTest.Iface);
{$ENDIF}
@@ -467,6 +474,7 @@
first_map : IThriftDictionary<TNumberz, IInsanity>;
second_map : IThriftDictionary<TNumberz, IInsanity>;
pair : TPair<TNumberz, TUserId>;
+ testsize : TTestSize;
begin
client := TThriftTest.TClient.Create( FProtocol);
FTransport.Open;
@@ -559,42 +567,18 @@
Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
// random binary small
- binOut := PrepareBinaryData( TRUE, FALSE);
- Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
- try
- binIn := client.testBinary(binOut);
- Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
- i32 := Min( Length(binOut), Length(binIn));
- Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
- except
- on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
- on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
- end;
-
- // random binary huge
- binOut := PrepareBinaryData( TRUE, TRUE);
- Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
- try
- binIn := client.testBinary(binOut);
- Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
- i32 := Min( Length(binOut), Length(binIn));
- Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
- except
- on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
- on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
- end;
-
- // empty binary
- SetLength( binOut, 0);
- Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
- try
- binIn := client.testBinary(binOut);
- Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
- i32 := Min( Length(binOut), Length(binIn));
- Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
- except
- on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
- on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
+ for testsize := Low(TTestSize) to High(TTestSize) do begin
+ binOut := PrepareBinaryData( TRUE, testsize);
+ Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
+ try
+ binIn := client.testBinary(binOut);
+ Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
+ i32 := Min( Length(binOut), Length(binIn));
+ Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
+ except
+ on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
+ on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
+ end;
end;
Console.WriteLine('testDouble(5.325098235)');
@@ -1063,18 +1047,25 @@
{$ENDIF}
-function TClientThread.PrepareBinaryData( aRandomDist, aHuge : Boolean) : TBytes;
+function TClientThread.PrepareBinaryData( aRandomDist : Boolean; aSize : TTestSize) : TBytes;
var i : Integer;
begin
- if aHuge
- then SetLength( result, $12345) // tests for THRIFT-4372
- else SetLength( result, $100);
+ case aSize of
+ Empty : SetLength( result, 0);
+ Normal : SetLength( result, $100);
+ ByteArrayTest : SetLength( result, SizeOf(TByteArray) + 128);
+ PipeWriteLimit : SetLength( result, 65535 + 128);
+ else
+ raise EArgumentException.Create('aSize');
+ end;
+
ASSERT( Low(result) = 0);
+ if Length(result) = 0 then Exit;
// linear distribution, unless random is requested
if not aRandomDist then begin
for i := Low(result) to High(result) do begin
- result[i] := i;
+ result[i] := i mod $100;
end;
Exit;
end;
@@ -1129,7 +1120,7 @@
StartTestGroup( 'JsonProtocolTest', test_Unknown);
// prepare binary data
- binary := PrepareBinaryData( FALSE, FALSE);
+ binary := PrepareBinaryData( FALSE, Normal);
SetLength( emptyBinary, 0); // empty binary data block
// output setup