Corrige latência do keep-alive no FPC e prepara a versão 3.3.4

.github/workflows/tests.yml

@@ -11,7 +11,7 @@ jobs:
     runs-on: ubuntu-latest
 
     steps:
-    - uses: actions/checkout@v2
+    - uses: actions/checkout@v4
 
     - name: Install Free Pascal Compiler (FPC)
       run: |
@@ -37,4 +37,52 @@ jobs:
     - name: Run Console Tests
       run: |
         cd tests
-        ./Console -exit:Continue
+        ./Console -exit:Continue
+
+  fpc-trunk-keepalive:
+    runs-on: ubuntu-latest
+    timeout-minutes: 20
+    env:
+      # Known FPC 3.3.1 revision where the latency regression was reproduced.
+      FPC_TRUNK_REF: a92f381365576b6b64be9eb9b8a2db5b4609d8a5
+
+    steps:
+    - uses: actions/checkout@v4
+
+    - name: Install FPC bootstrap compiler
+      run: |
+        sudo apt-get update
+        sudo apt-get install -y fpc make
+
+    - name: Build FPC trunk
+      run: |
+        git init /tmp/fpc-source
+        git -C /tmp/fpc-source remote add origin https://gitlab.com/freepascal.org/fpc/source.git
+        git -C /tmp/fpc-source fetch --depth 1 origin "$FPC_TRUNK_REF"
+        git -C /tmp/fpc-source checkout --detach FETCH_HEAD
+        make -C /tmp/fpc-source -j2 all OPT="-O2"
+        sudo make -C /tmp/fpc-source install INSTALL_PREFIX=/opt/fpc
+        compiler_path=$(find /opt/fpc/lib/fpc -mindepth 2 -maxdepth 2 -name ppcx64 | head -1)
+        compiler_dir=$(dirname "$compiler_path")
+        sudo ln -sf "$compiler_path" /opt/fpc/bin/ppcx64
+        sudo "$compiler_dir/samplecfg" "$compiler_dir" /etc
+        echo "/opt/fpc/bin" >> "$GITHUB_PATH"
+
+    - name: Compile keep-alive regression server
+      run: |
+        mkdir -p /tmp/horse-fpc-units /tmp/horse-fpc-bin
+        cd tests/src
+        fpc -B -Mdelphi -Sh \
+          -FE/tmp/horse-fpc-bin \
+          -FU/tmp/horse-fpc-units \
+          -Fu../../src \
+          -dHORSE_CONSOLE \
+          FPCHttpKeepAliveServer.dpr
+
+    - name: Run keep-alive latency regression
+      run: |
+        /tmp/horse-fpc-bin/FPCHttpKeepAliveServer &
+        server_pid=$!
+        trap 'kill "$server_pid" 2>/dev/null || true' EXIT
+        sleep 1
+        python3 tests/fpc_keepalive_regression.py

boss.json

@@ -1,7 +1,7 @@
 {
   "name": "horse",
   "description": "Express-inspired web framework for Delphi and Lazarus",
-  "version": "3.3.0",
+  "version": "3.3.4",
   "homepage": "https://github.com/HashLoad/horse",
   "license": "MIT",
   "mainsrc": "src/",

src/Horse.Constants.pas

@@ -10,7 +10,7 @@ interface
   DEFAULT_HOST = '0.0.0.0';
   DEFAULT_PORT = 9000;
   START_RUNNING = 'Server is running on %s:%d';
-  HORSE_VERSION = '3.3.3';
+  HORSE_VERSION = '3.3.4';
 
 implementation
 

src/Horse.Provider.FPC.HTTPApplication.pas

@@ -42,6 +42,7 @@   THorseProvider = class(THorseProviderAbstract)
     class procedure DoGetModule(Sender: TObject; ARequest: TRequest; var ModuleClass: TCustomHTTPModuleClass);
     {$IF FPC_FULLVERSION >= 30301}
     class procedure EnableServerKeepAlive(const AApplication: THTTPApplication);
+    class procedure ConfigureServerTransport(const AApplication: THTTPApplication);
     {$ENDIF}
   public
     class property Host: string read GetHost write SetHost;
@@ -71,7 +72,8 @@ implementation
 uses
   Horse.WebModule,
   Horse.Response
-  {$IF FPC_FULLVERSION >= 30301}, custhttpapp{$ENDIF};
+  {$IF FPC_FULLVERSION >= 30301}, custhttpapp, fphttpserver, ssockets{$ENDIF}
+  {$IF DEFINED(FPC) AND DEFINED(UNIX)}, Sockets{$ENDIF};
 
 {$IF FPC_FULLVERSION >= 30301}
 const
@@ -90,6 +92,61 @@ implementation
   THorseHTTPServerHandlerAccess = class(custhttpapp.TFPHTTPServerHandler);
   THorseEmbeddedServerAccess = class(custhttpapp.TEmbeddedHttpServer);
 
+  {$IFDEF UNIX}
+  THorseNoDelaySocketHandler = class(TSocketHandler)
+  public
+    function Accept: Boolean; override;
+  end;
+
+  THorseSocketHandlerFactory = class
+  private
+    FPrevious: TGetSocketHandlerEvent;
+  public
+    procedure CreateHandler(Sender: TObject; const UseSSL: Boolean;
+      out AHandler: TSocketHandler);
+    property Previous: TGetSocketHandlerEvent read FPrevious write FPrevious;
+  end;
+  {$ENDIF}
+
+var
+  {$IFDEF UNIX}
+  GSocketHandlerFactory: THorseSocketHandlerFactory;
+  GConfiguredSocketServer: TEmbeddedHttpServer;
+  {$ENDIF}
+
+{$IFDEF UNIX}
+function THorseNoDelaySocketHandler.Accept: Boolean;
+var
+  LEnabled: LongInt;
+begin
+  Result := inherited Accept;
+  if not Result then
+    Exit;
+
+  LEnabled := 1;
+  { fphttpserver writes the response headers and body separately. On Linux,
+    leaving Nagle enabled makes the second small write interact with delayed
+    ACK and adds about 40-44 ms to every reused HTTP/1.1 connection. Accept is
+    the first handler callback invoked after TSocketStream associates the raw
+    socket, so the descriptor is valid here. }
+  fpSetSockOpt(Socket.Handle, IPPROTO_TCP, TCP_NODELAY, @LEnabled,
+    SizeOf(LEnabled));
+end;
+
+procedure THorseSocketHandlerFactory.CreateHandler(Sender: TObject;
+  const UseSSL: Boolean; out AHandler: TSocketHandler);
+begin
+  AHandler := nil;
+  if Assigned(FPrevious) then
+    FPrevious(Sender, UseSSL, AHandler);
+
+  { Do not replace custom or TLS handlers. The default non-TLS handler is the
+    only path affected by the two-small-writes delayed-ACK regression. }
+  if (AHandler = nil) and not UseSSL then
+    AHandler := THorseNoDelaySocketHandler.Create;
+end;
+{$ENDIF}
+
 class procedure THorseProvider.EnableServerKeepAlive(const AApplication: THTTPApplication);
 var
   LHandler: TFPHTTPServerHandler;
@@ -120,6 +177,35 @@ class procedure THorseProvider.EnableServerKeepAlive(const AApplication: THTTPAp
       THorseEmbeddedServerAccess(LServer).KeepConnectionTimeout := DEFAULT_KEEPALIVE_TIMEOUT_MS;
   end;
 end;
+
+class procedure THorseProvider.ConfigureServerTransport(
+  const AApplication: THTTPApplication);
+{$IFDEF UNIX}
+var
+  LHandler: TFPHTTPServerHandler;
+  LServer: TEmbeddedHttpServer;
+{$ENDIF}
+begin
+  {$IFDEF UNIX}
+  LHandler := AApplication.HTTPHandler;
+  if LHandler = nil then
+    Exit;
+  LServer := THorseHTTPServerHandlerAccess(LHandler).HTTPServer;
+  if (LServer = nil) or (LServer = GConfiguredSocketServer) then
+    Exit;
+
+  if GSocketHandlerFactory = nil then
+    GSocketHandlerFactory := THorseSocketHandlerFactory.Create;
+  { Do not use OnAllowConnect here. FPC 3.3.1 stores that callback but its
+    DoOnAllowConnect implementation does not dispatch it. A socket-handler
+    factory is both effective and early enough to configure accepted sockets. }
+  GSocketHandlerFactory.Previous :=
+    THorseEmbeddedServerAccess(LServer).OnGetSocketHandler;
+  THorseEmbeddedServerAccess(LServer).OnGetSocketHandler :=
+    GSocketHandlerFactory.CreateHandler;
+  GConfiguredSocketServer := LServer;
+  {$ENDIF}
+end;
 {$ENDIF}
 
 class function THorseProvider.GetDefaultHTTPApplication: THTTPApplication;
@@ -198,6 +284,7 @@ class procedure THorseProvider.InternalListen;
     and before Run, while the server is fully configured but not yet
     accepting. }
   EnableServerKeepAlive(LHTTPApplication);
+  ConfigureServerTransport(LHTTPApplication);
   {$ENDIF}
   FRunning := True;
   DoOnListen;

src/Horse.Provider.HttpSys.pas

@@ -1048,10 +1048,18 @@ function THttpSysRawRequest.GetURL: string;
 end;
 
 function THttpSysRawRequest.GetPathInfo: string;
-begin
-  if FRequest.CookedUrl.pAbsPath <> nil then
-    SetString(Result, FRequest.CookedUrl.pAbsPath, FRequest.CookedUrl.AbsPathLength div SizeOf(WideChar))
-  else
+var
+  LQueryPos: Integer;
+begin
+  { Keep the escaped path until Horse splits it into route segments. The
+    HTTP.sys cooked URL decodes %2F to '/', which would turn an encoded slash
+    inside a parameter into a path separator and produce a false 404. IOCP and
+    Epoll expose the raw path for the same reason. }
+  Result := GetURL;
+  LQueryPos := Pos('?', Result);
+  if LQueryPos > 0 then
+    SetLength(Result, LQueryPos - 1);
+  if Result = '' then
     Result := '/';
 end;
 

src/Horse.Response.pas

@@ -285,9 +285,11 @@ implementation
   Horse.Core,
   Horse.Exception.Interrupted,
   Horse.Core.MemoryBufferPool
-  {$IF DEFINED(HORSE_PROVIDER_EPOLL) or DEFINED(HORSE_PROVIDER_IOCP) or DEFINED(HORSE_PROVIDER_HTTPSYS)}
+  {$IF NOT DEFINED(FPC)}
+  {$IF NOT DEFINED(HORSE_APACHE) and NOT DEFINED(HORSE_ISAPI) and NOT DEFINED(HORSE_CGI) and NOT DEFINED(HORSE_FCGI)}
   , Horse.Provider.RawAdapters
   {$IFEND}
+  {$IFEND}
   {$IF DEFINED(FPC)}
   , fphttpserver
   , ssockets
@@ -508,10 +510,12 @@ function THorseResponse.GetContentStream: TStream;
   Result := FCSContentStream;
   if (Result = nil) and Assigned(FCSRawWebResponse) then
   begin
-    {$IF NOT DEFINED(FPC) and (DEFINED(HORSE_PROVIDER_EPOLL) or DEFINED(HORSE_PROVIDER_IOCP) or DEFINED(HORSE_PROVIDER_HTTPSYS))}
+    {$IF NOT DEFINED(FPC)}
+    {$IF NOT DEFINED(HORSE_APACHE) and NOT DEFINED(HORSE_ISAPI) and NOT DEFINED(HORSE_CGI) and NOT DEFINED(HORSE_FCGI)}
     if FCSRawWebResponse is TInterfacedWebResponse then
       Result := TInterfacedWebResponse(FCSRawWebResponse).ContentStream
     else
+    {$ENDIF}
     {$ENDIF}
       Result := FCSRawWebResponse.ContentStream;
   end;

tests/fpc_keepalive_regression.py

@@ -0,0 +1,74 @@
+#!/usr/bin/env python3
+"""FPC 3.3.1+ keep-alive latency regression test for the default provider."""
+
+import socket
+import statistics
+import time
+
+HOST = "127.0.0.1"
+PORT = 9901
+REQUEST_COUNT = 30
+MAX_MEDIAN_MS = 25.0  # Half of FPC's 50 ms keep-alive idle polling interval.
+REQUEST = (
+    b"GET /ping HTTP/1.1\r\n"
+    b"Host: localhost\r\n"
+    b"Connection: keep-alive\r\n\r\n"
+)
+
+
+def read_response(sock: socket.socket, buffered: bytes) -> tuple[bytes, bytes]:
+    while b"\r\n\r\n" not in buffered:
+        chunk = sock.recv(65536)
+        if not chunk:
+            raise RuntimeError("peer closed before the response headers")
+        buffered += chunk
+
+    raw_headers, buffered = buffered.split(b"\r\n\r\n", 1)
+    headers = {}
+    for line in raw_headers.split(b"\r\n")[1:]:
+        key, value = line.split(b":", 1)
+        headers[key.lower()] = value.strip()
+
+    content_length = int(headers.get(b"content-length", b"0"))
+    while len(buffered) < content_length:
+        chunk = sock.recv(65536)
+        if not chunk:
+            raise RuntimeError("peer closed before the response body")
+        buffered += chunk
+
+    body = buffered[:content_length]
+    return body, buffered[content_length:]
+
+
+def main() -> None:
+    samples = []
+    buffered = b""
+    with socket.create_connection((HOST, PORT), timeout=5) as sock:
+        sock.settimeout(5)
+        connection = sock.getsockname()
+
+        for _ in range(REQUEST_COUNT):
+            started = time.perf_counter_ns()
+            sock.sendall(REQUEST)
+            body, buffered = read_response(sock, buffered)
+            samples.append((time.perf_counter_ns() - started) / 1_000_000)
+            if body != b"pong":
+                raise RuntimeError(f"unexpected response body: {body!r}")
+
+        if connection != sock.getsockname():
+            raise RuntimeError("the client socket changed during the test")
+
+    # Ignore connection establishment/first-request cost and use the median so
+    # isolated scheduler jitter cannot fail the regression test.
+    steady_state = samples[1:]
+    median_ms = statistics.median(steady_state)
+    p95_ms = sorted(steady_state)[int(len(steady_state) * 0.95) - 1]
+    print(f"same socket: yes; median={median_ms:.3f} ms; p95={p95_ms:.3f} ms")
+    if median_ms >= MAX_MEDIAN_MS:
+        raise RuntimeError(
+            f"keep-alive median {median_ms:.3f} ms is still near the FPC 50 ms tick"
+        )
+
+
+if __name__ == "__main__":
+    main()

tests/run_compile_matrix.ps1

@@ -156,14 +156,23 @@ if ($HasDocker) {
             $FpcFlags += "-d$Def "
         }
 
+        # Apache applications are shared modules loaded by httpd. Compile the
+        # Pascal units without the standalone link/run step; linking an
+        # executable here produces expected unresolved ap_/apr_ symbols.
+        if ($Defines -like "*HORSE_PROVIDER_APACHE*") {
+            $FpcCommand = "mkdir -p /tmp/fpc_lib /tmp/fpc_bin && fpc -B -Cn -Mdelphi -Sh -FE/tmp/fpc_bin -FU/tmp/fpc_lib -Fu../../src:modules/jhonson/src:modules/restrequest4delphi/src:modules/cors/src:modules/basic-auth/src $($FpcFlags.Trim()) CompileCheck.dpr"
+        } else {
+            $FpcCommand = "mkdir -p /tmp/fpc_lib /tmp/fpc_bin && fpc -B -Mdelphi -Sh -FE/tmp/fpc_bin -FU/tmp/fpc_lib -Fu../../src:modules/jhonson/src:modules/restrequest4delphi/src:modules/cors/src:modules/basic-auth/src $($FpcFlags.Trim()) CompileCheck.dpr && /tmp/fpc_bin/CompileCheck"
+        }
+
         Write-Host " -> Compilando Provedor (FPC Linux): $ScenName..." -ForegroundColor Gray
 
         $DockerArgs = @(
             "run", "--rm",
             "-v", "$ScriptDir\..\:/usr/src/app",
             "-w", "/usr/src/app/tests/src",
             "horse-tests-lazarus",
-            "bash", "-c", "mkdir -p /tmp/fpc_lib /tmp/fpc_bin && fpc -B -Mdelphi -Sh -FE/tmp/fpc_bin -FU/tmp/fpc_lib -Fu../../src:modules/jhonson/src:modules/restrequest4delphi/src:modules/cors/src:modules/basic-auth/src $($FpcFlags.Trim()) CompileCheck.dpr && /tmp/fpc_bin/CompileCheck"
+            "bash", "-c", $FpcCommand
         )
 
         $BuildStatus = "SUCESSO"

tests/src/FPCHttpKeepAliveServer.dpr

@@ -0,0 +1,22 @@
+program FPCHttpKeepAliveServer;
+
+{ Compile with FPC 3.3.1+ and run ../fpc_keepalive_regression.py while this
+  server is listening. The provider's keep-alive path is intentionally not
+  enabled on FPC 3.2.2. }
+
+{$MODE DELPHI}{$H+}
+
+uses
+  {$IFDEF UNIX}cthreads,{$ENDIF}
+  Horse,
+  Horse.Commons;
+
+procedure Ping(Req: THorseRequest; Res: THorseResponse; Next: TNextProc);
+begin
+  Res.Send('pong');
+end;
+
+begin
+  THorse.Get('/ping', Ping);
+  THorse.Listen(9901, '127.0.0.1');
+end.

tests/src/tests/Tests.CleanupHelper.pas

@@ -18,7 +18,8 @@ procedure ClearGlobalState;
   LList: TList<THorseCallback>;
 begin
   // 1. Para a escuta do servidor
-  THorse.StopListen;
+  if THorse.IsRunning then
+    THorse.StopListen;
 
   // 2. Reseta a arvore de rotas global
   THorse.Routes := nil;