test(console): add persistent connection stability stress

tests/console-stability/ConsoleStabilityCheck.dpr

@@ -0,0 +1,205 @@
+program ConsoleStabilityCheck;
+
+{$APPTYPE CONSOLE}
+
+uses
+  System.SysUtils,
+  System.Classes,
+  System.Generics.Collections,
+  IdHTTP,
+  IdHTTPHeaderInfo,
+  IdGlobalProtocols,
+  Horse,
+  Horse.Request,
+  Horse.Response,
+  Horse.Provider.Console;
+
+const
+  TEST_PORT = 19181;
+  DEFAULT_CLIENT_COUNT = 50;
+  DEFAULT_REQUESTS_PER_CLIENT = 1500;
+  DEFAULT_REQUEST_DELAY_MS = 0;
+  CONNECT_TIMEOUT_MS = 5000;
+  READ_TIMEOUT_MS = 10000;
+
+var
+  GClientCount: Integer;
+  GRequestsPerClient: Integer;
+  GRequestDelayMS: Integer;
+
+function EnvironmentInteger(const AName: string; const ADefault: Integer): Integer;
+var
+  LValue: string;
+begin
+  LValue := GetEnvironmentVariable(AName);
+  if (LValue = '') or not TryStrToInt(LValue, Result) or (Result < 0) then
+    Result := ADefault;
+end;
+
+type
+  TServerThread = class(TThread)
+  private
+    FErrorMessage: string;
+  protected
+    procedure Execute; override;
+  public
+    property ErrorMessage: string read FErrorMessage;
+  end;
+
+  TClientThread = class(TThread)
+  private
+    FClientIndex: Integer;
+    FErrorCount: Integer;
+    FMaxLatencyMS: UInt64;
+    FFirstError: string;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(const AClientIndex: Integer);
+    property ErrorCount: Integer read FErrorCount;
+    property MaxLatencyMS: UInt64 read FMaxLatencyMS;
+    property FirstError: string read FFirstError;
+  end;
+
+procedure Ping(Req: THorseRequest; Res: THorseResponse);
+begin
+  Res.Send('ok');
+end;
+
+procedure TServerThread.Execute;
+begin
+  try
+    THorse.Listen(TEST_PORT, '127.0.0.1');
+  except
+    on E: Exception do
+      FErrorMessage := E.ClassName + ': ' + E.Message;
+  end;
+end;
+
+constructor TClientThread.Create(const AClientIndex: Integer);
+begin
+  inherited Create(True);
+  FreeOnTerminate := False;
+  FClientIndex := AClientIndex;
+end;
+
+procedure TClientThread.Execute;
+var
+  LHTTP: TIdHTTP;
+  LIteration: Integer;
+  LStartedAt: UInt64;
+  LElapsed: UInt64;
+  LResponse: string;
+begin
+  LHTTP := TIdHTTP.Create(nil);
+  try
+    LHTTP.ConnectTimeout := CONNECT_TIMEOUT_MS;
+    LHTTP.ReadTimeout := READ_TIMEOUT_MS;
+    LHTTP.ProtocolVersion := pv1_1;
+    LHTTP.HTTPOptions := LHTTP.HTTPOptions + [hoKeepOrigProtocol];
+    LHTTP.Request.Connection := 'keep-alive';
+
+    for LIteration := 1 to GRequestsPerClient do
+    begin
+      LStartedAt := GetTickCount64;
+      try
+        LResponse := LHTTP.Get(Format('http://127.0.0.1:%d/stability?client=%d&request=%d',
+          [TEST_PORT, FClientIndex, LIteration]));
+        if (LHTTP.ResponseCode <> 200) or (LResponse <> 'ok') then
+          raise Exception.CreateFmt('status=%d body="%s"',
+            [LHTTP.ResponseCode, LResponse]);
+      except
+        on E: Exception do
+        begin
+          Inc(FErrorCount);
+          if FFirstError = '' then
+            FFirstError := Format('client=%d request=%d %s: %s',
+              [FClientIndex, LIteration, E.ClassName, E.Message]);
+          LHTTP.Disconnect;
+        end;
+      end;
+
+      LElapsed := GetTickCount64 - LStartedAt;
+      if LElapsed > FMaxLatencyMS then
+        FMaxLatencyMS := LElapsed;
+      if (GRequestDelayMS > 0) and (LIteration < GRequestsPerClient) then
+        Sleep(GRequestDelayMS);
+    end;
+  finally
+    LHTTP.Free;
+  end;
+end;
+
+var
+  LServer: TServerThread;
+  LClients: TObjectList<TClientThread>;
+  LClient: TClientThread;
+  LIndex: Integer;
+  LAttempts: Integer;
+  LErrors: Integer;
+  LMaxLatencyMS: UInt64;
+  LFirstError: string;
+begin
+  GClientCount := EnvironmentInteger('HORSE_STABILITY_CLIENTS', DEFAULT_CLIENT_COUNT);
+  GRequestsPerClient := EnvironmentInteger('HORSE_STABILITY_REQUESTS_PER_CLIENT', DEFAULT_REQUESTS_PER_CLIENT);
+  GRequestDelayMS := EnvironmentInteger('HORSE_STABILITY_REQUEST_DELAY_MS', DEFAULT_REQUEST_DELAY_MS);
+  if (GClientCount = 0) or (GRequestsPerClient = 0) then
+  begin
+    Writeln('Client and request counts must be greater than zero');
+    Halt(1);
+  end;
+
+  THorse.Get('/stability', Ping);
+  LServer := TServerThread.Create(True);
+  LClients := TObjectList<TClientThread>.Create(True);
+  try
+    LServer.FreeOnTerminate := False;
+    LServer.Start;
+    for LAttempts := 1 to 100 do
+    begin
+      if THorseProvider.IsRunning then
+        Break;
+      Sleep(50);
+    end;
+    if not THorseProvider.IsRunning then
+    begin
+      LServer.WaitFor;
+      Writeln('Server failed to start: ', LServer.ErrorMessage);
+      Halt(1);
+    end;
+
+    for LIndex := 1 to GClientCount do
+      LClients.Add(TClientThread.Create(LIndex));
+    for LClient in LClients do
+      LClient.Start;
+    for LClient in LClients do
+      LClient.WaitFor;
+
+    LErrors := 0;
+    LMaxLatencyMS := 0;
+    LFirstError := '';
+    for LClient in LClients do
+    begin
+      Inc(LErrors, LClient.ErrorCount);
+      if LClient.MaxLatencyMS > LMaxLatencyMS then
+        LMaxLatencyMS := LClient.MaxLatencyMS;
+      if (LFirstError = '') and (LClient.FirstError <> '') then
+        LFirstError := LClient.FirstError;
+    end;
+
+    Writeln(Format('clients=%d requests=%d delay_ms=%d errors=%d max_latency_ms=%d',
+      [GClientCount, GClientCount * GRequestsPerClient, GRequestDelayMS,
+       LErrors, LMaxLatencyMS]));
+    if LErrors <> 0 then
+    begin
+      Writeln('First error: ', LFirstError);
+      Halt(1);
+    end;
+  finally
+    if THorseProvider.IsRunning then
+      THorse.StopListen;
+    LServer.WaitFor;
+    LClients.Free;
+    LServer.Free;
+  end;
+end.

tests/console-stability/README.md

@@ -0,0 +1,30 @@
+# Console provider stability regression
+
+This Windows/Delphi stress test models the workload reported in issue #581:
+50 persistent HTTP/1.1 clients perform 1,500 keep-alive requests each, for a
+total of 75,000 transactions. It fails on connection errors, timeouts, HTTP
+errors, or invalid response bodies and reports the highest observed latency.
+
+Run from the repository root:
+
+```powershell
+powershell -ExecutionPolicy Bypass -File tests/console-stability/run-console-stability-test.ps1
+```
+
+Set `RADSTUDIO_RSVARS` when RAD Studio is installed outside the default Delphi
+12 path.
+
+The default run has no delay so that it can be used as a quick regression
+check. The workload can be paced with environment variables. The issue's
+reported rate (75,000 transactions from 50 clients over approximately eight
+hours) is equivalent to a delay of about 19.2 seconds between requests from
+each client:
+
+```powershell
+$env:HORSE_STABILITY_CLIENTS = '50'
+$env:HORSE_STABILITY_REQUESTS_PER_CLIENT = '1500'
+$env:HORSE_STABILITY_REQUEST_DELAY_MS = '19200'
+powershell -ExecutionPolicy Bypass -File tests/console-stability/run-console-stability-test.ps1
+```
+
+Unset `HORSE_STABILITY_REQUEST_DELAY_MS` (or set it to `0`) for the quick run.

tests/console-stability/run-console-stability-test.ps1

@@ -0,0 +1,22 @@
+$ErrorActionPreference = 'Stop'
+
+$testDir = Split-Path -Parent $MyInvocation.MyCommand.Path
+$horseRoot = (Resolve-Path (Join-Path $testDir '..\..')).Path
+$outputDir = Join-Path ([System.IO.Path]::GetTempPath()) ('horse-console-stability-' + [Guid]::NewGuid().ToString('N'))
+$rsvars = if ($env:RADSTUDIO_RSVARS) { $env:RADSTUDIO_RSVARS } else { 'C:\Program Files (x86)\Embarcadero\Studio\23.0\bin\rsvars.bat' }
+
+New-Item -ItemType Directory -Path $outputDir | Out-Null
+try {
+  $command = 'call "' + $rsvars + '" && dcc32.exe -B -Q ' +
+    '-E"' + $outputDir + '" -NS"System;Xml;Data;Datasnap;Web;Soap;Winapi" ' +
+    '-I"' + $horseRoot + '\src" -U"' + $horseRoot + '\src" ' +
+    '"' + (Join-Path $testDir 'ConsoleStabilityCheck.dpr') + '"'
+  & cmd.exe /d /c $command
+  if ($LASTEXITCODE -ne 0) { exit $LASTEXITCODE }
+
+  & (Join-Path $outputDir 'ConsoleStabilityCheck.exe')
+  if ($LASTEXITCODE -ne 0) { exit $LASTEXITCODE }
+}
+finally {
+  Remove-Item -LiteralPath $outputDir -Recurse -Force -ErrorAction SilentlyContinue
+}