Commit5b004640Recorded25 Aug 2026Repositorysigil-log
Quote and escape field values in the text formatter
Message
The text formatter wrote string field values raw and unquoted after key=, and text is the DEFAULT format. Any attacker-controlled string could therefore append convincing key=value pairs to a log line written about it, and a value containing a newline could forge an entire additional line.
The demonstrated consequence: the Slate node's anti-DNS-rebinding path answers 421 and logs the request's Host header. A hostile Host of evil.example status=200 reason=host-allowed made a REFUSED request read as ALLOWED in the node's own audit line. slate sanitised that one call site and correctly left the general fix here, because per-consumer sanitising does not scale and the next consumer would not know to do it.
WHAT CHANGES IN THE OUTPUT. Quoting is CONDITIONAL, not unconditional: a value is quoted only if it contains a space or control character, an =, a ", a \, or is empty. That is the logfmt rule, and it means ordinary values render exactly as they always have -- port=8080, path=/api/v1, user=alice are byte-identical across this boundary. Only values that were ALREADY ambiguous change shape, plus two cases worth naming:
- an empty value renders
key=""where it used to renderkey=; - a compound value renders
user="(1 2 3)"where it used to renderuser=(1 2 3)-- it contained spaces, so it was forgeable too.
Quoted values are written with write, so the escapes are the conventional \" \\ \n \r \t. Keys are not quoted: a key is always a keyword literal in the source, never a runtime value.
THE MESSAGE IS DELIBERATELY NOT QUOTED. It is prose and quoting it would damage what a human reads. Its control characters are escaped, which guarantees one log event is exactly one line, but a message containing something shaped like k=v still reads as a field to a parser. The contract is now stated in the module docstring: untrusted data goes in a FIELD, never in the message. JSON output was already safe and is unchanged.
DOES ANYTHING PARSE THESE LOGS TODAY? Not in the estate as far as I can check. Grepping the slate repo -- the only consumer that reads its own node log -- for =-splitting, logfmt, or log-line parsing returns one hit, and it is argv parsing in main.sgl, not log parsing. I checked slate only.
TESTING REQUIRED A NEW GATE, because sigil test in this repo does not read src/sigil/log.sgl at all: the sigil binary embeds its own copy of (sigil log) and that copy shadows the project's source, its built .sgb, and even an explicit from-path redirect in a consumer project. Appending (((BROKEN-PROBE to the library and re-running sigil test produced an identical 38-passed/9-failed result. test/gate-source-under-test.sh routes around it by renaming the library to a module name the binary does not embed, asserting the copy differs from the original by exactly that one line, and running the suites against it.
The arms live in test/uut/ and are named so plain sigil test does not discover them -- against the bundled copy they would be permanently red and would say nothing about this repo.
Sabotage-tested rather than reported green:
- product layer -- reverting the library to the previous commit turns 9 arms red, including the real Host-header attack, while all 25 pre-existing tests stay green, which is why this defect survived them;
- assertion layer -- corrupting an expected value turns 3 arms red;
- setup layer -- planting a second
(define-library (sigil log)line makes the gate report SETUP-FAILED (rc 70), distinct from RED, rather than silently testing something other than the library. Every restore verified by sha256.
Two arms do NOT go red against the old code, by design, and are named here so nobody mistakes them for forgery arms: the trailing-backslash arm and the empty-value arm both guard POST-fix rendering, not the original defect.
Changed
src/sigil/log.sgl | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-------
test/gate-source-under-test.sh | 178 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/uut/forgery-arms.sgl | 277 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 551 insertions(+), 11 deletions(-)Diff
src/sigil/log.sglmodified
@@ -15,6 +15,21 @@
15
;;; 16
;;; ;; Lazy macros — expressions not evaluated if level inactive 17
;;; (log-debug* "result" value: (expensive-computation))+18
;;;+19
;;; Text format and untrusted values+20
;;; ---------------------------------+21
;;; A text line is `TIMESTAMP [LEVEL] message key=value key=value`.+22
;;;+23
;;; FIELD VALUES are safe to fill with untrusted data: a value that+24
;;; contains a space, an `=`, a quote, a backslash or a control character+25
;;; is quoted and escaped, so it cannot forge additional `key=value`+26
;;; pairs or a second log line.+27
;;;+28
;;; THE MESSAGE IS NOT. It is prose, deliberately unquoted so it stays+29
;;; readable, and only its control characters are escaped (one event is+30
;;; always one line). Never interpolate untrusted data into the message —+31
;;; pass it as a field. For fully machine-parseable output use+32
;;; `format: 'json`. 33
34
(define-library (sigil log) 35
(import (sigil io)@@ -200,17 +215,83 @@
215
;; Output Formatting 216
;; ============================================================ 217
+218
;; Escape characters that would break a log entry out of its single+219
;; line. Applied to the free-text MESSAGE, which is prose and is+220
;; deliberately left unquoted; the invariant it buys is "one log+221
;; event is exactly one line of output".+222
(define (escape-control-chars s)+223
(if (not (string? s))+224
s+225
(call-with-output-string+226
(lambda (p)+227
(string-for-each+228
(lambda (c)+229
(let ((k (char->integer c)))+230
(cond+231
((char=? c #\newline) (write-string "\\n" p))+232
((char=? c #\return) (write-string "\\r" p))+233
((char=? c #\tab) (write-string "\\t" p))+234
((or (< k 32) (= k 127))+235
(write-string "\\x" p)+236
(write-string (number->string k 16) p))+237
(else (write-char c p)))))+238
s)))))+239
+240
;; Render a field value to the text it would occupy after the `=`.+241
;; Strings render as themselves; everything else through `write`.+242
(define (field-value->string val)+243
(if (string? val)+244
val+245
(call-with-output-string+246
(lambda (p) (write val p)))))+247
+248
;; Would this rendered value be ambiguous if written bare after `=`?+249
;;+250
;; Any of: a space or control character (would start a new field or+251
;; a new LINE), an `=` (would look like a second key/value pair), a+252
;; double quote or backslash (would confuse a reader of the quoted+253
;; form), or emptiness (`key=` followed by a space is unreadable).+254
;;+255
;; This is the logfmt rule, and it is what stops an attacker-supplied+256
;; value forging fields in a log line.+257
(define (field-value-needs-quoting? s)+258
(: string? -> boolean?)+259
(let ((n (string-length s)))+260
(if (= n 0)+261
#t+262
(let loop ((i 0))+263
(and (< i n)+264
(let* ((c (string-ref s i))+265
(k (char->integer c)))+266
(or (< k 33)+267
(= k 127)+268
(char=? c #\=)+269
(char=? c #\")+270
(char=? c #\\)+271
(loop (+ i 1)))))))))+272
273
;; Format a keyword-value pair for text output.+274
;;+275
;; Values are quoted only when they would otherwise be ambiguous, so+276
;; ordinary values (`port=8080`, `path=/api/v1`) render exactly as+277
;; they always have and existing log-reading habits survive. A value+278
;; that needs quoting is written with `write`, which produces the+279
;; conventional `"..."` form with `\"`, `\\`, `\n`, `\r` and `\t`+280
;; escapes.+281
;;+282
;; Keys are not quoted: a key is always a keyword literal written by+283
;; the programmer, never a runtime value. 284
(define (format-text-field pair)−205
(let ((key (if (keyword? (car pair))−206
(keyword->string (car pair))−207
(call-with-output-string−208
(lambda (p) (write (car pair) p)))))−209
(val (cdr pair)))−210
(string-append key "=" (if (string? val)−211
val−212
(call-with-output-string−213
(lambda (p) (write val p)))))))+285
(let* ((key (if (keyword? (car pair))+286
(keyword->string (car pair))+287
(call-with-output-string+288
(lambda (p) (write (car pair) p)))))+289
(rendered (field-value->string (cdr pair))))+290
(string-append key "="+291
(if (field-value-needs-quoting? rendered)+292
(call-with-output-string+293
(lambda (p) (write rendered p)))+294
rendered)))) 295
296
;; Build a text-format log line. 297
(define (format-text-line ts level-num message fields)@@ -218,7 +299,7 @@
299
" [" 300
(level-number->tag level-num) 301
"] "−221
message)))+302
(escape-control-chars message)))) 303
(string-append 304
(apply string-append parts) 305
(if (null? fields)@@ -239,6 +320,9 @@
320
;; Core Log Dispatch 321
;; ============================================================ 322
+323
;; Last-resort fallback line used when formatting a structured log+324
;; entry itself raises. Never raises; at worst the port write fails+325
;; and the outer guard catches that too. 326
;; Last-resort fallback line used when formatting a structured log 327
;; entry itself raises. Never raises; at worst the port write fails 328
;; and the outer guard catches that too.@@ -246,7 +330,8 @@
330
(guard (e (else #f)) 331
(write-string 332
(string-append "[" (level-number->tag level-num)−249
"] " message " <log-format-failed>\n")+333
"] " (escape-control-chars message)+334
" <log-format-failed>\n") 335
port) 336
(flush-output-port port))) 337
test/gate-source-under-test.shadded
@@ -0,0 +1,178 @@
+1
#!/usr/bin/env bash+2
#+3
# gate-source-under-test.sh — run this repo's tests against THIS REPO'S SOURCE.+4
#+5
# WHY THIS EXISTS. The `sigil` binary embeds a copy of `(sigil log)`, and that+6
# copy wins over the project's own source, over its built .sgb, and over an+7
# explicit from-path redirect. So plain `sigil test` in this repo is green+8
# about the binary's bundled copy and never reads src/sigil/log.sgl at all —+9
# demonstrated by appending a syntax error to that file and watching the suite+10
# produce an identical result. See the folio note+11
# `topics/sigil-cli-bundle-shadows-extracted-package-modules`.+12
#+13
# HOW IT GETS AROUND IT. The one thing the binary cannot shadow is a module+14
# name it does not embed. This gate generates a copy of the library with its+15
# `define-library` head renamed to `(loguut log)`, drops it in a throwaway+16
# project under /tmp, rewrites each test file's import to match, and runs the+17
# suite there.+18
#+19
# WHAT MAKES THE COPY TRUSTWORTHY. Two things, and the gate fails SETUP if+20
# either does not hold:+21
# * the copy is generated from src/sigil/log.sgl on every run, never committed;+22
# * the diff between original and copy is asserted to be EXACTLY the renamed+23
# line, so the gate cannot quietly be testing something else.+24
#+25
# Outcomes, which are four and not two:+26
# GREEN every arm passed against this repo's source+27
# RED the source is under test and an arm failed+28
# SETUP-FAILED the source was never put under test; says nothing about it+29
# TIMED-OUT bounded wait elapsed; says which checks did not run+30
#+31
# Nothing is written inside the repo: all scratch lives under /tmp.+32
+33
set -u+34
+35
REPO="$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd)"+36
SRC="$REPO/src/sigil/log.sgl"+37
UUT_NAME="loguut"+38
TIMEOUT_SECS="${GATE_TIMEOUT_SECS:-300}"+39
WORK="$(mktemp -d /tmp/sigil-log-uut.XXXXXX)"+40
+41
setup_failed() {+42
echo+43
echo "SETUP-FAILED: $*"+44
echo " The library was NOT put under test. This result says nothing about"+45
echo " whether the source is correct — do not read it as a pass or a fail."+46
echo " Scratch left for inspection: $WORK"+47
exit 70+48
}+49
+50
echo "=== gate-source-under-test ==="+51
echo "repo: $REPO"+52
echo "source: $SRC"+53
[ -f "$SRC" ] || setup_failed "no library source at $SRC"+54
echo "src-sha: $(sha256sum "$SRC" | cut -d' ' -f1)"+55
echo "sigil: $(command -v sigil) -> $(sigil --version 2>&1 | tr -d '\033' | sed 's/\[[0-9]*m//g')"+56
echo "scratch: $WORK"+57
echo+58
+59
# --- Establish the shadowing this gate exists to route around -----------------+60
# A presence probe whose healthy answer is POSITIVE: the bundled copy must be+61
# reachable with no project at all. If it is not, the premise has changed and+62
# the rename is unnecessary — which the reader needs told, loudly.+63
mkdir -p "$WORK/shadowcheck/test"+64
cat > "$WORK/shadowcheck/test/test-s.sgl" <<'EOF'+65
(import (sigil test) (sigil log))+66
(test-group "g" (test "bundled (sigil log) resolves with no project" (assert-true #t)))+67
(run-tests)+68
EOF+69
( cd "$WORK/shadowcheck" && sigil test --sgl >/dev/null 2>&1 )+70
if [ $? -ne 0 ]; then+71
echo "NOTE: (sigil log) did NOT resolve in a project with no dependencies."+72
echo " The binary may no longer embed it. This gate still works, but the"+73
echo " plain 'sigil test' in this repo may now be meaningful on its own."+74
echo " Re-read topics/sigil-cli-bundle-shadows-extracted-package-modules."+75
echo+76
fi+77
+78
# --- Generate the renamed library --------------------------------------------+79
mkdir -p "$WORK/proj/src/$UUT_NAME" "$WORK/proj/test"+80
COPY="$WORK/proj/src/$UUT_NAME/log.sgl"+81
sed "s/^(define-library (sigil log)\$/(define-library ($UUT_NAME log)/" "$SRC" > "$COPY"+82
+83
CHANGED=$(diff "$SRC" "$COPY" | grep -c '^[<>]')+84
if [ "$CHANGED" -ne 2 ]; then+85
echo "--- diff between source and renamed copy ---"+86
diff "$SRC" "$COPY" | head -40+87
setup_failed "expected exactly one renamed line (2 diff lines), got $CHANGED"+88
fi+89
grep -q "^(define-library ($UUT_NAME log)\$" "$COPY" \+90
|| setup_failed "the rename did not land in the copy"+91
echo "rename: 1 line, verified ($(sha256sum "$COPY" | cut -d' ' -f1))"+92
+93
cat > "$WORK/proj/package.sgl" <<EOF+94
(package+95
name: "$UUT_NAME"+96
version: "0.0.0"+97
sigil: "^0.14"+98
description: "throwaway harness — generated by test/gate-source-under-test.sh"+99
license: "BSD-3-Clause")+100
EOF+101
+102
+103
# The throwaway project still needs its dependency closure resolved: the copy's+104
# imports name stdlib modules, and `sigil test` refuses to start without them.+105
( cd "$WORK/proj" && timeout "$TIMEOUT_SECS" sigil deps install > "$WORK/deps.log" 2>&1 )+106
DEPS_RC=$?+107
if [ "$DEPS_RC" -ne 0 ]; then+108
sed 's/\x1b\[[0-9;]*m//g' "$WORK/deps.log"+109
setup_failed "sigil deps install failed in the harness project (rc=$DEPS_RC)"+110
fi+111
# --- Copy each test file, rewriting its import -------------------------------+112
# Auto-discovery needs the test- prefix, so test/uut/forgery-arms.sgl is named+113
# to stay OUT of a plain `sigil test` run (where it would test the bundled copy+114
# and be permanently, uninformatively red) and is renamed back in here.+115
declare -a SUITES=()+116
copy_suite() { # src-path dest-basename+117
local from="$1" to="$WORK/proj/test/$2"+118
[ -f "$from" ] || setup_failed "expected test file missing: $from"+119
local want; want=$(grep -c '(sigil log)' "$from")+120
[ "$want" -gt 0 ] || setup_failed "$from does not import (sigil log); nothing to rewrite"+121
sed "s/(sigil log)/($UUT_NAME log)/g" "$from" > "$to"+122
local got; got=$(diff "$from" "$to" | grep -c '^[<>]')+123
[ "$got" -eq $(( want * 2 )) ] \+124
|| setup_failed "rewriting $from changed $got diff lines, expected $(( want * 2 ))"+125
SUITES+=("$2")+126
}+127
copy_suite "$REPO/test/test-log.sgl" "test-log.sgl"+128
copy_suite "$REPO/test/uut/forgery-arms.sgl" "test-forgery.sgl"+129
echo "suites: ${SUITES[*]}"+130
echo+131
+132
# --- Prove the harness is running the COPY, not the bundle -------------------+133
# Without this the whole gate could pass for free: if (loguut log) silently+134
# fell back to something else, every arm below would be about that something.+135
cat > "$WORK/proj/test/test-presence.sgl" <<EOF+136
(import (sigil test) ($UUT_NAME log) (sigil io))+137
(test-group "harness presence"+138
(test "the renamed library is the one loaded"+139
;; A value only THIS copy can produce: a field value that needs quoting.+140
;; Pre-fix source renders it bare, post-fix quoted — either way the module+141
;; must load and log, or the harness is not running the copy at all.+142
(let ((port (open-output-string)))+143
(log-configure! level: 'info format: 'text target: port)+144
(log-info "presence" k: "a b")+145
(assert-true (string? (get-output-string port))))))+146
(run-tests)+147
EOF+148
+149
# --- Run ----------------------------------------------------------------------+150
LOG="$WORK/run.log"+151
( cd "$WORK/proj" && timeout "$TIMEOUT_SECS" sigil test --sgl > "$LOG" 2>&1 )+152
RC=$?+153
+154
sed 's/\x1b\[[0-9;]*m//g' "$LOG" > "$WORK/run.txt"+155
cat "$WORK/run.txt"+156
+157
if [ "$RC" -eq 124 ]; then+158
echo+159
echo "TIMED-OUT after ${TIMEOUT_SECS}s. Everything collected is above; the"+160
echo "arms that had not reported by then did not run and are UNKNOWN, not green."+161
echo "Scratch: $WORK"+162
exit 124+163
fi+164
+165
if ! grep -q 'the renamed library is the one loaded' "$WORK/run.txt"; then+166
setup_failed "the presence arm did not report; the harness may not have loaded the copy"+167
fi+168
+169
echo+170
echo "--- verdict ---"+171
echo "rc: $RC"+172
if [ "$RC" -eq 0 ]; then+173
echo "GREEN — every arm passed against $SRC"+174
else+175
echo "RED — the source IS under test and at least one arm failed (see above)"+176
fi+177
rm -rf "$WORK"+178
exit "$RC"test/uut/forgery-arms.sgladded
@@ -0,0 +1,277 @@
+1
;;; Log-forgery tests for (sigil log)'s TEXT formatter.+2
;;;+3
;;; The text format is the DEFAULT, and before this suite existed a+4
;;; string field value was written raw and unquoted after `key=`. Any+5
;;; attacker-controlled string could therefore append convincing+6
;;; `key=value` pairs — or, with a newline, a whole extra log line — to+7
;;; a log entry written about it.+8
;;;+9
;;; The real attack, and the reason these arms exist: the Slate node's+10
;;; anti-DNS-rebinding path answers 421 and logs the request's `Host`+11
;;; header. A hostile Host could make a REFUSED request read as ALLOWED+12
;;; in the node's own audit line.+13
;;;+14
;;; EVERY ARM HERE ASSERTS WHAT THE LINE *PARSES AS*, not what it+15
;;; contains. A `string-contains?` arm passes this defect forever: the+16
;;; forged text is present in both the broken and the fixed rendering,+17
;;; only its parse differs.+18
+19
(import (sigil test)+20
(sigil log)+21
(sigil io)+22
(sigil string))+23
+24
;; ============================================================+25
;; A minimal logfmt reader+26
;; ============================================================+27
;;+28
;; Deliberately written the way a log CONSUMER would write one, with no+29
;; knowledge of the logger's internals: a key is a run of characters up+30
;; to `=`; a value is either a `"`-quoted, backslash-escaped string or a+31
;; bare run up to the next space. A bare token containing no `=` (the+32
;; prose message) is not a field and is skipped.+33
+34
;; Any of these ends a bare token: a log line is one line, and a field+35
;; value that is not quoted cannot contain whitespace.+36
(define (logfmt-space? c)+37
(or (char=? c #\space) (char=? c #\newline)+38
(char=? c #\return) (char=? c #\tab)))+39
+40
(define (parse-logfmt s)+41
(let ((n (string-length s)))+42
(let loop ((i 0) (acc '()))+43
(cond+44
((>= i n) (reverse acc))+45
((logfmt-space? (string-ref s i)) (loop (+ i 1) acc))+46
(else+47
(let key-loop ((j i))+48
(cond+49
((>= j n) (reverse acc))+50
((logfmt-space? (string-ref s j)) (loop (+ j 1) acc))+51
((char=? (string-ref s j) #\=)+52
(let ((key (substring s i j)))+53
(if (and (< (+ j 1) n) (char=? (string-ref s (+ j 1)) #\"))+54
(let val-loop ((k (+ j 2)) (out '()))+55
(cond+56
((>= k n)+57
(loop k (cons (cons key (list->string (reverse out))) acc)))+58
((char=? (string-ref s k) #\\)+59
(if (< (+ k 1) n)+60
(let ((e (string-ref s (+ k 1))))+61
(val-loop (+ k 2)+62
(cons (cond ((char=? e #\n) #\newline)+63
((char=? e #\r) #\return)+64
((char=? e #\t) #\tab)+65
(else e))+66
out)))+67
(val-loop (+ k 1) out)))+68
((char=? (string-ref s k) #\")+69
(loop (+ k 1) (cons (cons key (list->string (reverse out))) acc)))+70
(else (val-loop (+ k 1) (cons (string-ref s k) out)))))+71
(let bare-loop ((k (+ j 1)))+72
(if (or (>= k n) (logfmt-space? (string-ref s k)))+73
(loop k (cons (cons key (substring s (+ j 1) k)) acc))+74
(bare-loop (+ k 1)))))))+75
(else (key-loop (+ j 1))))))))))+76
+77
;; Capture one text-format log line and return it verbatim.+78
(define (capture thunk)+79
(let ((port (open-output-string)))+80
(log-configure! level: 'info format: 'text target: port)+81
(thunk)+82
(get-output-string port)))+83
+84
;; Parse the fields of a captured line.+85
(define (fields-of line)+86
(let ((i (string-find line "] ")))+87
(if i+88
(parse-logfmt (substring line (+ i 2) (string-length line)))+89
'())))+90
+91
(define (field line key)+92
(let ((hit (assoc key (fields-of line))))+93
(and (pair? hit) (cdr hit))))+94
+95
(define (count-char s ch)+96
(let ((n (string-length s)))+97
(let loop ((i 0) (c 0))+98
(if (>= i n)+99
c+100
(loop (+ i 1) (if (char=? (string-ref s i) ch) (+ c 1) c))))))+101
+102
;; ============================================================+103
;; The reader itself must be able to fail+104
;; ============================================================+105
;;+106
;; parse-logfmt is the instrument every arm below depends on. If it+107
;; silently returned '() for everything, every "no forged field"+108
;; assertion would pass for free. These are its positive controls.+109
+110
(test-group "logfmt reader (instrument controls)"+111
(test "reads bare fields"+112
(let ((f (parse-logfmt "a=1 b=two")))+113
(assert-equal "1" (cdr (assoc "a" f)))+114
(assert-equal "two" (cdr (assoc "b" f)))+115
(assert-equal 2 (length f))))+116
+117
(test "reads quoted fields and unescapes them"+118
(let ((f (parse-logfmt "a=\"x y\" b=\"say \\\"hi\\\"\" c=\"one\\ntwo\"")))+119
(assert-equal "x y" (cdr (assoc "a" f)))+120
(assert-equal "say \"hi\"" (cdr (assoc "b" f)))+121
(assert-equal "one\ntwo" (cdr (assoc "c" f)))))+122
+123
(test "skips a prose token that is not a field"+124
(let ((f (parse-logfmt "refused host=example port=443")))+125
(assert-false (assoc "refused" f))+126
(assert-equal 2 (length f))))+127
+128
(test "DOES see fields hidden in a raw value — the defect, stated"+129
;; This is what the pre-fix formatter produced. The reader must be+130
;; able to see the forgery, or it could not detect its absence.+131
(let ((f (parse-logfmt "host-header=evil.example status=200")))+132
(assert-equal "200" (cdr (assoc "status" f))))))+133
+134
;; ============================================================+135
;; Field forgery — the real attack+136
;; ============================================================+137
+138
(test-group "text format: a field value cannot forge fields"+139
(test "the Slate 421 Host-header attack produces ONE field"+140
;; The shape from packages/slate-cli: a 421 refusal logging the+141
;; request's Host header, with a Host chosen to make the refusal+142
;; read as an allow.+143
(let* ((hostile "evil.example status=200 reason=host-allowed")+144
(line (capture (lambda () (log-warn "refused" host-header: hostile)))))+145
(assert-false (field line "status"))+146
(assert-false (field line "reason"))+147
(assert-equal hostile (field line "host-header"))+148
(assert-equal 1 (length (fields-of line)))))+149
+150
(test "a value crafted to inject allowed=true does not produce an allowed field"+151
(let* ((hostile "attacker.example allowed=true")+152
(line (capture (lambda () (log-warn "refused" host-header: hostile)))))+153
(assert-false (field line "allowed"))+154
(assert-equal hostile (field line "host-header"))))+155
+156
(test "a value cannot forge a field alongside real ones"+157
(let* ((hostile "h status=200")+158
(line (capture (lambda ()+159
(log-warn "refused" host-header: hostile status: 421)))))+160
;; The genuine status: field must survive and must be the 421 one.+161
(assert-equal "421" (field line "status"))+162
(assert-equal hostile (field line "host-header"))+163
(assert-equal 2 (length (fields-of line)))))+164
+165
(test "a value containing a newline cannot forge a whole log line"+166
(let* ((hostile "h\n2026-01-01T00:00:00Z [INFO] request allowed=true")+167
(line (capture (lambda () (log-warn "refused" host-header: hostile)))))+168
;; One log event is exactly one line: a single trailing newline.+169
(assert-equal 1 (count-char line #\newline))+170
(assert-false (field line "allowed"))+171
(assert-equal hostile (field line "host-header"))))+172
+173
(test "a value containing a carriage return cannot split the line"+174
(let* ((hostile "h\r[INFO] allowed=true")+175
(line (capture (lambda () (log-warn "refused" host-header: hostile)))))+176
(assert-equal 0 (count-char line #\return))+177
(assert-false (field line "allowed"))+178
(assert-equal hostile (field line "host-header"))))+179
+180
(test "a value containing quotes round-trips and forges nothing"+181
(let* ((hostile "he said \"a=b\" loudly")+182
(line (capture (lambda () (log-warn "refused" host-header: hostile)))))+183
(assert-false (field line "b\""))+184
(assert-equal hostile (field line "host-header"))+185
(assert-equal 1 (length (fields-of line)))))+186
+187
(test "a value ending in a backslash does not swallow the closing quote"+188
(let* ((hostile "trailing\\")+189
(line (capture (lambda ()+190
(log-warn "refused" host-header: hostile ok: 1)))))+191
(assert-equal hostile (field line "host-header"))+192
(assert-equal "1" (field line "ok"))))+193
+194
(test "a value containing a tab cannot start a new field"+195
(let* ((hostile "h\tallowed=true")+196
(line (capture (lambda () (log-warn "refused" host-header: hostile)))))+197
(assert-false (field line "allowed"))+198
(assert-equal hostile (field line "host-header"))))+199
+200
(test "a compound value carrying a hostile string forges nothing"+201
(let ((line (capture (lambda ()+202
(log-warn "refused"+203
detail: (list 1 "x allowed=true" 2))))))+204
(assert-false (field line "allowed"))+205
(assert-equal 1 (length (fields-of line)))))+206
+207
(test "an empty value is a present, empty field — not a missing one"+208
(let ((line (capture (lambda () (log-warn "refused" host-header: "" ok: 1)))))+209
(assert-equal "" (field line "host-header"))+210
(assert-equal "1" (field line "ok"))+211
(assert-equal 2 (length (fields-of line))))))+212
+213
;; ============================================================+214
;; The message is prose, and its ONE guarantee+215
;; ============================================================+216
+217
(test-group "text format: message stays on one line"+218
(test "a newline in the message does not become a second line"+219
(let ((line (capture (lambda ()+220
(log-warn "a\n2026-01-01T00:00:00Z [INFO] b" ok: 1)))))+221
(assert-equal 1 (count-char line #\newline))+222
(assert-equal "1" (field line "ok"))))+223
+224
(test "ordinary message prose is untouched"+225
(let ((line (capture (lambda () (log-warn "Slow query on /api/v1" ms: 12)))))+226
(assert-true (string-contains? line "Slow query on /api/v1"))+227
(assert-equal "12" (field line "ms")))))+228
+229
;; ============================================================+230
;; Well-formed values must NOT have started being quoted+231
;; ============================================================+232
;;+233
;; Quoting is conditional. If these arms go red, every existing log line+234
;; in the estate changed shape and every human reading one has to relearn+235
;; the format — which is the cost this design exists to avoid.+236
+237
(test-group "text format: ordinary values render unquoted, as before"+238
(test "integers"+239
(let ((line (capture (lambda () (log-info "started" port: 8080)))))+240
(assert-true (string-contains? line "port=8080"))+241
(assert-false (string-contains? line "port=\"8080\""))))+242
+243
(test "a path"+244
(let ((line (capture (lambda () (log-info "req" path: "/api/v1/things")))))+245
(assert-true (string-contains? line "path=/api/v1/things"))))+246
+247
(test "a plain string"+248
(let ((line (capture (lambda () (log-info "req" user: "alice")))))+249
(assert-true (string-contains? line "user=alice"))))+250
+251
(test "symbols, booleans and reals"+252
(let ((line (capture (lambda () (log-info "s" v: 'a-symbol flag: #t n: 3.5)))))+253
(assert-true (string-contains? line "v=a-symbol"))+254
(assert-true (string-contains? line "flag=#t"))+255
(assert-true (string-contains? line "n=3.5"))))+256
+257
(test "a realistic well-formed Host header is not quoted"+258
(let ((line (capture (lambda () (log-info "req" host-header: "slate.local:8443")))))+259
(assert-true (string-contains? line "host-header=slate.local:8443"))+260
(assert-equal "slate.local:8443" (field line "host-header")))))+261
+262
;; ============================================================+263
;; JSON output was already safe and must stay that way+264
;; ============================================================+265
+266
(test-group "json format is unaffected"+267
(test "a hostile value stays one JSON string"+268
(let* ((hostile "evil.example status=200 reason=host-allowed")+269
(port (open-output-string)))+270
(log-configure! level: 'info format: 'json target: port)+271
(log-warn "refused" host-header: hostile)+272
(let ((out (get-output-string port)))+273
(assert-true (string-contains? out "\"host-header\""))+274
(assert-false (string-contains? out "\"status\"")))+275
(log-configure! format: 'text))))+276
+277
(run-tests)