fpc-msgbase/tests/adversarial/test_fuzz_ezycom.pas

{
  test_fuzz_ezycom.pas - corruption-resilience for EzyCom driver.

  EzyCom lays out per-area files under AREA<n>/ subdirs
  (MH#####.BBS header, MT#####.BBS text on BBSType 12).  The
  default TEzyComMessageBase opens board 1, BBSType 12; a fuzzed
  AREA1/MH00001.BBS / MT00001.BBS pair is what the fuzz tests
  exercise.

  Test IDs:
    F-EZ-1  missing AREA1/ dir -> graceful
    F-EZ-2  empty MH00001.BBS / MT00001.BBS -> MessageCount = 0
    F-EZ-3  garbage-filled header + text files -> bounded + no crash
    F-EZ-4  truncated header (half a record) -> graceful
}

program test_fuzz_ezycom;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils,
  testutil,
  mb.types, mb.api,
  mb.fmt.ezycom, mb.fmt.ezycom.uni;

const
  SCRATCH = '/tmp/mb_fuzz_ezycom';
  AREA1   = SCRATCH + '/AREA1';

procedure FreshDir;
var
  sr: TSearchRec;
begin
  ForceDirectories(SCRATCH);
  ForceDirectories(AREA1);
  { Wipe any leftover files from a prior run, both in SCRATCH and
    in AREA1 -- repeated tests must start from a clean slate. }
  if FindFirst(SCRATCH + '/*', faAnyFile, sr) = 0 then begin
    repeat
      if (sr.Name <> '.') and (sr.Name <> '..') and
         ((sr.Attr and faDirectory) = 0) then
        DeleteFile(SCRATCH + '/' + sr.Name);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  if FindFirst(AREA1 + '/*', faAnyFile, sr) = 0 then begin
    repeat
      if (sr.Name <> '.') and (sr.Name <> '..') and
         ((sr.Attr and faDirectory) = 0) then
        DeleteFile(AREA1 + '/' + sr.Name);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

procedure WriteBytes(const APath: string; const B: array of byte);
var fs: TFileStream;
begin
  fs := TFileStream.Create(APath, fmCreate);
  try if Length(B) > 0 then fs.Write(B[0], Length(B)); finally fs.Free; end;
end;

function SafeOpen(out Base: TMessageBase; const ADir: string): boolean;
begin
  Result := False; Base := nil;
  try
    Base := MessageBaseOpen(mbfEzyCom, ADir, momReadOnly);
    Result := Base.Open;
  except
    on E: Exception do begin
      TestFail('Open raised: ' + E.ClassName + ': ' + E.Message);
      if Assigned(Base) then begin Base.Free; Base := nil; end;
    end;
  end;
end;

procedure CloseAndFree(var Base: TMessageBase);
begin
  if Base = nil then exit;
  try Base.Close; except end;
  try Base.Free;  except end;
  Base := nil;
end;

{ ============================================================ }

procedure TestMissingAreaDir;
var base: TMessageBase;
begin
  TestBegin('F-EZ-1: missing AREA1/ dir -> graceful');
  FreshDir;
  { Remove AREA1 entirely. }
  RemoveDir(AREA1);
  if not SafeOpen(base, SCRATCH) then begin TestOK; exit; end;
  try AssertTrue('MessageCount >= 0', base.MessageCount >= 0);
  finally CloseAndFree(base); end;
  TestOK;
end;

procedure TestEmptyFiles;
var base: TMessageBase;
begin
  TestBegin('F-EZ-2: empty MH/MT -> MessageCount = 0');
  FreshDir;
  WriteBytes(AREA1 + '/MH00001.BBS', []);
  WriteBytes(AREA1 + '/MT00001.BBS', []);
  if not SafeOpen(base, SCRATCH) then begin TestOK; exit; end;
  try AssertEquals('MessageCount', 0, base.MessageCount);
  finally CloseAndFree(base); end;
  TestOK;
end;

procedure TestGarbageBundle;
var
  base: TMessageBase;
  garb: array[0..2047] of byte;
  i: integer;
  msg: TUniMessage;
  n: longint;
begin
  TestBegin('F-EZ-3: garbage MH + MT -> bounded, no crash');
  FreshDir;
  for i := 0 to High(garb) do garb[i] := byte(($A3 + i * 5) and $FF);
  WriteBytes(AREA1 + '/MH00001.BBS', garb);
  WriteBytes(AREA1 + '/MT00001.BBS', garb);
  if not SafeOpen(base, SCRATCH) then begin TestOK; exit; end;
  try
    n := base.MessageCount;
    AssertTrue('MessageCount bounded', (n >= 0) and (n <= 65535));
    for i := 0 to 7 do
      if i < n then base.ReadMessage(i, msg);
  finally CloseAndFree(base); end;
  TestOK;
end;

procedure TestTruncatedHeader;
var
  base: TMessageBase;
  half: array[0..92] of byte;   { half of EzyMsgHdrRecord (~186 B) }
  i: integer;
  msg: TUniMessage;
  n: longint;
begin
  TestBegin('F-EZ-4: truncated half-header -> graceful');
  FreshDir;
  for i := 0 to High(half) do half[i] := byte($5A xor i);
  WriteBytes(AREA1 + '/MH00001.BBS', half);
  WriteBytes(AREA1 + '/MT00001.BBS', []);
  if not SafeOpen(base, SCRATCH) then begin TestOK; exit; end;
  try
    n := base.MessageCount;
    AssertTrue('MessageCount bounded', (n >= 0) and (n <= 1));
    if n > 0 then base.ReadMessage(0, msg);
  finally CloseAndFree(base); end;
  TestOK;
end;

begin
  WriteLn('fpc-msgbase: EzyCom corruption-resilience fuzz');
  WriteLn;
  TestMissingAreaDir;
  TestEmptyFiles;
  TestTruncatedHeader;
  TestGarbageBundle;
  Halt(TestsSummary);
end.