paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 10:49:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added HPACK implementation by José Mejuto (bug ID 30058)

Browse Source 
git-svn-id: trunk@33579 -
This commit is contained in:
michael 2016-04-30 08:29:26 +00:00
parent ecde605017
commit 87be61c807
10 changed files with 3124 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.gitattributes vendored
View File

@ -4350,10 +4350,17 @@ packages/hash/src/md5i386.inc svneol=native#text/plain
packages/hash/src/ntlm.pas svneol=native#text/plain
packages/hash/src/sha1.pp svneol=native#text/plain
packages/hash/src/sha1i386.inc svneol=native#text/plain
packages/hash/src/uhpack.pp svneol=native#text/plain
packages/hash/src/uhpackimp.pp svneol=native#text/plain
packages/hash/src/uhpacktables.pp svneol=native#text/plain
packages/hash/src/unixcrypt.pas svneol=native#text/plain
packages/hash/src/uuid.pas svneol=native#text/plain
packages/hash/tests/README.txt svneol=native#text/plain
packages/hash/tests/fpcunithpack.lpi svneol=native#text/plain
packages/hash/tests/fpcunithpack.lpr svneol=native#text/plain
packages/hash/tests/tests.pp svneol=native#text/pascal
packages/hash/tests/testshmac.pas svneol=native#text/pascal
packages/hash/tests/uhpacktest1.pas svneol=native#text/plain
packages/hermes/Makefile svneol=native#text/plain
packages/hermes/Makefile.fpc svneol=native#text/plain
packages/hermes/Makefile.fpc.fpcmake svneol=native#text/plain

2
packages/hash/Makefile.fpc
View File

@ -7,7 +7,7 @@ name=hash
version=3.1.1
[require]
packages=rtl
packages=rtl
[install]
fpcpackage=y

6
packages/hash/fpmake.pp
View File

@ -36,7 +36,11 @@ begin
T:=P.Targets.AddUnit('src/uuid.pas');
T:=P.Targets.AddUnit('src/hmac.pp');
T:=P.Targets.AddUnit('src/unixcrypt.pas');
T.OSes:=[Linux];
T:=P.Targets.AddUnit('src/uhpacktables.pp');
T:=P.Targets.AddUnit('src/uhpackimp.pp');
T:=P.Targets.AddUnit('src/uhpack.pp');
T.OSes:=[Linux];
T:=P.Targets.AddExampleunit('examples/mdtest.pas');
T:=P.Targets.AddExampleunit('examples/crctest.pas');
T:=P.Targets.AddExampleunit('examples/sha1test.pp');

87
packages/hash/src/uhpack.pp Normal file
View File

@ -0,0 +1,87 @@
(*
HPACK: Header Compression for HTTP/2 (rfc7541)
----------------------------------------------
Pascal implementation of HTTP/2 headers send and receive process.
Code based in Twitter's HPACK for java https://github.com/twitter/hpack
History:
2016.04.21 - Initial development by Jose Mejuto
Package source files
uhpackapi.pas (this file)
uhpack.pas
uhpacktables.pas
rfc7541.txt (rfc based on)
Basic API:
HPackDecoder.Create(MaxHeaderSize,MaxHeaderTableSize)
MaxHeaderSize: Each header block must not exceed this value (default: 8192)
MaxHeaderTableSize: Max size for the dynamic table (default: 4096)
HPackDecoder.Decode(DataStream)
This procedure receives a RawByteString or a Stream and decodes its headers.
If an OnAddHeader is created it will be called for each decoded header.
After all data has been sent to "Decode" the plain headers can be accessed
using "DecodedHeaders". After headers has been processed the function
"EndHeaderBlockTruncated" should be called to verify that the headers has
been successfully decoded.
HPackEncoder.Create(MaxHeaderTableSize)
Creates the Encoder with a MaxHeaderTableSize.
HPackEncoder.AddHeader(OutputStream,Name,Value,bSensitive)
Encodes a header pair Name/Value and also a sensitive flag (header should
not be stored in internal tables nor in encoder, nor in decoder) in the
OutputStream parameter.
THPACKException
Exception raised if some internal state do not work as expected, or sent
information does not meets the structure expected.
If the exception happens, even as some of the errors could be recovered, the
best approach is to free the object and recreate again and also drop the
http2 connection and restart it, as when this exception is raised is quite
sure that the connection is out of sync with remote end point.
License:
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*)
unit uhpack;
(*
This file exposes only the needed symbols instead the whole
infrastructure to handle HPack.
*)
{$mode objfpc}{$H+}
interface
uses
uhpackimp;
const
HPACK_MAX_HEADER_SIZE = uhpackimp.HPACK_MAX_HEADER_SIZE;
HPACK_MAX_HEADER_TABLE_SIZE = uhpackimp.HPACK_MAX_HEADER_TABLE_SIZE;
type
THPackDecoder=uhpackimp.THPackDecoder;
THPackEncoder=uhpackimp.THPackEncoder;
THPackHeaderAddEvent = uhpackimp.THPackHeaderAddEvent;
THPACKException= uhpackimp.THPACKException;
THPackHeaderTextList = uhpackimp.THPackHeaderTextList;
implementation
end.

1887
packages/hash/src/uhpackimp.pp Normal file
View File

File diff suppressed because it is too large Load Diff

94
packages/hash/src/uhpacktables.pp Normal file
View File

@ -0,0 +1,94 @@
unit uhpacktables;
interface
const
HPACK_HUFFMAN_CODES_LENGTH=257;
HPackHuffmanCodes: array [0..HPACK_HUFFMAN_CODES_LENGTH-1] of DWORD =(
$1ff8, $7fffd8, $fffffe2, $fffffe3, $fffffe4, $fffffe5, $fffffe6, $fffffe7,
$fffffe8, $ffffea, $3ffffffc, $fffffe9, $fffffea, $3ffffffd, $fffffeb, $fffffec,
$fffffed, $fffffee, $fffffef, $ffffff0, $ffffff1, $ffffff2, $3ffffffe, $ffffff3,
$ffffff4, $ffffff5, $ffffff6, $ffffff7, $ffffff8, $ffffff9, $ffffffa, $ffffffb,
$14, $3f8, $3f9, $ffa, $1ff9, $15, $f8, $7fa,
$3fa, $3fb, $f9, $7fb, $fa, $16, $17, $18,
$0, $1, $2, $19, $1a, $1b, $1c, $1d,
$1e, $1f, $5c, $fb, $7ffc, $20, $ffb, $3fc,
$1ffa, $21, $5d, $5e, $5f, $60, $61, $62,
$63, $64, $65, $66, $67, $68, $69, $6a,
$6b, $6c, $6d, $6e, $6f, $70, $71, $72,
$fc, $73, $fd, $1ffb, $7fff0, $1ffc, $3ffc, $22,
$7ffd, $3, $23, $4, $24, $5, $25, $26,
$27, $6, $74, $75, $28, $29, $2a, $7,
$2b, $76, $2c, $8, $9, $2d, $77, $78,
$79, $7a, $7b, $7ffe, $7fc, $3ffd, $1ffd, $ffffffc,
$fffe6, $3fffd2, $fffe7, $fffe8, $3fffd3, $3fffd4, $3fffd5, $7fffd9,
$3fffd6, $7fffda, $7fffdb, $7fffdc, $7fffdd, $7fffde, $ffffeb, $7fffdf,
$ffffec, $ffffed, $3fffd7, $7fffe0, $ffffee, $7fffe1, $7fffe2, $7fffe3,
$7fffe4, $1fffdc, $3fffd8, $7fffe5, $3fffd9, $7fffe6, $7fffe7, $ffffef,
$3fffda, $1fffdd, $fffe9, $3fffdb, $3fffdc, $7fffe8, $7fffe9, $1fffde,
$7fffea, $3fffdd, $3fffde, $fffff0, $1fffdf, $3fffdf, $7fffeb, $7fffec,
$1fffe0, $1fffe1, $3fffe0, $1fffe2, $7fffed, $3fffe1, $7fffee, $7fffef,
$fffea, $3fffe2, $3fffe3, $3fffe4, $7ffff0, $3fffe5, $3fffe6, $7ffff1,
$3ffffe0, $3ffffe1, $fffeb, $7fff1, $3fffe7, $7ffff2, $3fffe8, $1ffffec,
$3ffffe2, $3ffffe3, $3ffffe4, $7ffffde, $7ffffdf, $3ffffe5, $fffff1, $1ffffed,
$7fff2, $1fffe3, $3ffffe6, $7ffffe0, $7ffffe1, $3ffffe7, $7ffffe2, $fffff2,
$1fffe4, $1fffe5, $3ffffe8, $3ffffe9, $ffffffd, $7ffffe3, $7ffffe4, $7ffffe5,
$fffec, $fffff3, $fffed, $1fffe6, $3fffe9, $1fffe7, $1fffe8, $7ffff3,
$3fffea, $3fffeb, $1ffffee, $1ffffef, $fffff4, $fffff5, $3ffffea, $7ffff4,
$3ffffeb, $7ffffe6, $3ffffec, $3ffffed, $7ffffe7, $7ffffe8, $7ffffe9, $7ffffea,
$7ffffeb, $ffffffe, $7ffffec, $7ffffed, $7ffffee, $7ffffef, $7fffff0, $3ffffee,
$3fffffff // EOS
);
HPackHuffmanCodeLength: array [0..256] of byte =(
13, 23, 28, 28, 28, 28, 28, 28, 28, 24, 30, 28, 28, 30, 28, 28,
28, 28, 28, 28, 28, 28, 30, 28, 28, 28, 28, 28, 28, 28, 28, 28,
6, 10, 10, 12, 13, 6, 8, 11, 10, 10, 8, 11, 8, 6, 6, 6,
5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 7, 8, 15, 6, 12, 10,
13, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 8, 7, 8, 13, 19, 13, 14, 6,
15, 5, 6, 5, 6, 5, 6, 6, 6, 5, 7, 7, 6, 6, 6, 5,
6, 7, 6, 5, 5, 6, 7, 7, 7, 7, 7, 15, 11, 14, 13, 28,
20, 22, 20, 20, 22, 22, 22, 23, 22, 23, 23, 23, 23, 23, 24, 23,
24, 24, 22, 23, 24, 23, 23, 23, 23, 21, 22, 23, 22, 23, 23, 24,
22, 21, 20, 22, 22, 23, 23, 21, 23, 22, 22, 24, 21, 22, 23, 23,
21, 21, 22, 21, 23, 22, 23, 23, 20, 22, 22, 22, 23, 22, 22, 23,
26, 26, 20, 19, 22, 23, 22, 25, 26, 26, 26, 27, 27, 26, 24, 25,
19, 21, 26, 27, 27, 26, 27, 24, 21, 21, 26, 26, 28, 27, 27, 27,
20, 24, 20, 21, 22, 21, 21, 23, 22, 22, 25, 25, 24, 24, 26, 23,
26, 27, 26, 26, 27, 27, 27, 27, 27, 28, 27, 27, 27, 27, 27, 26,
30 // EOS
);
HPACK_HUFFMAN_EOS: integer = 256;
HPACK_HEADER_ENTRY_OVERHEAD = 32;
type
THPackIndexType=(
eHPackINCREMENTAL, // Section 6.2.1. Literal Header Field with Incremental Indexing
eHPackNONE, // Section 6.2.2. Literal Header Field without Indexing
eHPackNEVER // Section 6.2.3. Literal Header Field never Indexed
);
THPackState =(
READ_HEADER_REPRESENTATION,
READ_MAX_DYNAMIC_TABLE_SIZE,
READ_INDEXED_HEADER,
READ_INDEXED_HEADER_NAME,
READ_LITERAL_HEADER_NAME_LENGTH_PREFIX,
READ_LITERAL_HEADER_NAME_LENGTH,
READ_LITERAL_HEADER_NAME,
SKIP_LITERAL_HEADER_NAME,
READ_LITERAL_HEADER_VALUE_LENGTH_PREFIX,
READ_LITERAL_HEADER_VALUE_LENGTH,
READ_LITERAL_HEADER_VALUE,
SKIP_LITERAL_HEADER_VALUE
);
implementation
end.

5
packages/hash/tests/README.txt Normal file
View File

@ -0,0 +1,5 @@
In order to run the HPACK testcase, you must download and unzip the HPACK testsuite:
https://github.com/http2jp/hpack-test-case
The test code expects to find it under the 'hpack-test-case-master' directory.

122
packages/hash/tests/fpcunithpack.lpi Normal file
View File

@ -0,0 +1,122 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="fpcunithpack"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="3">
<Item1 Name="Default" Default="True"/>
<Item2 Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="fpcunithpack"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\src"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</Item2>
<Item3 Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\src"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
</CompilerOptions>
</Item3>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="--all"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="FCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="fpcunithpack.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uhpacktest1.pas"/>
<IsPartOfProject Value="True"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\src"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

27
packages/hash/tests/fpcunithpack.lpr Normal file
View File

@ -0,0 +1,27 @@
program fpcunithpack;
{$mode objfpc}{$H+}
uses
Classes, consoletestrunner, uhpacktest1,sysutils;
type
{ TLazTestRunner }
TMyTestRunner = class(TTestRunner)
protected
// override the protected methods of TTestRunner to customize its behavior
end;
var
Application: TMyTestRunner;
begin
DefaultFormat:=fPlain;
DefaultRunAllTests:=True;
Application := TMyTestRunner.Create(nil);
Application.Initialize;
Application.Run;
Application.Free;
end.

889
packages/hash/tests/uhpacktest1.pas Normal file
View File

@ -0,0 +1,889 @@
(*
* Test program for pascal HPack for http2
*
* This test code uses sample headers from https://github.com/http2jp/hpack-test-case
* to test decoding of available samples and then reencode and decode again
* using plain only, indexing only, huffman only, and both at same time.
*
* The JSON parsing adds around a 15% speed penalty.
*
*)
unit uhpacktest1;
{$mode objfpc}{$H+}
{$DEFINE QUIET}
{$DEFINE FULL_QUIET}
{$IFDEF FULL_QUIET}
{$DEFINE QUIET}
{$ENDIF}
interface
uses
Classes, SysUtils, fpcunit, testregistry, uhpack, fpjson, jsonparser, jsonscanner;
type
{ THPackTestCaseCycle }
THPackTestCaseCycle= class(TTestCase)
private
HPDecoder: THPackDecoder;
HPIntfDecoderPlain: THPackDecoder;
HPIntfDecoderPlainIndexed: THPackDecoder;
HPIntfDecoderHuffman: THPackDecoder;
HPIntfDecoderHuffmanIndexed: THPackDecoder;
HPIntfEncoderPlain: THPackEncoder;
HPIntfEncoderPlainIndexed: THPackEncoder;
HPIntfEncoderHuffman: THPackEncoder;
HPIntfEncoderHuffmanIndexed: THPackEncoder;
SequenceCounter: integer;
StoryCounter: integer;
GroupsCounter: integer;
WireBytes: integer;
DecodedBytes: integer;
procedure TestThisSequence(const aGroup: integer; const aStory: integer; const aJSon: TJSONData);
procedure TestCaseStory(const aGroup: integer; const aStory: integer; const aJSon: TJSONData);
procedure RunSampleHeadersTest;
protected
function GetTestName: string; override;
published
procedure TestHookUp;
end;
{ THPackTestDecoder }
THPackTestDecoder= class(TTestCase)
private
HPDecoder: THPackDecoder;
DummyDecoder: THPackDecoder;
DummyEncoder: THPackEncoder;
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure VerifyIncompleteIndexRead;
procedure InvalidTableIndexZero;
procedure IndexShiftOverflow;
procedure DynamicTableSizeUpdate;
procedure DynamicTableSizeUpdateRequired;
procedure IllegalDynamicTableSizeUpdate;
procedure MaxDynamicTableSizeSignOverflow;
procedure ReduceMaxDynamicTableSize;
procedure TooLargeDynamicTableSizeUpdate;
procedure MissingDynamicTableSizeUpdate;
procedure LiteralWithIncrementalIndexingWithEmptyName;
procedure LiteralWithIncrementalIndexingCompleteEviction;
procedure LiteralWithIncrementalIndexingWithLargeName;
procedure LiteralWithIncrementalIndexingWithLargeValue;
procedure LiteralWithoutIndexingWithEmptyName;
procedure LiteralWithoutIndexingWithLargeName;
procedure LiteralWithoutIndexingWithLargeValue;
procedure LiteralNeverIndexedWithEmptyName;
procedure LiteralNeverIndexedWithLargeName;
procedure LiteralNeverIndexedWithLargeValue;
end;
implementation
function HexToBinString(aHex: RawByteString): RawByteString;
var
j: integer;
t: integer;
begin
t:=0;
for j := 1 to Length(aHex) do begin
if (aHex[j] in ['a'..'f','A'..'F','0'..'9']) then begin
inc(t);
if t<>j then begin
aHex[t]:=aHex[j];
end;
end else begin
if (aHex[j]<>#32) and (aHex[j]<>'-') then begin
Raise Exception.Create('Internal: Invalid hex format character');
end;
end;
end;
if t<>j then SetLength(aHex,t);
if t mod 2 <>0 then begin
Raise Exception.Create('Internal: Invalid hex chars count (odd)');
end;
SetLength(Result,Length(aHex) div 2);
HexToBin(@aHex[1],@Result[1],Length(Result));
end;
function BinStringToHex(const aBinString: string): string;
begin
Result:='';
SetLength(Result,Length(aBinString)*2);
BinToHex(@aBinString[1],@Result[1],Length(aBinString));
end;
function ErrorHeader(const aString: string): string;
begin
if Length(aString)<38 then begin
Result:='**'+aString+StringOfChar('*',38-Length(aString));
end else begin
Result:='**'+aString+'**';
end;
end;
{ THPackTestDecoder }
procedure THPackTestDecoder.SetUp;
begin
//Setup 2 dummy encoder & decoder to avoid multiple
//creation of internal tables. This should be fixed some
//way in the future.
DummyDecoder:=THPackDecoder.Create;
DummyEncoder:=THPackEncoder.Create;
inherited SetUp;
end;
procedure THPackTestDecoder.TearDown;
begin
FreeAndNil(DummyEncoder);
FreeAndNil(DummyDecoder);
inherited TearDown;
end;
procedure THPackTestDecoder.VerifyIncompleteIndexRead;
var
Data: TStringStream;
begin
Data:=TStringStream.Create(HexToBinString('FFF0'));
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(Data);
AssertEquals(Data.Size-Data.Position,1);
HPDecoder.Decode(Data);
AssertEquals(Data.Size-Data.Position,1);
finally
Data.Free;
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.InvalidTableIndexZero;
begin
HPDecoder:=THPackDecoder.Create;
try
try
HPDecoder.Decode(HexToBinString('80'));
FAIL('Exception missing');
except
on e: Exception do begin
if not (e is THPACKException) then begin
Raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.IndexShiftOverflow;
begin
HPDecoder:=THPackDecoder.Create;
try
try
HPDecoder.Decode(HexToBinString('FF8080808008'));
FAIL('Exception missing');
except
on e: Exception do begin
if not (e is THPACKException) then begin
Raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.DynamicTableSizeUpdate;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(HexToBinString('20'));
AssertEquals(0,HPDecoder.GetMaxHeaderTableSize);
HPDecoder.Decode(HexToBinString('3FE11F'));
assertEquals(4096, HPDecoder.GetMaxHeaderTableSize);
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.DynamicTableSizeUpdateRequired;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.SetMaxHeaderTableSize(32);
HPDecoder.Decode(HexToBinString('3F00'));
assertEquals(31, HPDecoder.GetMaxHeaderTableSize);
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.IllegalDynamicTableSizeUpdate;
begin
HPDecoder:=THPackDecoder.Create;
try
try
HPDecoder.Decode(HexToBinString('3FE21F'));
FAIL('Exception missing');
except
on e: Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.MaxDynamicTableSizeSignOverflow;
begin
HPDecoder:=THPackDecoder.Create;
try
try
HPDecoder.Decode(HexToBinString('3FE1FFFFFF07'));
except
on e: Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.ReduceMaxDynamicTableSize;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.SetMaxHeaderTableSize(0);
AssertEquals(0, HPDecoder.GetMaxHeaderTableSize());
HPDecoder.Decode(HexToBinString('2081'));
AssertEquals(0, HPDecoder.GetMaxHeaderTableSize());
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.TooLargeDynamicTableSizeUpdate;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.SetMaxHeaderTableSize(0);
AssertEquals(0, HPDecoder.GetMaxHeaderTableSize());
try
HPDecoder.Decode(HexToBinString('21'));
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.MissingDynamicTableSizeUpdate;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.SetMaxHeaderTableSize(0);
AssertEquals(0, HPDecoder.GetMaxHeaderTableSize());
try
HPDecoder.Decode(HexToBinString('81'));
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralWithIncrementalIndexingWithEmptyName;
begin
HPDecoder:=THPackDecoder.Create;
try
try
HPDecoder.Decode(HexToBinString('000005')+'value');
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralWithIncrementalIndexingCompleteEviction;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(HexToBinString('4004')+'name'+HexToBinString('05')+'value');
AssertFalse(HPDecoder.EndHeaderBlockTruncated);
HPDecoder.Decode(HexToBinString('417F811F')+StringOfChar('a',4096));
AssertFalse(HPDecoder.EndHeaderBlockTruncated);
HPDecoder.Decode(HexToBinString('4004')+'name'+ HexToBinString('05')+'value'+HexToBinString('BE'));
AssertEquals('name',HPDecoder.DecodedHeaders[0]^.HeaderName);
AssertEquals('value',HPDecoder.DecodedHeaders[0]^.HeaderValue);
AssertEquals('name',HPDecoder.DecodedHeaders[1]^.HeaderName);
AssertEquals('value',HPDecoder.DecodedHeaders[1]^.HeaderValue);
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralWithIncrementalIndexingWithLargeName;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(HexToBinString('417F811F')+StringOfChar('a',16384)+HexToBinString('00'));
// Verify header block is reported as truncated
AssertTrue(HPDecoder.EndHeaderBlockTruncated);
// Verify next header is inserted at index 62
HPDecoder.Decode(HexToBinString('4004')+'name'+ HexToBinString('05')+'value'+HexToBinString('BE'));
AssertEquals('name',HPDecoder.DecodedHeaders[0]^.HeaderName);
AssertEquals('value',HPDecoder.DecodedHeaders[0]^.HeaderValue);
AssertEquals('name',HPDecoder.DecodedHeaders[1]^.HeaderName);
AssertEquals('value',HPDecoder.DecodedHeaders[1]^.HeaderValue);
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralWithIncrementalIndexingWithLargeValue;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(HexToBinString('4004')+'name'+HexToBinString('7F813F')+StringOfChar('a',8192));
// Verify header block is reported as truncated
AssertTrue(HPDecoder.EndHeaderBlockTruncated);
// Verify next header is inserted at index 62
HPDecoder.Decode(HexToBinString('4004')+'name'+ HexToBinString('05')+'value'+HexToBinString('BE'));
AssertEquals('name',HPDecoder.DecodedHeaders[0]^.HeaderName);
AssertEquals('value',HPDecoder.DecodedHeaders[0]^.HeaderValue);
AssertEquals('name',HPDecoder.DecodedHeaders[1]^.HeaderName);
AssertEquals('value',HPDecoder.DecodedHeaders[1]^.HeaderValue);
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralWithoutIndexingWithEmptyName;
begin
HPDecoder:=THPackDecoder.Create;
try
try
HPDecoder.Decode(HexToBinString('000005')+'value');
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralWithoutIndexingWithLargeName;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(HexToBinString('007F817F')+StringOfChar('a',16384)+HexToBinString('00'));
// Verify header block is reported as truncated
AssertTrue(HPDecoder.EndHeaderBlockTruncated);
try
HPDecoder.Decode(HexToBinString('BE'));
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralWithoutIndexingWithLargeValue;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(HexToBinString('0004')+'name'+HexToBinString('7F813F')+StringOfChar('a',8192));
// Verify header block is reported as truncated
AssertTrue(HPDecoder.EndHeaderBlockTruncated);
try
HPDecoder.Decode(HexToBinString('BE'));
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralNeverIndexedWithEmptyName;
begin
HPDecoder:=THPackDecoder.Create;
try
try
HPDecoder.Decode(HexToBinString('100005')+'value');
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralNeverIndexedWithLargeName;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(HexToBinString('107F817F')+StringOfChar('a',16384)+HexToBinString('00'));
// Verify header block is reported as truncated
AssertTrue(HPDecoder.EndHeaderBlockTruncated);
try
HPDecoder.Decode(HexToBinString('BE'));
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestDecoder.LiteralNeverIndexedWithLargeValue;
begin
HPDecoder:=THPackDecoder.Create;
try
HPDecoder.Decode(HexToBinString('1004')+'name'+HexToBinString('7F813F')+StringOfChar('a',8192));
// Verify header block is reported as truncated
AssertTrue(HPDecoder.EndHeaderBlockTruncated);
try
HPDecoder.Decode(HexToBinString('BE'));
FAIL('Exception missing');
except
on E:Exception do begin
if not (e is THPACKException) then begin
raise;
end;
end;
end;
finally
FreeAndNil(HPDecoder);
end;
end;
procedure THPackTestCaseCycle.TestHookUp;
begin
RunSampleHeadersTest;
end;
function THPackTestCaseCycle.GetTestName: string;
begin
Result:='Sample headers cycled';
end;
procedure THPackTestCaseCycle.TestThisSequence(const aGroup: integer; const aStory: integer; const aJSon: TJSONData);
var
HeadersPath: TJSonData;
HexWire: string;
BinWire: RawByteString;
BinWire2: RawByteString;
Sequence: integer;
ExpectedHeaders: THPackHeaderTextList;
j, HeaderTableSize: integer;
lName,lValue: string;
TestPassed: integer;
function GetInteger(const aPath: string; const aOptional: Boolean=false): integer;
var
tmp: TJSonData;
begin
tmp:=aJSon.FindPath(aPath);
if Assigned(tmp) then begin
Result:=tmp.AsInteger;
end else begin
if not aOptional then begin
Raise Exception.Create('Missing '+aPath);
end else begin
Result:=-1;
end;
end;
end;
function GetString(const aPath: string): String;
var
tmp: TJSonData;
begin
tmp:=aJSon.FindPath(aPath);
if Assigned(tmp) then begin
Result:=tmp.AsString;
end else begin
Raise Exception.Create('Missing '+aPath);
end;
end;
procedure GetHeadersPair(const aHeaders: TJSonData; out aName,aValue: string);
var
Enumerator: TBaseJSONEnumerator;
begin
aName:='';
aValue:='';
if aHeaders.Count<>1 then begin
Raise Exception.Create('Unexpected headers count = '+aHeaders.AsJSON);
end;
Enumerator:=aHeaders.GetEnumerator;
try
if Assigned(Enumerator) then begin
if Enumerator.MoveNext then begin
aName:=Enumerator.Current.Key;
aValue:=Enumerator.Current.Value.AsString;
if Enumerator.MoveNext then begin
Raise Exception.Create('Too many header parts, expected A=B');
end;
Exit;
end;
end;
Raise Exception.Create('Unexpected reach');
finally
Enumerator.Free;
end;
end;
function EncodeHeaders(const aEncoder: THPackEncoder; const aHeadersList: THPackHeaderTextList): String;
var
OutStream: TStringStream;
j: integer;
begin
Result:='';
OutStream:=TStringStream.Create('');
try
for j := 0 to Pred(aHeadersList.Count) do begin
aEncoder.EncodeHeader(OutStream,aHeadersList[j]^.HeaderName,aHeadersList[j]^.HeaderValue,aHeadersList[j]^.IsSensitive);
end;
Result:=OutStream.DataString;
finally
FreeAndNil(OutStream);
end;
end;
begin
TestPassed:=0;
Sequence:=GetInteger('seqno');
HexWire:=GetString('wire');
HeaderTableSize:=GetInteger('header_table_size',true);
if HeaderTableSize=-1 then begin
HeaderTableSize:=HPACK_MAX_HEADER_TABLE_SIZE;
end;
if HeaderTableSize<>HPDecoder.GetMaxHeaderTableSize then begin
{$IFNDEF QUIET}
writeln('Max header table size changed from ',HPDecoder.GetMaxHeaderTableSize,' to ',HeaderTableSize);
{$ENDIF}
HPDecoder.SetMaxHeaderTableSize(HeaderTableSize);
end;
ExpectedHeaders:=THPackHeaderTextList.Create;
{$IFNDEF QUIET}
write('SEQ: ',aGroup,'-',aStory,'-',Sequence,#13);
{$ENDIF}
try
HeadersPath:=aJSon.FindPath('headers');
if not Assigned(HeadersPath) then begin
Raise Exception.Create('Missing headers');
end;
for j := 0 to Pred(HeadersPath.Count) do begin
GetHeadersPair(HeadersPath.Items[j],lName,lValue);
ExpectedHeaders.Add(lName,lValue);
end;
BinWire:=HexToBinString(HexWire);
HPDecoder.Decode(BinWire);
if HPDecoder.EndHeaderBlockTruncated then begin
raise Exception.Create('FAIL EndHeaderBlock');
end;
if HPDecoder.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
raise Exception.Create('Expected headers different than decoded ones.');
end;
TestPassed:=1;
// Now reencode with our engine and decode again, result must be the same.
BinWire2:=EncodeHeaders(HPIntfEncoderPlain,ExpectedHeaders);
HPIntfDecoderPlain.Decode(BinWire2);
if HPIntfDecoderPlain.EndHeaderBlockTruncated then begin
raise Exception.Create('FAIL EndHeaderBlock REcoded (Plain).');
end;
if HPIntfDecoderPlain.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
raise Exception.Create('Expected headers different than REcoded ones (Plain).');
end;
TestPassed:=2;
// Now reencode with our engine and decode again, result must be the same.
BinWire2:=EncodeHeaders(HPIntfEncoderPlainIndexed,ExpectedHeaders);
HPIntfDecoderPlainIndexed.Decode(BinWire2);
if HPIntfDecoderPlainIndexed.EndHeaderBlockTruncated then begin
raise Exception.Create('FAIL EndHeaderBlock REcoded (Plain & Indexed).');
end;
if HPIntfDecoderPlainIndexed.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
raise Exception.Create('Expected headers different than REcoded ones (Plain & Indexed).');
end;
TestPassed:=3;
// Now reencode with our engine using huffman and decode again, result must be the same.
BinWire2:=EncodeHeaders(HPIntfEncoderHuffman,ExpectedHeaders);
HPIntfDecoderHuffman.Decode(BinWire2);
if HPIntfDecoderHuffman.EndHeaderBlockTruncated then begin
raise Exception.Create('FAIL EndHeaderBlock REcoded (Huffman).');
end;
if HPIntfDecoderHuffman.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
raise Exception.Create('Expected headers different than REcoded ones (Huffman).');
end;
TestPassed:=4;
// Now reencode with our engine using huffman & indexed and decode again, result must be the same.
BinWire2:=EncodeHeaders(HPIntfEncoderHuffmanIndexed,ExpectedHeaders);
HPIntfDecoderHuffmanIndexed.Decode(BinWire2);
if HPIntfDecoderHuffmanIndexed.EndHeaderBlockTruncated then begin
raise Exception.Create('FAIL EndHeaderBlock REcoded (Huffman & Indexed).');
end;
if HPIntfDecoderHuffmanIndexed.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
raise Exception.Create('Expected headers different than REcoded ones (Huffman & Indexed).');
end;
inc(DecodedBytes,Length(HPIntfDecoderHuffmanIndexed.DecodedHeaders.Text));
inc(WireBytes,Length(BinWire2));
TestPassed:=1000;
finally
if TestPassed<1000 then begin
{$IFNDEF FULL_QUIET}
writeln(StdErr,ErrorHeader('TEST FAIL - Section passed '+inttostr(TestPassed)));
writeln(StdErr,ErrorHeader('Expected headers'));
writeln(StdErr,ExpectedHeaders.Text);
writeln(StdErr,ErrorHeader('Got headers'));
case TestPassed of
0: writeln(StdErr,HPDecoder.DecodedHeaders.Text);
1: writeln(StdErr,HPIntfDecoderPlain.DecodedHeaders.Text);
2: writeln(StdErr,HPIntfDecoderPlainIndexed.DecodedHeaders.Text);
3: writeln(StdErr,HPIntfDecoderHuffman.DecodedHeaders.Text);
4: writeln(StdErr,HPIntfDecoderHuffmanIndexed.DecodedHeaders.Text);
else
writeln(StdErr,'Unknown decoder in use.');
end;
writeln(StdErr,ErrorHeader('Location'));
writeln(StdErr,'SEQ: ',aGroup,'-',aStory,'-',Sequence);
{$ENDIF}
end else begin
inc(SequenceCounter);
end;
ExpectedHeaders.Free;
end;
end;
procedure THPackTestCaseCycle.TestCaseStory(const aGroup: integer; const aStory: integer;
const aJSon: TJSONData);
var
JSonData: TJSONData;
CaseData: TJSonData;
CaseCounter,Cases: integer;
TestPass: Boolean;
begin
TestPass:=false;
JSonData:=ajSon.FindPath('description');
if Assigned(JSonData) then begin
{$IFNDEF QUIET}
writeln(JSonData.AsString);
{$ENDIF}
end;
JSonData:=ajSon.FindPath('cases');
if Assigned(JSonData) then begin
Cases:=JSonData.Count;
{$IFNDEF QUIET}
writeln('Sequences in case ',Cases);
{$ENDIF}
HPDecoder:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
// This encoders, decoders are for cycle compress, decompress tests.
HPIntfDecoderPlain:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
HPIntfDecoderPlainIndexed:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
HPIntfDecoderHuffman:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
HPIntfDecoderHuffmanIndexed:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
HPIntfEncoderPlain:=THPackEncoder.Create(HPACK_MAX_HEADER_TABLE_SIZE,false,false,true);
HPIntfEncoderPlainIndexed:=THPackEncoder.Create(HPACK_MAX_HEADER_TABLE_SIZE,true,false,true);
HPIntfEncoderHuffman:=THPackEncoder.Create(HPACK_MAX_HEADER_TABLE_SIZE,false,true,false);
HPIntfEncoderHuffmanIndexed:=THPackEncoder.Create(HPACK_MAX_HEADER_TABLE_SIZE,true,true,false);
try
CaseCounter:=0;
while CaseCounter<Cases do begin
CaseData:=JSonData.Items[CaseCounter];
TestThisSequence(aGroup,aStory,CaseData);
inc(CaseCounter);
end;
TestPass:=true;
finally
if not TestPass then begin
{$IFNDEF FULL_QUIET}
writeln(StdErr,ErrorHeader('Sequence failed'));
writeln(StdErr,'Seq expected: ',CaseCounter);
{$ENDIF}
end else begin
inc(StoryCounter);
end;
FreeAndNil(HPDecoder);
FreeAndNil(HPIntfDecoderPlain);
FreeAndNil(HPIntfDecoderPlainIndexed);
FreeAndNil(HPIntfDecoderHuffman);
FreeAndNil(HPIntfDecoderHuffmanIndexed);
FreeAndNil(HPIntfEncoderPlain);
FreeAndNil(HPIntfEncoderPlainIndexed);
FreeAndNil(HPIntfEncoderHuffman);
FreeAndNil(HPIntfEncoderHuffmanIndexed);
end;
end;
end;
procedure THPackTestCaseCycle.RunSampleHeadersTest;
const
TestCaseBase: string ='hpack-test-case-master'+PathDelim;
TestCaseGroups: array [0..10] of string =
(
'go-hpack',
'haskell-http2-linear',
'haskell-http2-linear-huffman',
'haskell-http2-naive',
'haskell-http2-naive-huffman',
'haskell-http2-static',
'haskell-http2-static-huffman',
'nghttp2',
'nghttp2-16384-4096',
'nghttp2-change-table-size',
'node-http2-hpack'
);
TestCaseStoryMask: string ='story_%.2d.json';
var
TheFile: string;
JSonParser: TJSONParser;
JSonData: TJSonData;
MyStream: TFileStream;
j: integer;
FolderCounter: integer;
FailCounter: Integer=0;
ElapsedTime: QWord;
begin
SequenceCounter:=0;
StoryCounter:=0;
GroupsCounter:=0;
WireBytes:=0;
DecodedBytes:=0;
ElapsedTime:=GetTickCount64;
FolderCounter:=0;
while FolderCounter<=High(TestCaseGroups) do begin
j:=0;
while true do begin
TheFile:=IncludeTrailingPathDelimiter(TestCaseBase)+IncludeTrailingPathDelimiter(TestCaseGroups[FolderCounter])+format(TestCaseStoryMask,[j]);
if not FileExists(TheFile) then begin
break;
end;
MyStream:=TFileStream.Create(TheFile,fmOpenRead or fmShareDenyWrite);
JSonParser:=TJSONParser.Create(MyStream,[]);
JSonData:=JSonParser.Parse;
{$IFNDEF QUIET}
writeln('Check story ',Thefile);
{$ENDIF}
try
try
TestCaseStory(FolderCounter,j,JSonData);
finally
FreeAndNil(JSonData);
FreeAndNil(JSonParser);
FreeAndNil(MyStream);
end;
except
on e: exception do begin
{$IFNDEF FULL_QUIET}
writeln(StdErr,ErrorHeader('Story failed'));
writeln(StdErr,TheFile);
writeln(StdErr,ErrorHeader('Fail condition'));
writeln(StdErr,e.Message);
inc(FailCounter);
{$ENDIF}
break;
end;
end;
inc(j);
end;
inc(GroupsCounter);
inc(FolderCounter);
end;
ElapsedTime:=GetTickCount64-ElapsedTime;
{$IFNDEF QUIET}
writeln;
writeln;
{$ENDIF}
{$IFNDEF FULL_QUIET}
writeln(ErrorHeader('Summary'));
writeln('Groups: ',GroupsCounter);
writeln('Stories: ',StoryCounter);
writeln('Sequences: ',SequenceCounter);
writeln('Time: ',ElapsedTime/1000:1:3,' seconds.');
writeln('Wire bytes / Decoded bytes: ',WireBytes,' / ',DecodedBytes);
writeln('Compression ratio: ',WireBytes/DecodedBytes:1:3);
writeln('Failed tests: ',FailCounter);
{$ENDIF}
if FailCounter>0 then begin
Fail('Failed cycle tests: %d',[FailCounter]);
end;
end;
initialization
RegisterTest(THPackTestCaseCycle);
RegisterTest(THPackTestDecoder);
end.