security: add resource limits and path confinement (P1 #24)
ober
2e69f2335699483ddcf497e06bae873172e3e042
--- a/lib/jerboa-awk/builtins/string.sls +++ b/lib/jerboa-awk/builtins/string.sls @@ -17,11 +17,25 @@ (import (scheme) (only (std misc string) string-contains string-trim) + (only (std os env) getenv) (jerboa-awk value) (jerboa-awk runtime) (jerboa-awk ast) (std pregexp)) + (define max-format-width + (let ((v (getenv "JAWK_MAX_FORMAT_WIDTH"))) + (if v + (let ((n (string->number v))) + (if (and n (integer? n) (> n 0)) n 65536)) + 65536))) + + (define (check-format-bounds! who width prec) + (when (and width (> width max-format-width)) + (error who "printf width exceeds configured limit (JAWK_MAX_FORMAT_WIDTH)" width max-format-width)) + (when (and prec (> prec max-format-width)) + (error who "printf precision exceeds configured limit (JAWK_MAX_FORMAT_WIDTH)" prec max-format-width))) + ;;; length([s]) (define (awk-builtin-length env args) (if (null? args) @@ -253,6 +267,7 @@ (loop j flags width n 'spec)))) (else (loop i flags width (or prec 0) 'spec)))) ((spec) + (check-format-bounds! 'awk-sprintf width prec) (let ((arg (if (null? args) (make-awk-uninit) (car args))) (rest (if (null? args) '() (cdr args)))) (values (do-format c arg flags (or width 0) prec) --- a/lib/jerboa-awk/main.sls +++ b/lib/jerboa-awk/main.sls @@ -24,8 +24,11 @@ (if (and n (integer? n) (> n 0)) n default)) default))) + (define default-max-call-depth 1000) + (define max-program-chars (configured-positive-int "JAWK_MAX_PROGRAM_CHARS" default-max-program-chars)) (define max-record-chars (configured-positive-int "JAWK_MAX_RECORD_CHARS" default-max-record-chars)) + (define max-call-depth (configured-positive-int "JAWK_MAX_CALL_DEPTH" default-max-call-depth)) (define (check-sized-string! who label value limit) (when (> (string-length value) limit) @@ -628,16 +631,19 @@ (else (let ((func (hash-ref (awk-env-functions env) name #f))) (if func - (let ((args (map (lambda (e) (eval-expr env e)) arg-exprs))) - (env-push-locals! env (awk-func-params func) args) - (let ((result - (guard (e - ((awk-signal-return? e) - (or (awk-signal-return-value e) (make-awk-uninit)))) - (exec-stmt env (awk-func-body func)) - (make-awk-uninit)))) - (env-pop-locals! env) - result)) + (begin + (when (>= (length (awk-env-local-frames env)) max-call-depth) + (error 'eval-call "user-function recursion depth exceeds configured limit (JAWK_MAX_CALL_DEPTH)" max-call-depth)) + (let ((args (map (lambda (e) (eval-expr env e)) arg-exprs))) + (env-push-locals! env (awk-func-params func) args) + (let ((result + (guard (e + ((awk-signal-return? e) + (or (awk-signal-return-value e) (make-awk-uninit)))) + (exec-stmt env (awk-func-body func)) + (make-awk-uninit)))) + (env-pop-locals! env) + result))) (error 'eval-call (string-append "jawk: unknown function: " (symbol->string name))))))))) --- a/lib/jerboa-awk/runtime.sls +++ b/lib/jerboa-awk/runtime.sls @@ -109,19 +109,67 @@ ((char=? (string-ref s i) #\nul) #t) (else (loop (+ i 1))))))) + (define file-root + (let ((v (getenv "JAWK_FILE_ROOT"))) + (and v (> (string-length v) 0) v))) + + (define (awk-path-absolute? p) + (and (> (string-length p) 0) (char=? (string-ref p 0) #\/))) + + (define (awk-path-contains-dotdot? p) + (let ((n (string-length p))) + (let loop ((i 0)) + (cond + ((>= i n) #f) + ((and (char=? (string-ref p i) #\.) + (< (+ i 1) n) + (char=? (string-ref p (+ i 1)) #\.) + (or (= i 0) (char=? (string-ref p (- i 1)) #\/)) + (or (>= (+ i 2) n) (char=? (string-ref p (+ i 2)) #\/))) + #t) + (else (loop (+ i 1))))))) + (define (require-safe-path! who path) (unless (and (string? path) (> (string-length path) 0) (not (string-contains-nul? path))) (error who "invalid file path" path)) (check-untainted! path who) - path) + (when (awk-path-absolute? path) + (unless file-root + (error who "absolute file paths are disabled; set JAWK_FILE_ROOT to confine" path))) + (when (awk-path-contains-dotdot? path) + (unless file-root + (error who "path traversal (..) is disabled; set JAWK_FILE_ROOT to confine" path))) + (if file-root + (let ((resolved (if (awk-path-absolute? path) + (string-append file-root path) + (string-append file-root "/" path)))) + (when (awk-path-contains-dotdot? resolved) + (error who "path escapes JAWK_FILE_ROOT" path)) + resolved) + path)) ;;; ---- Regex pattern cache ---- (define (make-regex-cache) (make-hashtable equal-hash equal?)) + (define default-max-nf 1024) + (define default-max-open-files 64) + (define default-max-array-elems 1048576) + + (define (configured-positive-int-env name default) + (let ((value (getenv name))) + (if value + (let ((n (string->number value))) + (if (and n (integer? n) (> n 0)) n default)) + default))) + + (define max-nf (configured-positive-int-env "JAWK_MAX_NF" default-max-nf)) + (define max-open-files (configured-positive-int-env "JAWK_MAX_OPEN_FILES" default-max-open-files)) + (define max-array-elems (configured-positive-int-env "JAWK_MAX_ARRAY_ELEMS" default-max-array-elems)) + (define default-max-regex-cache-entries 64) (define max-regex-cache-entries @@ -340,6 +388,9 @@ (define (env-array-set! env name subscript val) (let ((arr (env-get-array env name))) + (when (and (not (hash-key? arr subscript)) + (>= (hash-length arr) max-array-elems)) + (error 'env-array-set! "array exceeds configured limit (JAWK_MAX_ARRAY_ELEMS)" name max-array-elems)) (hash-put! arr subscript (->awk val)))) (define (env-array-exists? env name subscript) @@ -363,6 +414,8 @@ (define (env-set-field! env idx val) (env-assert-owner! 'env-set-field! env) + (when (> idx max-nf) + (error 'env-set-field! "field index exceeds configured limit (JAWK_MAX_NF)" idx max-nf)) (let ((v (->awk val)) (nf (awk-env-nf env))) (when (> idx nf) @@ -400,6 +453,8 @@ (make-awk-string (string-join parts ofs))))) (define (env-set-nf! env new-nf) + (when (> new-nf max-nf) + (error 'env-set-nf! "NF exceeds configured limit (JAWK_MAX_NF)" new-nf max-nf)) (let ((old-nf (awk-env-nf env))) (cond ((= new-nf old-nf) (void)) @@ -532,25 +587,31 @@ ;;; ---- I/O port management ---- + (define (env-open-file-count env) + (+ (hash-length (awk-env-output-files env)) + (hash-length (awk-env-input-files env)))) + (define (env-get-output-port env target append?) (require-awk-file-io-enabled! 'env-get-output-port) - (require-safe-path! 'env-get-output-port target) - (let ((key target)) + (let ((key (require-safe-path! 'env-get-output-port target))) (if (hash-key? (awk-env-output-files env) key) (hash-ref (awk-env-output-files env) key #f) - (let ((port (if append? - (let ((p (open-file-output-port target + (begin + (when (>= (env-open-file-count env) max-open-files) + (error 'env-get-output-port "too many open files (JAWK_MAX_OPEN_FILES)" max-open-files)) + (let ((port (if append? + (let ((p (open-file-output-port key (file-options no-fail no-truncate) (buffer-mode line) (native-transcoder)))) (set-port-position! p (port-length p)) p) - (open-file-output-port target + (open-file-output-port key (file-options no-fail) (buffer-mode line) (native-transcoder))))) - (hash-put! (awk-env-output-files env) key port) - port)))) + (hash-put! (awk-env-output-files env) key port) + port))))) (define (env-get-pipe-port env cmd) (require-awk-shell-enabled! 'env-get-pipe-port) @@ -571,12 +632,15 @@ (define (env-get-input-port env filename) (require-awk-file-io-enabled! 'env-get-input-port) - (require-safe-path! 'env-get-input-port filename) - (if (hash-key? (awk-env-input-files env) filename) - (hash-ref (awk-env-input-files env) filename #f) - (let ((port (open-input-file filename))) - (hash-put! (awk-env-input-files env) filename port) - port))) + (let ((key (require-safe-path! 'env-get-input-port filename))) + (if (hash-key? (awk-env-input-files env) key) + (hash-ref (awk-env-input-files env) key #f) + (begin + (when (>= (env-open-file-count env) max-open-files) + (error 'env-get-input-port "too many open files (JAWK_MAX_OPEN_FILES)" max-open-files)) + (let ((port (open-input-file key))) + (hash-put! (awk-env-input-files env) key port) + port))))) (define (env-get-input-pipe-port env cmd) (require-awk-shell-enabled! 'env-get-input-pipe-port) --- a/lib/jerboa-awk/value.sls +++ b/lib/jerboa-awk/value.sls @@ -111,6 +111,8 @@ (let ((prec (max 1 (parse-format-precision fmt)))) (format-g-number n prec)))))) + (define max-format-precision 65536) + (define (parse-format-precision fmt) (let ((len (string-length fmt))) (if (and (>= len 3) @@ -118,11 +120,15 @@ (char=? (string-ref fmt 1) #\.)) (let loop ((i 2) (n 0)) (if (>= i len) - n + (if (> n max-format-precision) + (error 'parse-format-precision "printf precision exceeds configured limit" n max-format-precision) + n) (let ((c (string-ref fmt i))) (if (char-numeric? c) (loop (+ i 1) (+ (* n 10) (- (char->integer c) (char->integer #\0)))) - n)))) + (if (> n max-format-precision) + (error 'parse-format-precision "printf precision exceeds configured limit" n max-format-precision) + n))))) 6))) (define (format-g-number n prec)