kenjreno/fpc-msgbase
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Harden parsers against crafted message-base files

Browse Source 
Audit pass targeting attacker-controlled binary inputs (.JHR, .SQD,
*.MSG, Wildcat ISAM) and shared-directory sentinels.  Caps bound
allocations driven by in-file length fields; a few forward-only
invariants bound chain walks; O_NOFOLLOW plugs a lock-file
symlink-swap window.

JAM  (mb.fmt.jam): cap SubfieldLen (ReadSubFields) and TxtLen
(ReadBody) at 64 MiB.  Reject negative TxtOffset before seek.

Squish  (mb.fmt.squish): reject clen/msg_length outside the frame,
and clen > msg_length - SizeOf(SqMsgHdr) (prevents bodyLen
underflow into a negative SetLength argument).  ReIndex now
rejects non-forward next_frame and caps total hops.

Wildcat  (mb.fmt.wildcat): clamp Hdr.MsgBytes to SizeOf(TMsgText)
in ReadBody so Move() cannot read past the fixed-size buffer.

*.MSG  (mb.fmt.msg): cap ReadBody growth at 16 MiB; pre-size the
AnsiString so concatenation is O(n), not O(n^2).

mb.kludge: pre-count CRs so SplitKludgeBlob is O(n) instead of
O(n^2), and cap the parsed line count at 10 K.

mb.lock: POSIX fpOpen now passes O_NOFOLLOW so a symlink that an
attacker drops in place of the sentinel between FileExists and
fpOpen does not redirect us.  Advisory flock semantics unchanged.

mb.paths: new IsSafePathComponent / EnforceSafePathComponent
helpers.  Reject empty, '.', '..', absolute, drive-prefixed, or
separator-bearing tails; used by callers that accept area tags or
filenames from outside data.
This commit is contained in:
Ken Johnson
2026-04-19 06:27:46 -07:00
parent 84e2efdd7e
commit 180ca954f7
7 changed files with 160 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
src/formats/mb.fmt.jam.pas
View File

@@ -334,6 +334,16 @@ implementation
{$OVERFLOWCHECKS OFF}
const
{ Hard caps applied when parsing attacker-controlled .JHR/.JDT
fields. 64 MiB is far above anything a legitimate FidoNet
message needs (FTS-1 message size limit is 16 KiB of body;
JAM subfield blocks in the wild are a few kilobytes at most).
The caps exist so a crafted header cannot steer SetLength to
a multi-gigabyte allocation. }
JAM_MAX_SUBFIELD_BYTES = 64 * 1024 * 1024;
JAM_MAX_BODY_BYTES = 64 * 1024 * 1024;
const
{ CRC-32 lookup table — polynomial $EDB88320 (same as crcunit.pas) }
crc_32_tab: array[0..255] of longword = (
@@ -807,6 +817,11 @@ begin
Result := true;
exit;
end;
{ Cap attacker-controlled SubfieldLen so a corrupt header cannot
force hundreds of MiB of allocation via the inner SetLength.
A legitimate JAM header subfield block is only a few KiB. }
if SubfieldLen > JAM_MAX_SUBFIELD_BYTES then
SubfieldLen := JAM_MAX_SUBFIELD_BYTES;
n := 0;
remaining := SubfieldLen;
@@ -844,10 +859,12 @@ begin
Result := '';
if FTxtStream = nil then exit;
if TxtLen <= 0 then exit;
if TxtLen > JAM_MAX_BODY_BYTES then
TxtLen := JAM_MAX_BODY_BYTES;
ofs := TxtOffset;
if ofs >= FTxtStream.Size then exit;
if (ofs < 0) or (ofs >= FTxtStream.Size) then exit;
if ofs + TxtLen > FTxtStream.Size then
TxtLen := FTxtStream.Size - TxtOffset;
TxtLen := FTxtStream.Size - ofs;
FTxtStream.Position := ofs;
SetLength(Result, TxtLen);
TxtLen := FTxtStream.Read(Result[1], TxtLen);

22
src/formats/mb.fmt.msg.pas
View File

@@ -444,15 +444,31 @@ begin
end;
function TMsgFile.ReadBody: AnsiString;
const
{ Hard cap on FTS-1 *.MSG bodies. Real Fidonet messages are
capped in the wild at <=16 KiB; 16 MiB leaves generous head-
room while blocking a crafted giant .MSG from forcing a
multi-GB concatenation (AnsiString += in a loop is O(n^2)). }
MSG_MAX_BODY_BYTES = 16 * 1024 * 1024;
var
ch: byte;
remaining: int64;
count: longint;
begin
Result := '';
while FStream.Position < FStream.Size do begin
FStream.Read(ch, 1);
remaining := FStream.Size - FStream.Position;
if remaining > MSG_MAX_BODY_BYTES then
remaining := MSG_MAX_BODY_BYTES;
if remaining <= 0 then exit;
SetLength(Result, remaining);
count := 0;
while count < remaining do begin
if FStream.Read(ch, 1) <> 1 then break;
if ch = 0 then break;
Result := Result + Chr(ch);
Inc(count);
Result[count] := Chr(ch);
end;
SetLength(Result, count);
end;
function TMsgFile.ReadLine(var line: string): boolean;

31
src/formats/mb.fmt.squish.pas
View File

@@ -251,6 +251,14 @@ implementation
{$OVERFLOWCHECKS OFF}
const
{ Hard caps on attacker-controlled lengths / chain walks. Frames
larger than ~64 MiB indicate corruption; honouring clen or
msg_length past that risks OOM. MAX_CHAIN_HOPS bounds ReIndex
and Pack against a crafted next_frame cycle. }
SQ_MAX_FRAME_BYTES = 64 * 1024 * 1024;
SQ_MAX_CHAIN_HOPS = 10000000;
{ --- Date helpers --- }
function MonthStrToNum(const S: shortstring): word;
@@ -689,13 +697,22 @@ begin
Msg.Replies[i] := MHdr.replies[i];
Msg.UMsgId := Idx.umsgid;
{ Defensive bounds: clen and msg_length come straight from the
.SQD file and must be treated as attacker-controlled. Reject
values that would either overflow or drive a huge SetLength. }
if (FHdr.clen < 0) or (FHdr.clen > SQ_MAX_FRAME_BYTES) then exit;
if (FHdr.msg_length < SizeOf(SqMsgHdr)) or
(FHdr.msg_length > SQ_MAX_FRAME_BYTES) then exit;
if FHdr.clen > FHdr.msg_length - SizeOf(SqMsgHdr) then exit;
{ Read control info }
if FHdr.clen > 0 then begin
SetLength(Msg.CtrlInfo, FHdr.clen);
FSqdStream.Read(Msg.CtrlInfo[1], FHdr.clen);
end;
{ Read body: msg_length - sizeof(SqMsgHdr) - clen }
{ Read body: msg_length - sizeof(SqMsgHdr) - clen (underflow
guarded above). }
bodyLen := FHdr.msg_length - SizeOf(SqMsgHdr) - FHdr.clen;
if bodyLen > 0 then begin
SetLength(Msg.Body, bodyLen);
@@ -816,7 +833,8 @@ var
FHdr: SqFrameHdr;
MHdr: SqMsgHdr;
Idx: SqIdxRec;
CurFrame: longint;
CurFrame, PrevFrame: longint;
hops: longint;
begin
FillChar(Result, SizeOf(Result), 0);
if not FIsOpen or FReadOnly then exit;
@@ -829,6 +847,8 @@ begin
if not FBaseHdrRead then exit;
CurFrame := FBaseHdr.begin_frame;
PrevFrame := 0;
hops := 0;
while CurFrame > 0 do begin
if CurFrame + SizeOf(SqFrameHdr) + SizeOf(SqMsgHdr) > FSqdStream.Size then break;
@@ -850,7 +870,14 @@ begin
Inc(Result.ActiveMsgs);
end;
{ Cycle / forward-only guard: next_frame must move strictly
forward in the .SQD and we cap the total hop count so a
crafted chain cannot loop us forever. }
PrevFrame := CurFrame;
CurFrame := FHdr.next_frame;
if (CurFrame <> 0) and (CurFrame <= PrevFrame) then break;
Inc(hops);
if hops > SQ_MAX_CHAIN_HOPS then break;
end;
end;

11
src/formats/mb.fmt.wildcat.pas
View File

@@ -282,6 +282,7 @@ function TWildcatBase.ReadBody(Ref: longint): AnsiString;
var
Hdr: TMsgHeader;
Buf: PMsgText;
n: longint;
begin
Result := '';
if not FIsOpen then exit;
@@ -291,8 +292,14 @@ begin
FillChar(Buf^, SizeOf(TMsgText), 0);
FMsgDb^.GetMsgHeaderAndText(Ref, Hdr, Buf, 0, SizeOf(TMsgText));
if IsamOk and (Hdr.MsgBytes > 0) then begin
SetLength(Result, Hdr.MsgBytes);
Move(Buf^, Result[1], Hdr.MsgBytes);
{ Hdr.MsgBytes is read from the user DB and is attacker-
controlled; clamp against the fixed-size Buf so the Move
below cannot read past the allocation. }
n := Hdr.MsgBytes;
if n > SizeOf(TMsgText) then
n := SizeOf(TMsgText);
SetLength(Result, n);
Move(Buf^, Result[1], n);
end;
finally
Dispose(Buf);

32
src/mb.kludge.pas
View File

@@ -167,28 +167,44 @@ end;
procedure SplitKludgeBlob(const RawBody: AnsiString;
out PlainBody: AnsiString;
var A: TMsgAttributes);
const
{ Defensive cap on the number of #13-separated lines we will
process. A crafted body of millions of CRs otherwise turns
the O(n^2) SetLength-grow pattern into a hang. 10 K covers
any realistic kludge-rich message (SEEN-BY/PATH for a large
echo top out in the low thousands of entries). }
KLUDGE_MAX_LINES = 10000;
var
i, start, n: longint;
i, start, n, nCR: longint;
line, bodyOut: AnsiString;
lines: array of AnsiString;
begin
PlainBody := '';
if RawBody = '' then exit;
SetLength(lines, 0);
{ Pre-count CRs so the dynamic array is sized once (O(n) instead
of O(n^2)) and bail early if the attacker is trying to flood
us with line separators. }
nCR := 0;
for i := 1 to Length(RawBody) do
if RawBody[i] = #13 then Inc(nCR);
if nCR > KLUDGE_MAX_LINES then nCR := KLUDGE_MAX_LINES;
SetLength(lines, nCR + 1);
n := 0;
start := 1;
for i := 1 to Length(RawBody) do
if RawBody[i] = #13 then begin
SetLength(lines, Length(lines) + 1);
lines[High(lines)] := Copy(RawBody, start, i - start);
if n >= KLUDGE_MAX_LINES then break;
lines[n] := Copy(RawBody, start, i - start);
Inc(n);
start := i + 1;
end;
if start <= Length(RawBody) then begin
SetLength(lines, Length(lines) + 1);
lines[High(lines)] := Copy(RawBody, start, Length(RawBody) - start + 1);
if (n < KLUDGE_MAX_LINES) and (start <= Length(RawBody)) then begin
lines[n] := Copy(RawBody, start, Length(RawBody) - start + 1);
Inc(n);
end;
n := Length(lines);
bodyOut := '';
for i := 0 to n - 1 do begin
line := lines[i];

11
src/mb.lock.pas
View File

@@ -125,7 +125,16 @@ begin
fs.Free;
end;
{$IF DEFINED(UNIX)}
FHandle := THandle(fpOpen(FLockPath, O_RDWR or O_CREAT, &644));
{ O_NOFOLLOW: refuse to open the sentinel if an attacker with
write access to the area directory has replaced it with a
symlink pointing elsewhere (e.g. a config file they want us
to truncate). The advisory flock itself is bound to the
inode, so correctness of locking doesn't change -- this only
closes a TOCTOU / symlink-swap vector between the FileExists
check above and the fpOpen here. }
FHandle := THandle(fpOpen(FLockPath,
O_RDWR or O_CREAT or O_NOFOLLOW,
&644));
Result := FHandle <> THandle(-1);
{$ELSEIF DEFINED(WINDOWS)}
FHandle := CreateFile(PChar(string(FLockPath)),

50
src/mb.paths.pas
View File

@@ -16,6 +16,19 @@ uses
function PathJoin(const ADir, ATail: AnsiString): AnsiString;
function PathAppendSep(const ADir: AnsiString): AnsiString;
{ True when ATail is safe to use as a single path component below a
trusted base directory: non-empty, no NUL, no directory separators,
no '..', not an absolute path, not a drive-letter prefix.
The caller is the trust boundary; once a name has been validated it
is safe to feed into PathJoin. }
function IsSafePathComponent(const ATail: AnsiString): boolean;
{ Raise EInOutError when ATail is not a safe component. Used on
entry points that accept an area tag or filename derived from
outside data (.pkt filenames, flow-file lines, config values). }
procedure EnforceSafePathComponent(const ATail: AnsiString;
const AWhere: AnsiString = '');
{ Try APath as-is, then UpperCase(basename), then LowerCase(basename).
Returns the first that exists, or APath unchanged when nothing
resolves (so the caller can produce a useful error message). }
@@ -81,6 +94,43 @@ begin
else Result := PathAppendSep(ADir) + ATail;
end;
function IsSafePathComponent(const ATail: AnsiString): boolean;
var
i: integer;
c: AnsiChar;
begin
Result := False;
if ATail = '' then exit;
if (ATail = '.') or (ATail = '..') then exit;
{ Block absolute paths and Windows drive-letter prefixes. }
if ATail[1] in ['/', '\'] then exit;
if (Length(ATail) >= 2) and (ATail[2] = ':') then exit;
for i := 1 to Length(ATail) do begin
c := ATail[i];
if (c = #0) or (c = '/') or (c = '\') then exit;
end;
{ Reject any occurrence of '..' as a sub-component; after the
separator check above we also know there are no separators, so
a literal '..' substring can only mean dot-dot traversal in a
tail that was hand-built by concatenation. }
if Pos('..', ATail) > 0 then exit;
Result := True;
end;
procedure EnforceSafePathComponent(const ATail: AnsiString;
const AWhere: AnsiString);
begin
if not IsSafePathComponent(ATail) then begin
if AWhere = '' then
raise EInOutError.CreateFmt(
'mb.paths: unsafe path component %s', [AnsiQuotedStr(ATail, '"')])
else
raise EInOutError.CreateFmt(
'mb.paths: unsafe path component %s in %s',
[AnsiQuotedStr(ATail, '"'), AWhere]);
end;
end;
function FindExistingFile(const APath: AnsiString): AnsiString;
var
dir, name, upper, lower: AnsiString;