Resolve security audit findings
ober
57b790c5cab3b0ca93fea567b72d9dd8f6166bf2
--- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -17,7 +17,7 @@ jobs: verify: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4.3.1 - name: Install system tools run: | --- a/.github/workflows/security-baseline.yml +++ b/.github/workflows/security-baseline.yml @@ -13,7 +13,7 @@ jobs: baseline: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4.3.1 - name: Required release files run: | --- a/.jerboa/security.json +++ b/.jerboa/security.json @@ -42,6 +42,8 @@ "mail-max-encoded-word-chars": 65536, "mail-max-mime-depth": 16, "mail-max-mime-parts": 1024, + "mail-max-mime-header-chars": 4194304, + "mail-max-mime-decoded-chars": 26214400, "mail-max-boundary-chars": 200 } } --- a/README.md +++ b/README.md @@ -39,7 +39,11 @@ or make body text safe for browser rendering. - `mail-max-transfer-encoded-chars`: 25 MiB. - `mail-max-encoded-word-chars`: 64 KiB. - `mail-max-mime-depth`: 16. -- `mail-max-mime-parts`: 1024. +- `mail-max-mime-parts`: 1024 total nodes across the complete message tree, + including the root, multipart containers, and leaves. +- `mail-max-mime-header-chars`: 4 MiB total across all MIME nodes. +- `mail-max-mime-decoded-chars`: 25 MiB total retained decoded/body text + across all MIME leaves. - `mail-max-boundary-chars`: 200. ## Development --- a/SECURITY.md +++ b/SECURITY.md @@ -23,8 +23,10 @@ must be cut from a clean checkout after: - Parser and test source must not import `(chezscheme)` directly. - Parser and test source must remain free of shell/process execution, filesystem sinks, network access, FFI, and dynamic-library loading. -- Oversized messages, headers, lines, encoded payloads, MIME part counts, MIME - nesting, and invalid boundaries must fail closed. +- Oversized messages, headers, lines, encoded payloads, aggregate MIME tree + nodes, aggregate MIME headers/decoded bodies, MIME nesting, and invalid + boundaries must fail closed. A single mutable budget must span the complete + recursive parse; per-multipart counters are not sufficient. - Parsed HTML, subjects, display names, attachment names, and body text remain hostile strings for downstream renderers and indexers. - This library never makes decoded HTML safe for browser rendering. Callers --- a/docs/parser-hardening.md +++ b/docs/parser-hardening.md @@ -16,7 +16,12 @@ deployment: - `mail-max-transfer-encoded-chars`: 25 MiB. - `mail-max-encoded-word-chars`: 64 KiB. - `mail-max-mime-depth`: 16. -- `mail-max-mime-parts`: 1024. +- `mail-max-mime-parts`: 1024 total nodes across the complete message tree; + the root, multipart containers, and leaves each consume one slot before the + next message node is constructed. +- `mail-max-mime-header-chars`: 4 MiB accumulated across every MIME node. +- `mail-max-mime-decoded-chars`: 25 MiB of accumulated retained decoded/body + characters across leaves and malformed multipart bodies. - `mail-max-boundary-chars`: 200. Set a parameter to `#f` only in controlled offline tooling that already applies @@ -30,8 +35,10 @@ stronger outer resource controls. - Base64, quoted-printable, and encoded-word decoding. - Plain-text and multipart/alternative body selection. - Over-limit message, header, header-line-count, line, transfer-payload, - encoded-word, MIME-part-count, MIME-depth, boundary-length, and empty-boundary - failures. + encoded-word, aggregate MIME-node-count, aggregate MIME-header/body, + MIME-depth, boundary-length, and empty-boundary failures. The branching-tree + regression keeps every multipart below the local child limit while exceeding + the shared seven-node budget. `make fuzz-evidence` adds deterministic hostile-input property coverage: @@ -55,3 +62,5 @@ bodies, content types, best-text output, and part lists structurally valid. - Keep message-body logging disabled by default in mail readers and daemons. - Use process, queue, and memory limits around bulk importers that parse untrusted mail archives. +- Keep the aggregate MIME parameters enabled. Setting them to `#f` is safe only + in controlled offline tooling with stronger outer memory/process limits. --- a/docs/release-evidence.md +++ b/docs/release-evidence.md @@ -23,6 +23,8 @@ artifacts under `dist/release-evidence/`: - `source-sha256.txt` for parser and test source. - `corpus-smoke.txt` with safe public malformed-message corpus results. - `fuzz-evidence.txt` with deterministic hostile-input parser property results. + Its limit cases include global MIME node, aggregate header, and aggregate + decoded-body budgets rather than only per-multipart child counts. - `rendering-policy.txt` with required caller HTML/rendering policy markers. - `sbom/` with source, corpus, release-input, and no-native-dependency provenance. --- a/docs/threat-model.md +++ b/docs/threat-model.md @@ -39,7 +39,9 @@ libraries, or store credentials. - Keep the parser capability-free: no shell, filesystem, network, credential, or FFI access in parser/test source. - Fail closed on over-limit messages, headers, lines, encoded payloads, MIME - part counts, MIME nesting, and boundary values. + nesting, and boundary values. One shared recursive budget counts every MIME + container/leaf and accumulates all MIME header and retained decoded/body + characters, so nested branching cannot reset a local counter. - Treat decoded HTML as text only. This library does not sanitize HTML for browser display. - Do not log message contents, private addresses, deployment paths, or parser @@ -53,7 +55,7 @@ libraries, or store credentials. license text, and high-confidence secrets. - Regression tests must cover successful parsing and limit-triggering failure paths for messages, headers, lines, transfer payloads, encoded-word headers, - MIME part counts, MIME nesting, and boundaries. + aggregate MIME node/header/body budgets, MIME nesting, and boundaries. - `make fuzz-evidence` must pass with at least 512 deterministic hostile-input cases covering headers, transfer encodings, multipart handling, encoded words, structural invariants, malformed input rejection, and limit policy. --- a/jerboa-mail/mime.ss +++ b/jerboa-mail/mime.ss @@ -5,6 +5,8 @@ (export mail-max-mime-depth mail-max-mime-parts + mail-max-mime-header-chars + mail-max-mime-decoded-chars mail-max-boundary-chars mail-content-type mail-content-params @@ -22,6 +24,8 @@ (define mail-max-mime-depth (make-parameter 16)) (define mail-max-mime-parts (make-parameter 1024)) + (define mail-max-mime-header-chars (make-parameter (* 4 1024 1024))) + (define mail-max-mime-decoded-chars (make-parameter (* 25 1024 1024))) (define mail-max-boundary-chars (make-parameter 200)) (define (limit-value who param label) @@ -41,6 +45,20 @@ count limit)))) + ;; One budget is shared by every recursive node in a message tree. + ;; Slots are total nodes, aggregate header chars, and retained decoded/body + ;; chars. The counters remain useful even when a limit is explicitly #f. + (define (make-mime-budget) + (vector 0 0 0)) + + (define (consume-mime-budget! budget slot amount label param) + (unless (and (integer? amount) (>= amount 0)) + (error 'mail-parse-message "invalid MIME budget increment" label amount)) + (let ([next (+ (vector-ref budget slot) amount)]) + (check-limit 'mail-parse-message label next param) + (vector-set! budget slot next) + next)) + (define (string-prefix? prefix s) (let ([plen (string-length prefix)] [slen (string-length s)]) @@ -139,37 +157,28 @@ (string-length boundary) mail-max-boundary-chars)) - (define (finish-current-part inside? current parts count) + (define (finish-current-part inside? current parts) (if (and inside? (pair? current)) - (let ([next-count (+ count 1)]) - (check-limit 'mail-parse-message - "MIME part count" - next-count - mail-max-mime-parts) - (values (cons (string-join-lines (reverse current)) parts) - next-count)) - (values parts count))) + (cons (string-join-lines (reverse current)) parts) + parts)) (define (split-multipart-body body boundary) (check-boundary boundary) (let* ([marker (string-append "--" boundary)] [lines (mail-split-lines body)]) - (let loop ([xs lines] [inside? #f] [current '()] [parts '()] [count 0]) + (let loop ([xs lines] [inside? #f] [current '()] [parts '()]) (cond [(null? xs) - (let-values ([(new-parts new-count) - (finish-current-part inside? current parts count)]) - (reverse new-parts))] + (reverse (finish-current-part inside? current parts))] [(boundary-line? (car xs) marker) - (let-values ([(new-parts new-count) - (finish-current-part inside? current parts count)]) + (let ([new-parts (finish-current-part inside? current parts)]) (if (closing-boundary-line? (car xs) marker) (reverse new-parts) - (loop (cdr xs) #t '() new-parts new-count)))] + (loop (cdr xs) #t '() new-parts)))] [inside? - (loop (cdr xs) inside? (cons (car xs) current) parts count)] + (loop (cdr xs) inside? (cons (car xs) current) parts)] [else - (loop (cdr xs) inside? current parts count)])))) + (loop (cdr xs) inside? current parts)])))) (define (string-join-lines lines) (let ([out (open-output-string)]) @@ -186,12 +195,26 @@ (mail-header-ref headers "Content-Transfer-Encoding" "7bit") body)) - (define (mail-parse-message/depth raw depth) + (define (make-budgeted-body-message budget headers body) + (consume-mime-budget! budget 2 (string-length body) + "aggregate MIME decoded/body chars" + mail-max-mime-decoded-chars) + (make-message headers body '())) + + (define (mail-parse-message/depth raw depth budget) (check-limit 'mail-parse-message "MIME nesting depth" depth mail-max-mime-depth) + ;; Reserve the node before parsing headers or constructing its message + ;; vector. Multipart containers and leaves both consume one slot. + (consume-mime-budget! budget 0 1 + "aggregate MIME node count" + mail-max-mime-parts) (let-values ([(header-text body) (mail-split-header-body raw)]) + (consume-mime-budget! budget 1 (string-length header-text) + "aggregate MIME header chars" + mail-max-mime-header-chars) (let* ([headers (mail-headers-parse header-text)] [ctype (mail-content-type headers)]) (if (string-prefix? "multipart/" ctype) @@ -201,13 +224,14 @@ headers "" (map (lambda (part) - (mail-parse-message/depth part (+ depth 1))) + (mail-parse-message/depth part (+ depth 1) budget)) (split-multipart-body body boundary))) - (make-message headers body '()))) - (make-message headers (decode-leaf-body headers body) '()))))) + (make-budgeted-body-message budget headers body))) + (make-budgeted-body-message + budget headers (decode-leaf-body headers body)))))) (define (mail-parse-message raw) - (mail-parse-message/depth raw 0)) + (mail-parse-message/depth raw 0 (make-mime-budget))) (define (html->text html) (let ([out (open-output-string)]) --- a/scripts/security-check.sh +++ b/scripts/security-check.sh @@ -85,6 +85,28 @@ do fi done +for marker in \ + 'make-mime-budget' \ + 'consume-mime-budget!' \ + 'aggregate MIME node count' \ + 'mail-max-mime-header-chars' \ + 'mail-max-mime-decoded-chars' +do + if ! grep -q "$marker" jerboa-mail/mime.ss; then + note_fail "missing global MIME budget marker: $marker" + fi +done + +for marker in \ + 'mail-max-mime-header-chars' \ + 'mail-max-mime-decoded-chars' \ + 'complete message tree' +do + if ! grep -q "$marker" docs/parser-hardening.md; then + note_fail "missing documented global MIME budget marker: $marker" + fi +done + if find jerboa-mail test \( -name '*.so' -o -name '*.dylib' -o -name '*.o' -o -name '*.wpo' -o -name '*.boot' \) -print | grep -q .; then find jerboa-mail test \( -name '*.so' -o -name '*.dylib' -o -name '*.o' -o -name '*.wpo' -o -name '*.boot' \) -print note_fail "generated native/Scheme artifacts found in parser/test directories" --- a/support/fuzz-evidence.ss +++ b/support/fuzz-evidence.ss @@ -203,9 +203,6 @@ (fail! name "content type is not a string")) (unless (string? best) (fail! name "best text body is not a string")) - (when (and (list? parts) - (> (length parts) (mail-max-mime-parts))) - (fail! name "part count exceeds active limit")) (when (and (list? parts) (< depth (mail-max-mime-depth))) (let loop ([xs parts] [n 0]) (unless (null? xs) @@ -217,6 +214,21 @@ (when (eq? (car result) 'condition) (fail! name "message invariant check raised a condition")))) +(define (message-node-count msg) + (+ 1 + (let loop ([parts (mail-message-parts msg)] [count 0]) + (if (null? parts) + count + (loop (cdr parts) (+ count (message-node-count (car parts)))))))) + +(define (message-decoded-char-count msg) + (+ (string-length (mail-message-body msg)) + (let loop ([parts (mail-message-parts msg)] [count 0]) + (if (null? parts) + count + (loop (cdr parts) + (+ count (message-decoded-char-count (car parts)))))))) + (define (run-message-case i) (bump-total!) (let* ([name (string-append "message-" (number->string i))] @@ -232,6 +244,8 @@ [mail-max-encoded-word-chars 512] [mail-max-mime-depth 8] [mail-max-mime-parts 64] + [mail-max-mime-header-chars 4096] + [mail-max-mime-decoded-chars 8192] [mail-max-boundary-chars 80]) (mail-parse-message raw))))]) (if (eq? (car result) 'condition) @@ -239,7 +253,14 @@ (begin (bump-accepted!) (parameterize ([mail-max-mime-depth 8] - [mail-max-mime-parts 64]) + [mail-max-mime-parts 64] + [mail-max-mime-decoded-chars 8192]) + (when (> (message-node-count (cdr result)) + (mail-max-mime-parts)) + (fail! name "aggregate MIME node count exceeds active limit")) + (when (> (message-decoded-char-count (cdr result)) + (mail-max-mime-decoded-chars)) + (fail! name "aggregate decoded body chars exceed active limit")) (check-message-invariants name (cdr result) 0)))))) (define (run-decoder-case i) @@ -297,7 +318,7 @@ (fail! name "header lookup did not return a string")))))) (define (limit-thunk i) - (case (modulo i 8) + (case (modulo i 11) [(0) (lambda () (parameterize ([mail-max-message-chars 8]) @@ -324,13 +345,29 @@ (mail-decode-encoded-words "=?UTF-8?B?SGVsbG8=?=")))] [(6) (lambda () - (parameterize ([mail-max-mime-parts 1]) + (parameterize ([mail-max-mime-parts 2]) (mail-parse-message (string-append "Content-Type: multipart/mixed; boundary=\"b\"\r\n\r\n" "--b\r\nContent-Type: text/plain\r\n\r\none\r\n" "--b\r\nContent-Type: text/plain\r\n\r\ntwo\r\n" "--b--\r\n"))))] + [(7) + (lambda () + (parameterize ([mail-max-mime-header-chars 8]) + (mail-parse-message "Subject: aggregate-too-long\r\n\r\nbody")))] + [(8) + (lambda () + (parameterize ([mail-max-mime-decoded-chars 4]) + (mail-parse-message "Content-Type: text/plain\r\n\r\n12345")))] + [(9) + (lambda () + (parameterize ([mail-max-mime-depth 0]) + (mail-parse-message + (string-append + "Content-Type: multipart/mixed; boundary=\"b\"\r\n\r\n" + "--b\r\nContent-Type: text/plain\r\n\r\none\r\n" + "--b--\r\n"))))] [else (lambda () (parameterize ([mail-max-boundary-chars 1]) --- a/test/test-all.ss +++ b/test/test-all.ss @@ -131,6 +131,40 @@ "--b\r\nContent-Type: text/plain\r\n\r\ntwo\r\n" "--b--\r\n")))) +(define branching-multipart-message + (string-append + "Content-Type: multipart/mixed; boundary=\"top\"\r\n\r\n" + "--top\r\n" + "Content-Type: multipart/mixed; boundary=\"left\"\r\n\r\n" + "--left\r\nContent-Type: text/plain\r\n\r\none\r\n" + "--left\r\nContent-Type: text/plain\r\n\r\ntwo\r\n" + "--left--\r\n" + "--top\r\n" + "Content-Type: multipart/mixed; boundary=\"right\"\r\n\r\n" + "--right\r\nContent-Type: text/plain\r\n\r\nthree\r\n" + "--right\r\nContent-Type: text/plain\r\n\r\nfour\r\n" + "--right--\r\n" + "--top--\r\n")) + +;; Every multipart has only two direct children, but the complete tree has +;; seven nodes: root container, two child containers, and four leaves. +(parameterize ([mail-max-mime-parts 6]) + (check-raises "reject aggregate MIME tree over node budget" + (mail-parse-message branching-multipart-message))) + +(parameterize ([mail-max-mime-parts 7]) + (let ([msg (mail-parse-message branching-multipart-message)]) + (check "accept MIME tree at exact aggregate node budget" + (= 2 (length (mail-message-parts msg)))))) + +(parameterize ([mail-max-mime-header-chars 100]) + (check-raises "reject aggregate MIME header budget" + (mail-parse-message branching-multipart-message))) + +(parameterize ([mail-max-mime-decoded-chars 10]) + (check-raises "reject aggregate MIME decoded body budget" + (mail-parse-message branching-multipart-message))) + (parameterize ([mail-max-mime-depth 0]) (check-raises "reject over-limit MIME nesting" (mail-parse-message