From 180ca954f7d09e479bc24dbac9efc64f19cd6d3e Mon Sep 17 00:00:00 2001 From: Ken Johnson Date: Sun, 19 Apr 2026 06:27:46 -0700 Subject: [PATCH] Harden parsers against crafted message-base files 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. --- src/formats/mb.fmt.jam.pas | 21 ++++++++++++-- src/formats/mb.fmt.msg.pas | 22 +++++++++++++-- src/formats/mb.fmt.squish.pas | 31 +++++++++++++++++++-- src/formats/mb.fmt.wildcat.pas | 11 ++++++-- src/mb.kludge.pas | 32 ++++++++++++++++------ src/mb.lock.pas | 11 +++++++- src/mb.paths.pas | 50 ++++++++++++++++++++++++++++++++++ 7 files changed, 160 insertions(+), 18 deletions(-) diff --git a/src/formats/mb.fmt.jam.pas b/src/formats/mb.fmt.jam.pas index cb16d02..ce4d4df 100644 --- a/src/formats/mb.fmt.jam.pas +++ b/src/formats/mb.fmt.jam.pas @@ -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); diff --git a/src/formats/mb.fmt.msg.pas b/src/formats/mb.fmt.msg.pas index c542717..940b9d5 100644 --- a/src/formats/mb.fmt.msg.pas +++ b/src/formats/mb.fmt.msg.pas @@ -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; diff --git a/src/formats/mb.fmt.squish.pas b/src/formats/mb.fmt.squish.pas index 57b0850..6699ac5 100644 --- a/src/formats/mb.fmt.squish.pas +++ b/src/formats/mb.fmt.squish.pas @@ -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; diff --git a/src/formats/mb.fmt.wildcat.pas b/src/formats/mb.fmt.wildcat.pas index 62bfb05..5a7099b 100644 --- a/src/formats/mb.fmt.wildcat.pas +++ b/src/formats/mb.fmt.wildcat.pas @@ -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); diff --git a/src/mb.kludge.pas b/src/mb.kludge.pas index a3a99e3..818e81f 100644 --- a/src/mb.kludge.pas +++ b/src/mb.kludge.pas @@ -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]; diff --git a/src/mb.lock.pas b/src/mb.lock.pas index 5841b03..493be28 100644 --- a/src/mb.lock.pas +++ b/src/mb.lock.pas @@ -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)), diff --git a/src/mb.paths.pas b/src/mb.paths.pas index 391b286..42086a4 100644 --- a/src/mb.paths.pas +++ b/src/mb.paths.pas @@ -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;