Harden runtime input and bootstrap handling
ober
8ffab25157aa38932d086044481935c079da652d
--- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,18 +13,13 @@ jobs: verify: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4.3.1 - name: Install build tools - run: sudo apt-get update && sudo apt-get install -y build-essential curl ca-certificates ripgrep + run: sudo apt-get update && sudo apt-get install -y build-essential curl ca-certificates openssh-client ripgrep - name: Install jerbuild - run: | - set -eux - curl -fsSL "https://github.com/jerboa-lang/jerboa/releases/download/${JERBOA_VERSION}/jerbuild-linux-x86_64" -o /usr/local/bin/jerbuild - chmod +x /usr/local/bin/jerbuild - env: - JERBOA_VERSION: v0.2.3 + run: support/install-verified-jerbuild.sh /usr/local/bin/jerbuild - name: Verify run: make verify --- 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: Install scanner tools run: sudo apt-get update && sudo apt-get install -y ripgrep --- a/Makefile +++ b/Makefile @@ -99,7 +99,7 @@ release-evidence: verify { git rev-parse HEAD 2>/dev/null || true; } > $(EVIDENCE_DIR)/git-commit.txt git status --short > $(EVIDENCE_DIR)/git-status.txt git diff --stat > $(EVIDENCE_DIR)/diff-stat.txt - { printf 'JERBOA_VERSION=%s\n' '$(JERBOA_VERSION)'; "$(JERBUILD)" --version; if "$(JERBUILD)" --jerboa-home >/dev/null 2>&1; then echo "jerboa_home_status=present"; else echo "jerboa_home_status=missing"; fi; uname -srm; env | LC_ALL=C sort | grep -E '^(JAWK_ALLOW_FILE_IO|JAWK_ALLOW_SYSTEM|JAWK_EXPOSE_ENVIRON|JAWK_MAX_PROGRAM_CHARS|JAWK_MAX_RECORD_CHARS)=' || true; } > $(EVIDENCE_DIR)/build-env.txt + { printf 'JERBOA_VERSION=%s\n' '$(JERBOA_VERSION)'; "$(JERBUILD)" --version; if "$(JERBUILD)" --jerboa-home >/dev/null 2>&1; then echo "jerboa_home_status=present"; else echo "jerboa_home_status=missing"; fi; uname -srm; env | LC_ALL=C sort | grep -E '^(JAWK_ALLOW_FILE_IO|JAWK_ALLOW_SYSTEM|JAWK_EXPOSE_ENVIRON|JAWK_MAX_PROGRAM_CHARS|JAWK_MAX_RECORD_CHARS|JAWK_MAX_REGEX_CACHE_ENTRIES)=' || true; } > $(EVIDENCE_DIR)/build-env.txt $(MAKE) security > $(EVIDENCE_DIR)/security.log 2>&1 $(MAKE) parser-corpus > $(EVIDENCE_DIR)/parser-corpus.log 2>&1 $(MAKE) test > $(EVIDENCE_DIR)/test.log 2>&1 --- a/README.md +++ b/README.md @@ -28,6 +28,15 @@ legacy AWK capabilities: variables through `ENVIRON`; by default `ENVIRON` is empty. - `JAWK_MAX_PROGRAM_CHARS` caps program text, default 1 MiB. - `JAWK_MAX_RECORD_CHARS` caps input records, default 1 MiB. +- `JAWK_MAX_REGEX_CACHE_ENTRIES` bounds each evaluation's dynamic-regex LRU, + default 64. Regex, range-pattern, random-number, and multi-character + record-buffer state is never shared between evaluations. Transient caches + and buffers are cleared during evaluation cleanup. + +Library embeddings must create an independent environment with +`make-initial-env` for each evaluation and use it only from the thread that +created it. Runtime entry points reject cross-thread reuse. Concurrent +evaluations are supported when each worker creates and owns its own environment. Generated `jawk` binaries and native build artifacts are ignored and must not be tracked. --- a/lib/jerboa-awk/builtins/math.sls +++ b/lib/jerboa-awk/builtins/math.sls @@ -44,38 +44,38 @@ ;; Chez Scheme doesn't have SRFI-27, so we use a simple LCG seeded PRNG ;; that produces floats in [0, 1). - (define *awk-rand-seed* 1) - (define *awk-rand-state* 0) - (define *awk-rand-initialized* #f) + (define (awk-rand-init! env) + (unless (awk-env-rand-initialized? env) + (awk-env-rand-state-set! env (awk-env-rand-seed env)) + (awk-env-rand-initialized?-set! env #t))) - (define (awk-rand-init!) - (unless *awk-rand-initialized* - (set! *awk-rand-state* *awk-rand-seed*) - (set! *awk-rand-initialized* #t))) - - (define (awk-rand-next!) + (define (awk-rand-next! env) ;; LCG: same constants as glibc - (set! *awk-rand-state* - (mod (+ (* 1103515245 *awk-rand-state*) 12345) - (expt 2 31))) - (/ (inexact *awk-rand-state*) (inexact (expt 2 31)))) + (let ((next-state + (mod (+ (* 1103515245 (awk-env-rand-state env)) 12345) + (expt 2 31)))) + (awk-env-rand-state-set! env next-state) + (/ (inexact next-state) (inexact (expt 2 31))))) (define (awk-builtin-rand env args) - (awk-rand-init!) - (make-awk-number (awk-rand-next!))) + (env-assert-owner! 'awk-builtin-rand env) + (awk-rand-init! env) + (make-awk-number (awk-rand-next! env))) (define (awk-builtin-srand env args) - (let ((old-seed *awk-rand-seed*)) + (env-assert-owner! 'awk-builtin-srand env) + (let ((old-seed (awk-env-rand-seed env))) (if (null? args) - (begin - (set! *awk-rand-seed* (time-second (current-time))) - (set! *awk-rand-state* *awk-rand-seed*) - (set! *awk-rand-initialized* #t) + (let ((new-seed (time-second (current-time)))) + (awk-env-rand-seed-set! env new-seed) + (awk-env-rand-state-set! env new-seed) + (awk-env-rand-initialized?-set! env #t) (make-awk-number old-seed)) - (begin - (set! *awk-rand-seed* (inexact->exact (floor (awk->number (car args))))) - (set! *awk-rand-state* *awk-rand-seed*) - (set! *awk-rand-initialized* #t) + (let ((new-seed + (inexact->exact (floor (awk->number (car args)))))) + (awk-env-rand-seed-set! env new-seed) + (awk-env-rand-state-set! env new-seed) + (awk-env-rand-initialized?-set! env #t) (make-awk-number old-seed))))) ) ;; end library --- a/lib/jerboa-awk/builtins/string.sls +++ b/lib/jerboa-awk/builtins/string.sls @@ -62,7 +62,7 @@ ((string=? fs " ") (split-on-whitespace str)) ((string=? fs "") (map string (string->list str))) ((= (string-length fs) 1) (split-on-char str (string-ref fs 0))) - (else (pregexp-split fs str)))) + (else (pregexp-split (env-regex env fs) str)))) (arr (env-get-array env arr-name))) ;; Clear array (hash-clear! arr) @@ -79,7 +79,7 @@ (awk-expr-regex-pattern ere) (awk->string ere))) (target-str (awk->string target-expr)) - (m (pregexp-match-positions pattern target-str))) + (m (pregexp-match-positions (env-regex env pattern) target-str))) (if m (let* ((pos (car m)) ;; first element is the full match (start . end) (start (car pos)) @@ -100,7 +100,7 @@ (target-str (awk->string target-expr)) (count 0)) (let loop ((pos 0) (result '())) - (let ((m (pregexp-match-positions pattern target-str pos))) + (let ((m (pregexp-match-positions (env-regex env pattern) target-str pos))) (if (not m) (let ((final (string-append (apply string-append (reverse result)) (substring target-str pos (string-length target-str))))) @@ -148,7 +148,7 @@ (if (awk-expr-regex? p) (awk-expr-regex-pattern p) (awk->string p)))) - (m (pregexp-match-positions pattern str))) + (m (pregexp-match-positions (env-regex env pattern) str))) (if m (let* ((pos (car m)) ;; full match (start . end) (start (car pos)) --- a/lib/jerboa-awk/main.sls +++ b/lib/jerboa-awk/main.sls @@ -14,9 +14,6 @@ (jerboa-awk builtins io) (std pregexp)) - ;; Buffer for multi-char RS record splitting - (define *record-buffer* '()) - (define default-max-program-chars (* 1024 1024)) (define default-max-record-chars (* 1024 1024)) @@ -61,33 +58,35 @@ (let* ((program-text (check-program-text! program-text)) (prog (parse-awk-string program-text)) (env (make-initial-env))) - ;; Apply -F - (when fs (env-set! env 'FS (make-awk-string fs))) - ;; Apply -v assignments (before BEGIN) - (for-each (lambda (va) (apply-var-assign! env va)) var-assigns) - ;; Register user functions - (let-values (((ks vs) (hashtable-entries (awk-program-functions prog)))) - (let ((len (vector-length ks))) - (let loop ((i 0)) - (when (< i len) - (hash-put! (awk-env-functions env) - (vector-ref ks i) (vector-ref vs i)) - (loop (+ i 1)))))) - ;; Initialize ARGV and ENVIRON - (env-init-argv! env (cons "awk" files)) - (env-init-environ! env) - ;; Run BEGIN - (run-rules env prog 'begin) - ;; Process files - (if (null? files) - (process-stream env prog (current-input-port) "-") - (process-files env prog files)) - ;; Run END - (run-rules env prog 'end) - ;; Cleanup - (env-close-all! env) - (when (awk-env-exit-code env) - (exit (awk-env-exit-code env)))))) + (dynamic-wind + (lambda () (void)) + (lambda () + ;; Apply -F + (when fs (env-set! env 'FS (make-awk-string fs))) + ;; Apply -v assignments (before BEGIN) + (for-each (lambda (va) (apply-var-assign! env va)) var-assigns) + ;; Register user functions + (let-values (((ks vs) (hashtable-entries (awk-program-functions prog)))) + (let ((len (vector-length ks))) + (let loop ((i 0)) + (when (< i len) + (hash-put! (awk-env-functions env) + (vector-ref ks i) (vector-ref vs i)) + (loop (+ i 1)))))) + ;; Initialize ARGV and ENVIRON + (env-init-argv! env (cons "awk" files)) + (env-init-environ! env) + ;; Run BEGIN + (run-rules env prog 'begin) + ;; Process files + (if (null? files) + (process-stream env prog (current-input-port) "-") + (process-files env prog files)) + ;; Run END + (run-rules env prog 'end) + (when (awk-env-exit-code env) + (exit (awk-env-exit-code env)))) + (lambda () (env-close-all! env)))))) (define (parse-args args) (let loop ((args args) (prog #f) (files '()) (vars '()) (fs #f) (expect #f)) @@ -179,14 +178,14 @@ (awk-env-filename-set! env filename) (env-set! env 'FILENAME (make-awk-string filename)) (awk-env-fnr-set! env 0) - (set! *record-buffer* '()) + (awk-env-record-buffer-set! env '()) (let ((rs (env-get-str env 'RS))) (guard (e ((awk-signal-exit? e) (awk-env-exit-code-set! env (awk-signal-exit-code e))) ((awk-signal-nextfile? e) (void))) (let loop () - (let ((record (read-record port rs))) + (let ((record (read-record env port rs))) (when record (awk-env-nr-set! env (+ (awk-env-nr env) 1)) (awk-env-fnr-set! env (+ (awk-env-fnr env) 1)) @@ -207,7 +206,7 @@ (awk-program-rules prog))) (loop))))))) - (define (read-record port rs) + (define (read-record env port rs) (cond ((string=? rs "\n") (let ((line (get-line port))) @@ -245,23 +244,23 @@ (loop (cons c chars) next-count)))))))) (else ;; Multi-char RS — regex split, buffered - (if (pair? *record-buffer*) - (let ((rec (car *record-buffer*))) - (set! *record-buffer* (cdr *record-buffer*)) + (if (pair? (awk-env-record-buffer env)) + (let ((rec (car (awk-env-record-buffer env)))) + (awk-env-record-buffer-set! env (cdr (awk-env-record-buffer env))) rec) (let loop ((chars '()) (count 0)) (let ((c (read-char port))) (if (eof-object? c) (if (null? chars) #f (let* ((all (list->string (reverse chars))) - (records (check-records! (pregexp-split rs all))) + (records (check-records! (pregexp-split (env-regex env rs) all))) (records (if (and (pair? records) (string=? (last-element records) "")) (reverse (cdr (reverse records))) records))) (if (null? records) #f (begin - (set! *record-buffer* (cdr records)) + (awk-env-record-buffer-set! env (cdr records)) (car records))))) (let ((next-count (+ count 1))) (when (> next-count max-record-chars) @@ -279,10 +278,7 @@ [(awk-pattern-expr e) (awk->bool (eval-expr env e))] [(awk-pattern-range start-pat end-pat) - (let* ((key (or (eq-hashtable-ref *range-key-table* rule #f) - (let ((k (gensym))) - (eq-hashtable-set! *range-key-table* rule k) - k))) + (let* ((key rule) (states (awk-env-range-states env)) (in-range? (hash-ref states key #f))) (if in-range? @@ -299,9 +295,6 @@ #f)))] [_ #t])) - ;; Table to map rules to stable keys for range pattern state - (define *range-key-table* (make-eq-hashtable)) - ;;; Statement execution (define (exec-stmt env stmt) @@ -430,7 +423,7 @@ (make-awk-string val)] [(awk-expr-regex pattern) (let ((line (awk->string (env-get-field env 0)))) - (make-awk-number (if (pregexp-match-positions pattern line) 1 0)))] + (make-awk-number (if (pregexp-match-positions (env-regex env pattern) line) 1 0)))] [(awk-expr-var name) (env-get env name)] [(awk-expr-field idx-expr) @@ -496,7 +489,7 @@ (pat (if (awk-expr-regex? mpat) (awk-expr-regex-pattern mpat) (awk->string (eval-expr env mpat)))) - (matched? (pregexp-match-positions pat str))) + (matched? (pregexp-match-positions (env-regex env pat) str))) (make-awk-number (if negate? (if matched? 0 1) (if matched? 1 0))))] [(awk-expr-call _ _) (eval-call env expr)] --- a/lib/jerboa-awk/runtime.sls +++ b/lib/jerboa-awk/runtime.sls @@ -16,6 +16,12 @@ awk-env-input-files awk-env-input-files-set! awk-env-output-files awk-env-output-files-set! awk-env-range-states awk-env-range-states-set! + awk-env-regex-cache awk-env-regex-cache-set! + awk-env-regex-order awk-env-regex-order-set! + awk-env-record-buffer awk-env-record-buffer-set! + awk-env-rand-seed awk-env-rand-seed-set! + awk-env-rand-state awk-env-rand-state-set! + awk-env-rand-initialized? awk-env-rand-initialized?-set! awk-env-exit-code awk-env-exit-code-set! awk-env-local-frames awk-env-local-frames-set! make-initial-env @@ -52,7 +58,7 @@ ;; String helpers string-join string-contains string-prefix? ;; Regex cache - make-regex-cache regex-cache-lookup) + make-regex-cache regex-cache-lookup env-regex env-assert-owner!) (import (scheme) (only (jerboa runtime) @@ -116,32 +122,137 @@ (define (make-regex-cache) (make-hashtable equal-hash equal?)) - (define *regex-cache* (make-regex-cache)) + (define default-max-regex-cache-entries 64) + + (define max-regex-cache-entries + (let ((value (getenv "JAWK_MAX_REGEX_CACHE_ENTRIES"))) + (if value + (let ((n (string->number value))) + (if (and n (integer? n) (> n 0)) + n + default-max-regex-cache-entries)) + default-max-regex-cache-entries))) (define (regex-cache-lookup cache pattern) (let ((cached (hashtable-ref cache pattern #f))) (if cached (values cached #t) (let ((compiled (pregexp pattern))) + ;; This compatibility helper has no recency list. Bound it by + ;; clearing before insertion; evaluator-owned caches use env-regex + ;; below for true LRU eviction. + (when (>= (hashtable-size cache) max-regex-cache-entries) + (hashtable-clear! cache)) (hashtable-set! cache pattern compiled) (values compiled #f))))) + (define (remove-pattern pattern patterns) + (cond + ((null? patterns) '()) + ((string=? pattern (car patterns)) (cdr patterns)) + (else (cons (car patterns) (remove-pattern pattern (cdr patterns)))))) + + (define (drop-last patterns) + (cond + ((or (null? patterns) (null? (cdr patterns))) '()) + (else (cons (car patterns) (drop-last (cdr patterns)))))) + + (define (last-pattern patterns) + (if (null? (cdr patterns)) (car patterns) (last-pattern (cdr patterns)))) + ;;; ---- Execution state ---- - (define-record-type awk-env - (fields (mutable globals) - (mutable arrays) - (mutable functions) - (mutable fields) - (mutable nf) - (mutable nr) - (mutable fnr) - (mutable filename) - (mutable input-files) - (mutable output-files) - (mutable range-states) - (mutable exit-code) - (mutable local-frames))) + (define-record-type (awk-env %make-awk-env awk-env?) + (fields (mutable globals %awk-env-globals %awk-env-globals-set!) + (mutable arrays %awk-env-arrays %awk-env-arrays-set!) + (mutable functions %awk-env-functions %awk-env-functions-set!) + (mutable fields %awk-env-fields %awk-env-fields-set!) + (mutable nf %awk-env-nf %awk-env-nf-set!) + (mutable nr %awk-env-nr %awk-env-nr-set!) + (mutable fnr %awk-env-fnr %awk-env-fnr-set!) + (mutable filename %awk-env-filename %awk-env-filename-set!) + (mutable input-files %awk-env-input-files %awk-env-input-files-set!) + (mutable output-files %awk-env-output-files %awk-env-output-files-set!) + (mutable range-states %awk-env-range-states %awk-env-range-states-set!) + (mutable regex-cache %awk-env-regex-cache %awk-env-regex-cache-set!) + (mutable regex-order %awk-env-regex-order %awk-env-regex-order-set!) + (mutable record-buffer %awk-env-record-buffer %awk-env-record-buffer-set!) + (mutable rand-seed %awk-env-rand-seed %awk-env-rand-seed-set!) + (mutable rand-state %awk-env-rand-state %awk-env-rand-state-set!) + (mutable rand-initialized? %awk-env-rand-initialized? %awk-env-rand-initialized?-set!) + (mutable exit-code %awk-env-exit-code %awk-env-exit-code-set!) + (mutable local-frames %awk-env-local-frames %awk-env-local-frames-set!) + (immutable owner-thread %awk-env-owner-thread))) + + ;; Preserve the original public constructor surface. The evaluator-owned + ;; cache, buffer, PRNG, and thread fields are internal hardening state and + ;; are always initialized here rather than supplied by embedding callers. + (define (make-awk-env globals arrays functions fields nf nr fnr filename + input-files output-files range-states exit-code + local-frames) + (%make-awk-env globals arrays functions fields nf nr fnr filename + input-files output-files range-states + (make-regex-cache) '() '() + 1 0 #f + exit-code local-frames + (get-thread-id))) + + (define (env-assert-owner! who env) + (unless (= (%awk-env-owner-thread env) (get-thread-id)) + (error who "AWK evaluation environment used from a non-owner thread"))) + + ;; Even the low-level record accessors are part of the exported embedding + ;; surface. Wrap every one so callers cannot bypass the single-owner rule + ;; by reaching around the higher-level env-* procedures. + (define-syntax define-owned-accessors + (syntax-rules () + ((_ getter raw-getter setter raw-setter) + (begin + (define (getter env) + (env-assert-owner! 'getter env) + (raw-getter env)) + (define (setter env value) + (env-assert-owner! 'setter env) + (raw-setter env value)))))) + + (define-owned-accessors awk-env-globals %awk-env-globals awk-env-globals-set! %awk-env-globals-set!) + (define-owned-accessors awk-env-arrays %awk-env-arrays awk-env-arrays-set! %awk-env-arrays-set!) + (define-owned-accessors awk-env-functions %awk-env-functions awk-env-functions-set! %awk-env-functions-set!) + (define-owned-accessors awk-env-fields %awk-env-fields awk-env-fields-set! %awk-env-fields-set!) + (define-owned-accessors awk-env-nf %awk-env-nf awk-env-nf-set! %awk-env-nf-set!) + (define-owned-accessors awk-env-nr %awk-env-nr awk-env-nr-set! %awk-env-nr-set!) + (define-owned-accessors awk-env-fnr %awk-env-fnr awk-env-fnr-set! %awk-env-fnr-set!) + (define-owned-accessors awk-env-filename %awk-env-filename awk-env-filename-set! %awk-env-filename-set!) + (define-owned-accessors awk-env-input-files %awk-env-input-files awk-env-input-files-set! %awk-env-input-files-set!) + (define-owned-accessors awk-env-output-files %awk-env-output-files awk-env-output-files-set! %awk-env-output-files-set!) + (define-owned-accessors awk-env-range-states %awk-env-range-states awk-env-range-states-set! %awk-env-range-states-set!) + (define-owned-accessors awk-env-regex-cache %awk-env-regex-cache awk-env-regex-cache-set! %awk-env-regex-cache-set!) + (define-owned-accessors awk-env-regex-order %awk-env-regex-order awk-env-regex-order-set! %awk-env-regex-order-set!) + (define-owned-accessors awk-env-record-buffer %awk-env-record-buffer awk-env-record-buffer-set! %awk-env-record-buffer-set!) + (define-owned-accessors awk-env-rand-seed %awk-env-rand-seed awk-env-rand-seed-set! %awk-env-rand-seed-set!) + (define-owned-accessors awk-env-rand-state %awk-env-rand-state awk-env-rand-state-set! %awk-env-rand-state-set!) + (define-owned-accessors awk-env-rand-initialized? %awk-env-rand-initialized? awk-env-rand-initialized?-set! %awk-env-rand-initialized?-set!) + (define-owned-accessors awk-env-exit-code %awk-env-exit-code awk-env-exit-code-set! %awk-env-exit-code-set!) + (define-owned-accessors awk-env-local-frames %awk-env-local-frames awk-env-local-frames-set! %awk-env-local-frames-set!) + + (define (env-regex env pattern) + (env-assert-owner! 'env-regex env) + (let* ((cache (awk-env-regex-cache env)) + (cached (hashtable-ref cache pattern #f))) + (if cached + (begin + (awk-env-regex-order-set! + env (cons pattern (remove-pattern pattern (awk-env-regex-order env)))) + cached) + (let ((compiled (pregexp pattern)) + (order (awk-env-regex-order env))) + (when (>= (hashtable-size cache) max-regex-cache-entries) + (let ((oldest (last-pattern order))) + (hashtable-delete! cache oldest) + (set! order (drop-last order)))) + (hashtable-set! cache pattern compiled) + (awk-env-regex-order-set! env (cons pattern order)) + compiled)))) (define (make-initial-env) (let ((env (make-awk-env @@ -152,7 +263,10 @@ 0 0 0 "" ; nf, nr, fnr, filename (make-equal-hash-table) ; input-files (make-equal-hash-table) ; output-files - (make-equal-hash-table) ; range-states + ;; Range state is keyed by rule object identity. Structurally + ;; identical range rules are still distinct program locations + ;; and must not advance one another's state machines. + (make-eq-hashtable) ; range-states #f ; exit-code '()))) ; local-frames ;; Initialize predefined variables @@ -174,6 +288,7 @@ ;;; ---- Variable access ---- (define (env-get env name) + (env-assert-owner! 'env-get env) (let loop ((frames (awk-env-local-frames env))) (if (null? frames) ;; Check special variables @@ -189,6 +304,7 @@ (loop (cdr frames)))))) (define (env-set! env name val) + (env-assert-owner! 'env-set! env) (let ((v (->awk val))) ;; Check special variables (case name @@ -211,6 +327,7 @@ ;;; ---- Array access ---- (define (env-get-array env name) + (env-assert-owner! 'env-get-array env) (if (hash-key? (awk-env-arrays env) name) (hash-ref (awk-env-arrays env) name #f) (let ((arr (make-equal-hash-table))) @@ -238,12 +355,14 @@ ;;; ---- Field access ---- (define (env-get-field env idx) + (env-assert-owner! 'env-get-field env) (let ((fields (awk-env-fields env))) (if (and (>= idx 0) (< idx (vector-length fields))) (vector-ref fields idx) (make-awk-string "")))) (define (env-set-field! env idx val) + (env-assert-owner! 'env-set-field! env) (let ((v (->awk val)) (nf (awk-env-nf env))) (when (> idx nf) @@ -260,6 +379,7 @@ (env-rebuild-record! env)))) (define (env-set-record! env str) + (env-assert-owner! 'env-set-record! env) (let ((fields (env-split-fields env str))) (let ((nf (length fields)) (vec (list->vector (cons (make-awk-string str) @@ -298,6 +418,7 @@ ;;; ---- Field splitting ---- (define (env-split-fields env str) + (env-assert-owner! 'env-split-fields env) (let ((fs (env-get-str env 'FS))) (cond ;; Default FS=" " -- split on runs of whitespace, strip leading/trailing @@ -311,7 +432,7 @@ (split-on-char str (string-ref fs 0))) ;; Multi-char FS -- treat as regex (else - (split-on-regex str fs))))) + (pregexp-split (env-regex env fs) str))))) (define (split-on-whitespace str) (let* ((trimmed (string-trim-both str)) @@ -396,20 +517,18 @@ (if value (cons (string-append key "=" value) out) out))))) '())) - (define env-init-environ! - (let ((initialized? #f)) - (lambda (env) - (unless initialized? - (set! initialized? #t) - (let ((arr (env-get-array env 'ENVIRON))) - (for-each - (lambda (entry) - (let ((eq-pos (string-contains entry "="))) - (when eq-pos - (hash-put! arr - (substring entry 0 eq-pos) - (make-awk-string (substring entry (+ eq-pos 1) (string-length entry))))))) - (get-all-environ))))))) + (define (env-init-environ! env) + ;; ENVIRON belongs to each evaluation. A process-global initialized flag + ;; made all but the first embedded run observe an empty environment. + (let ((arr (env-get-array env 'ENVIRON))) + (for-each + (lambda (entry) + (let ((eq-pos (string-contains entry "="))) + (when eq-pos + (hash-put! arr + (substring entry 0 eq-pos) + (make-awk-string (substring entry (+ eq-pos 1) (string-length entry))))))) + (get-all-environ)))) ;;; ---- I/O port management ---- @@ -488,6 +607,7 @@ "'")) (define (env-close-all! env) + (env-assert-owner! 'env-close-all! env) (hash-for-each (lambda (k p) (guard (e (else (void))) @@ -500,7 +620,11 @@ (close-port p))) (awk-env-input-files env)) (hash-clear! (awk-env-output-files env)) - (hash-clear! (awk-env-input-files env))) + (hash-clear! (awk-env-input-files env)) + (hash-clear! (awk-env-range-states env)) + (hashtable-clear! (awk-env-regex-cache env)) + (awk-env-regex-order-set! env '()) + (awk-env-record-buffer-set! env '())) (define (env-close-file! env name) (cond --- a/scripts/security-check.sh +++ b/scripts/security-check.sh @@ -144,4 +144,21 @@ if [[ -n "$host_fingerprint_matches" ]]; then exit 1 fi +for bootstrap_file in \ + support/install-verified-jerbuild.sh \ + support/jerbuild-bootstrap.lock \ + support/jerboa-release-signers; do + test -f "$bootstrap_file" || { echo "missing authenticated bootstrap input: $bootstrap_file" >&2; exit 1; } +done +grep -q 'ssh-keygen -Y verify' support/install-verified-jerbuild.sh +grep -q '^status=blocked-awaiting-authenticated-upstream-release$' support/jerbuild-bootstrap.lock +if grep -R -n -E 'jerbuild-linux|releases/download/.*/jerbuild' .github/workflows .build.yml 2>/dev/null; then + echo "unsigned Jerbuild bootstrap remains" >&2 + exit 1 +fi +if grep -R -n -E 'uses:[[:space:]]+[^[:space:]#]+@(v[0-9]+|main|master|stable|latest)([[:space:]#]|$)' .github/workflows 2>/dev/null; then + echo "mutable GitHub Action reference remains" >&2 + exit 1 +fi + echo "security-check: ok" new file mode 100755 --- /dev/null +++ b/support/install-verified-jerbuild.sh @@ -0,0 +1,58 @@ +#!/usr/bin/env bash +set -euo pipefail + +root=$(CDPATH= cd -- "$(dirname "$0")/.." && pwd) +lock=${JERBOA_JERBUILD_LOCK:-"$root/support/jerbuild-bootstrap.lock"} +signers="$root/support/jerboa-release-signers" +dest=${1:-"$root/.deps/bin/jerbuild"} + +read_value() { + local key=$1 + sed -n "s/^${key}=//p" "$lock" | tail -n 1 +} + +[[ -f "$lock" ]] || { echo "verified bootstrap blocked: missing lock" >&2; exit 1; } +status=$(read_value status) +if [[ "$status" != ready ]]; then + echo "verified bootstrap blocked: ${status:-lock-status-missing}" >&2 + exit 1 +fi + +base_url=$(read_value base_url) +asset=$(read_value asset) +expected=$(read_value sha256) +manifest=$(read_value manifest) +signature=$(read_value signature) +identity=$(read_value signer_identity) +namespace=$(read_value namespace) + +[[ "$base_url" == https://* ]] || { echo "bootstrap base URL must use HTTPS" >&2; exit 1; } +[[ "$asset" =~ ^[A-Za-z0-9._-]+$ ]] || { echo "unsafe bootstrap asset name" >&2; exit 1; } +[[ "$manifest" =~ ^[A-Za-z0-9._-]+$ ]] || { echo "unsafe manifest name" >&2; exit 1; } +[[ "$signature" =~ ^[A-Za-z0-9._-]+$ ]] || { echo "unsafe signature name" >&2; exit 1; } +[[ "$expected" =~ ^[0-9a-f]{64}$ ]] || { echo "invalid pinned SHA-256" >&2; exit 1; } +grep -Eq '^[[:space:]]*[^#[:space:]][^[:space:]]*[[:space:]]+ssh-(ed25519|rsa)[[:space:]]+' "$signers" || { + echo "verified bootstrap blocked: pinned signer entry missing" >&2 + exit 1 +} +command -v ssh-keygen >/dev/null || { echo "ssh-keygen is required" >&2; exit 1; } + +umask 077 +tmp=$(mktemp -d "${TMPDIR:-/tmp}/jerboa-bootstrap.XXXXXXXX") +trap 'rm -rf "$tmp"' EXIT +curl --fail --silent --show-error --location --proto '=https' --tlsv1.2 \ + "$base_url/$manifest" --output "$tmp/$manifest" +curl --fail --silent --show-error --location --proto '=https' --tlsv1.2 \ + "$base_url/$signature" --output "$tmp/$signature" +ssh-keygen -Y verify -f "$signers" -I "$identity" -n "${namespace:-file}" \ + -s "$tmp/$signature" < "$tmp/$manifest" + +manifest_digest=$(awk -v name="$asset" '$2 == name {print $1}' "$tmp/$manifest") +[[ "$manifest_digest" == "$expected" ]] || { echo "signed manifest digest mismatch" >&2; exit 1; } +curl --fail --silent --show-error --location --proto '=https' --tlsv1.2 \ + "$base_url/$asset" --output "$tmp/$asset" +actual=$(shasum -a 256 "$tmp/$asset" | awk '{print $1}') +[[ "$actual" == "$expected" ]] || { echo "jerbuild digest mismatch" >&2; exit 1; } +mkdir -p "$(dirname "$dest")" +install -m 0755 "$tmp/$asset" "$dest" +printf 'verified jerbuild sha256=%s\n' "$actual" new file mode 100644 --- /dev/null +++ b/support/jerboa-release-signers @@ -0,0 +1,2 @@ +# OpenSSH allowed-signers entries belong here. No authenticated Jerboa release +# identity has been published, so CI bootstrap remains deliberately blocked. new file mode 100644 --- /dev/null +++ b/support/jerbuild-bootstrap.lock @@ -0,0 +1,11 @@ +# Fail closed until the Jerboa producer publishes a signed manifest and a +# release identity is provisioned below. A versioned same-origin asset alone +# is not an authenticated bootstrap. +status=blocked-awaiting-authenticated-upstream-release +base_url= +asset= +sha256= +manifest= +signature= +signer_identity=jerboa-release +namespace=file --- a/tests/test-parser.ss +++ b/tests/test-parser.ss @@ -2,7 +2,11 @@ (import (scheme) (jerboa-awk parser) - (jerboa-awk ast)) + (jerboa-awk ast) + (jerboa-awk main) + (jerboa-awk value) + (jerboa-awk runtime) + (jerboa-awk builtins math)) (define pass 0) (define fail 0) @@ -83,5 +87,133 @@ (let ((s (make-string (+ (* 1024 1024) 1) #\x))) (parse-awk-string s))) +(test "dynamic regex cache is evaluation-local and bounded" + (let ((env-a (make-initial-env)) + (env-b (make-initial-env))) + (let loop ((i 0)) + (when (< i 256) + (env-regex env-a (string-append "pattern-" (number->string i))) + (loop (+ i 1)))) + (and (<= (hashtable-size (awk-env-regex-cache env-a)) 64) + (= (hashtable-size (awk-env-regex-cache env-b)) 0))) + #t) + +(test "dynamic regex cache evicts the least recently used entry" + (let ((env (make-initial-env))) + (let loop ((i 0)) + (when (< i 64) + (env-regex env (string-append "lru-" (number->string i))) + (loop (+ i 1)))) + ;; Refresh lru-0, then force one eviction. lru-1 is now the oldest. + (env-regex env "lru-0") + (env-regex env "lru-64") + (and (hashtable-ref (awk-env-regex-cache env) "lru-0" #f) + (not (hashtable-ref (awk-env-regex-cache env) "lru-1" #f)) + (not (not (hashtable-ref (awk-env-regex-cache env) "lru-64" #f))))) + #t) + +(test "record and range state are evaluation-local" + (let ((env-a (make-initial-env)) + (env-b (make-initial-env))) + (awk-env-record-buffer-set! env-a '("a" "b")) + (hash-put! (awk-env-range-states env-a) 'rule #t) + (and (null? (awk-env-record-buffer env-b)) + (= (hash-length (awk-env-range-states env-b)) 0))) + #t) + +(test "random state is evaluation-local" + (let ((env-a (make-initial-env)) + (env-b (make-initial-env)) + (seed (make-awk-number 12345))) + (awk-builtin-srand env-a (list seed)) + (awk-builtin-srand env-b (list seed)) + (let ((a1 (awk->number (awk-builtin-rand env-a '()))) + (b1 (awk->number (awk-builtin-rand env-b '()))) + (a2 (awk->number (awk-builtin-rand env-a '()))) + (b2 (awk->number (awk-builtin-rand env-b '())))) + (and (= a1 b1) (= a2 b2)))) + #t) + +(test "structurally identical range rules have independent state" + (let* ((program (parse-awk-string + "/start/,/end/ { print $0 } /start/,/end/ { print $0 }")) + (rules (awk-program-rules program)) + (first-rule (car rules)) + (second-rule (cadr rules)) + (env (make-initial-env)) + (states (awk-env-range-states env))) + (hash-put! states first-rule #t) + (and (not (eq? first-rule second-rule)) + (not (hash-ref states second-rule #f)))) + #t) + +(define (make-record-stream prefix count) + (let loop ((i 0) (parts '())) + (if (= i count) + (apply string-append (reverse parts)) + (loop (+ i 1) + (cons (string-append prefix "-" (number->string i) "\n") parts))))) + +(define (make-expected-stream prefix count) + (let loop ((i 0) (parts '())) + (if (= i count) + (apply string-append (reverse parts)) + (loop (+ i 1) + (cons (string-append "1 " prefix "-" (number->string i) "\n") parts))))) + +(define (evaluate-stream input) + (let ((input-port (open-input-string input)) + (output-port (open-output-string))) + (dynamic-wind + (lambda () (void)) + (lambda () + (parameterize ((current-input-port input-port) + (current-output-port output-port)) + ;; Each record supplies a new dynamic pattern, exercising both the + ;; per-evaluation cache and record state through the public runner. + (run-awk '("{ pattern = $1; print match($1, pattern), $0 }"))) + (get-output-string output-port)) + (lambda () + (close-port input-port) + (close-port output-port))))) + +(test "concurrent full evaluations own independent mutable state" + (let ((results (make-vector 2 #f)) + (record-count 128)) + (let ((threads + (map + (lambda (index) + (fork-thread + (lambda () + (let ((prefix (if (= index 0) "left" "right"))) + (vector-set! results index + (evaluate-stream + (make-record-stream prefix record-count))))))) + '(0 1)))) + (for-each thread-join threads) + (and (equal? (vector-ref results 0) + (make-expected-stream "left" record-count)) + (equal? (vector-ref results 1) + (make-expected-stream "right" record-count))))) + #t) + +(test "low-level environment accessors reject cross-thread reuse" + (let* ((env (make-initial-env)) + (result (make-vector 1 #f)) + (thread (fork-thread + (lambda () + (vector-set! + result 0 + (guard (exn (else 'rejected)) + ;; Accessors are exported for embedding, so ownership + ;; enforcement must not be limited to env-* helpers. + (awk-env-record-buffer-set! env '("wrong thread")) + 'accepted)))))) + ;; Chez thread-join waits but does not return the worker procedure's + ;; value, so publish the result explicitly for a deterministic assertion. + (thread-join thread) + (eq? (vector-ref result 0) 'rejected)) + #t) + (printf "~%pass: ~a fail: ~a~%" pass fail) (when (> fail 0) (exit 1))