fix(fpc): corrige hash de headers com range e overflow checking

.github/workflows/tests.yml

@@ -33,6 +33,11 @@ jobs:
     - name: Run FPC URL decoding regression
       run: sh tests/fpc-url-decoding/run-url-decoding-test.sh
 
+    - name: Run FPC header hash regression with range and overflow checks
+      run: |
+        sh tests/fpc-header-hash/run-header-hash-test.sh
+        sh tests/fpc-header-hash/run-header-hash-test.sh -dHORSE_PROVIDER_EPOLL
+
     # Console.dpr uses Delphi/DUnitX; validate it with run_delphi_tests.ps1.
     # The Linux job runs the standalone FPC suites instead.
     - name: Run FPC stream factory regression
@@ -70,6 +75,11 @@ jobs:
         sudo "$compiler_dir/samplecfg" "$compiler_dir" /etc
         echo "/opt/fpc/bin" >> "$GITHUB_PATH"
 
+    - name: Run FPC trunk header hash regression with range and overflow checks
+      run: |
+        sh tests/fpc-header-hash/run-header-hash-test.sh
+        sh tests/fpc-header-hash/run-header-hash-test.sh -dHORSE_PROVIDER_EPOLL
+
     - name: Compile keep-alive regression server
       run: |
         mkdir -p /tmp/horse-fpc-units /tmp/horse-fpc-bin

src/Horse.Core.Param.Header.pas

@@ -90,7 +90,8 @@ function THorseHeaderComparer.GetHashCode(CONST_GENERIC Value: string): DWord;
     LChar := Value[I];
     if LChar in ['A'..'Z'] then
       Inc(LChar, 32);
-    Result := ((Result shl 5) + Result) + Ord(LChar);
+    // DJB2 wraps modulo 2^32; keep the intermediate and conversion in range.
+    Result := DWord((QWord(Result) * 33 + Ord(LChar)) and QWord($FFFFFFFF));
   end;
 end;
 {$ENDIF}

tests/fpc-header-hash/HeaderHashCheck.dpr

@@ -0,0 +1,148 @@
+program HeaderHashCheck;
+
+{$MODE DELPHI}{$H+}
+{$IFOPT R-}{$FATAL Range checking must be enabled}{$ENDIF}
+{$IFOPT Q-}{$FATAL Overflow checking must be enabled}{$ENDIF}
+
+uses
+  SysUtils, Generics.Defaults, HTTPDefs,
+  Horse.Core.Param, Horse.Core.Param.Header;
+
+type
+  THashCase = record
+    Name: string;
+    Expected: DWord;
+  end;
+  TTestProc = procedure;
+
+const
+  // Independent DJB2 modulo-2^32 vectors, including values above MaxInt.
+  Cases: array[0..6] of THashCase = (
+    (Name: ''; Expected: 5381),
+    (Name: 'Host'; Expected: 2090335843),
+    (Name: 'Content-Type'; Expected: 4200957359),
+    (Name: 'Authorization'; Expected: 1595898102),
+    (Name: 'X-Custom-Header'; Expected: 4148212891),
+    (Name: 'Accept-Encoding'; Expected: 1116246921),
+    (Name: 'X-Trace-Id'; Expected: 3544274515)
+  );
+
+var
+  Checks, Groups, Failures: Integer;
+
+procedure Check(Condition: Boolean; const MessageText: string);
+begin
+  Inc(Checks);
+  if not Condition then
+    raise Exception.Create(MessageText);
+end;
+
+procedure RunTest(const Name: string; TestProc: TTestProc);
+begin
+  Inc(Groups);
+  try
+    TestProc;
+    Writeln('PASS ', Name);
+  except
+    on E: Exception do
+    begin
+      Inc(Failures);
+      Writeln('FAIL ', Name, ': ', E.ClassName, ': ', E.Message);
+    end;
+  end;
+end;
+
+procedure TestHashVectors;
+var
+  Comparer: IEqualityComparer<string>;
+  I: Integer;
+begin
+  Comparer := THorseHeaderComparer.Create;
+  for I := Low(Cases) to High(Cases) do
+  begin
+    Check(Comparer.GetHashCode(Cases[I].Name) = Cases[I].Expected,
+      'Unexpected hash for ' + Cases[I].Name);
+    Check(Comparer.GetHashCode(UpperCase(Cases[I].Name)) = Cases[I].Expected,
+      'Uppercase hash mismatch for ' + Cases[I].Name);
+    Check(Comparer.GetHashCode(LowerCase(Cases[I].Name)) = Cases[I].Expected,
+      'Lowercase hash mismatch for ' + Cases[I].Name);
+    Check(Comparer.Equals(Cases[I].Name, UpperCase(Cases[I].Name)),
+      'Comparer equality mismatch for ' + Cases[I].Name);
+  end;
+end;
+
+procedure TestLongHeader;
+var
+  Comparer: IEqualityComparer<string>;
+  Name: string;
+begin
+  Comparer := THorseHeaderComparer.Create;
+  Name := StringOfChar('X', 4096);
+  Check(Comparer.GetHashCode(Name) = 2600047877, 'Long header hash changed');
+  Check(Comparer.GetHashCode(LowerCase(Name)) = 2600047877,
+    'Long lowercase header hash changed');
+end;
+
+procedure TestDictionaryOperations;
+var
+  Comparer: IEqualityComparer<string>;
+  Headers: THorseList;
+  I: Integer;
+  Value: string;
+begin
+  Comparer := THorseHeaderComparer.Create;
+  Headers := THorseList.Create(Comparer);
+  try
+    for I := Low(Cases) to High(Cases) do
+      Headers.AddOrSetValue(Cases[I].Name, IntToStr(I));
+    Check(Headers.Count = Length(Cases), 'Header insertion count');
+    for I := Low(Cases) to High(Cases) do
+    begin
+      Check(Headers.TryGetValue(LowerCase(Cases[I].Name), Value),
+        'Lowercase header lookup');
+      Check(Value = IntToStr(I), 'Incorrect header value');
+      Headers.AddOrSetValue(UpperCase(Cases[I].Name), 'updated');
+      Check(Headers[Cases[I].Name] = 'updated', 'Case-insensitive update');
+    end;
+    Check(Headers.Count = Length(Cases), 'Updates must not duplicate keys');
+    for I := Low(Cases) to High(Cases) do
+    begin
+      Headers.Remove(LowerCase(Cases[I].Name));
+      Check(not Headers.ContainsKey(UpperCase(Cases[I].Name)), 'Header removal');
+    end;
+    Check(Headers.Count = 0, 'Dictionary must be empty after removal');
+  finally
+    Headers.Free;
+  end;
+end;
+
+procedure TestRequestHeaderExtraction;
+var
+  Request: TRequest;
+  Headers: THorseList;
+begin
+  Request := TRequest.Create;
+  try
+    Request.ContentType := 'application/json';
+    Request.Host := 'localhost';
+    Headers := THorseCoreParamHeader.GetHeaders(Request);
+    try
+      Check(Headers['content-type'] = 'application/json', 'Content-Type extraction');
+      Check(Headers['HOST'] = 'localhost', 'Host extraction');
+    finally
+      Headers.Free;
+    end;
+  finally
+    Request.Free;
+  end;
+end;
+
+begin
+  RunTest('known hashes and ASCII case equivalence', @TestHashVectors);
+  RunTest('4096-character header', @TestLongHeader);
+  RunTest('header dictionary insert/lookup/update/remove', @TestDictionaryOperations);
+  RunTest('request header extraction', @TestRequestHeaderExtraction);
+  Writeln('Groups: ', Groups, '; checks: ', Checks, '; failures: ', Failures);
+  if Failures <> 0 then
+    Halt(1);
+end.

tests/fpc-header-hash/README.md

@@ -0,0 +1,21 @@
+# Regressão do hash de headers no FPC
+
+Na raiz do repositório, em Linux com FPC/FCL:
+
+```sh
+sh tests/fpc-header-hash/run-header-hash-test.sh
+sh tests/fpc-header-hash/run-header-hash-test.sh -dHORSE_PROVIDER_EPOLL
+```
+
+O script recompila o teste **e as units do Horse** (`-B`) com range checking
+(`-Cr`) e overflow checking (`-Co`) ativados. O programa recusa compilação sem
+essas verificações. `heaptrc` (`-gh`) detecta blocos não liberados; falhas de
+compilação, verificações ou memória retornam código diferente de zero.
+
+Os testes verificam hashes DJB2 conhecidos módulo 2³², equivalência entre
+maiúsculas/minúsculas ASCII, chave vazia e chave longa de 4096 caracteres,
+operações do dicionário de headers e extração de headers de uma requisição FPC.
+Eles exercitam as classes diretamente, sem abrir um servidor HTTP.
+
+`HORSE_TEST_SOURCE` pode apontar para um diretório com uma versão anterior da
+unit, permitindo reproduzir a falha sem modificar os fontes do checkout.

tests/fpc-header-hash/run-header-hash-test.sh

@@ -0,0 +1,29 @@
+#!/bin/sh
+set -eu
+
+test_dir=$(CDPATH= cd -- "$(dirname -- "$0")" && pwd)
+source_dir=${HORSE_TEST_SOURCE:-"$test_dir/../../src"}
+output_dir=$(mktemp -d /tmp/horse-header-hash.XXXXXX)
+
+cd "$test_dir"
+# Rebuild Horse too: checks on the test program alone do not exercise the bug.
+fpc -B -Mdelphi -Sh -gh -gl "$@" -Cr -Co \
+  -Fu"$source_dir" -Fu../../src -Fi../../src \
+  -FU"$output_dir" -FE"$output_dir" HeaderHashCheck.dpr \
+  >"$output_dir/build.log" 2>&1 || {
+    cat "$output_dir/build.log"
+    exit 1
+  }
+
+set +e
+run_output=$("$output_dir/HeaderHashCheck" 2>&1)
+run_status=$?
+set -e
+printf '%s\n' "$run_output"
+if [ "$run_status" -ne 0 ]; then
+  exit "$run_status"
+fi
+if printf '%s\n' "$run_output" | grep -Eq '[1-9][0-9]* unfreed memory blocks'; then
+  echo 'Header hash regression: FPC reported unfreed memory.' >&2
+  exit 1
+fi