security: bound YAML config nesting depth before parse
ober
3cc0c4684f61e3461cb92f4718aebfd696dd5c7a
--- a/lib/semgrep/rule/parse-rule.sls +++ b/lib/semgrep/rule/parse-rule.sls @@ -22,6 +22,52 @@ (configured-positive-int "JSEMGREP_MAX_CONFIG_CHARS" default-max-config-chars)) + (define default-max-config-yaml-depth 512) + (define max-config-yaml-depth + (configured-positive-int + "JSEMGREP_MAX_CONFIG_DEPTH" + default-max-config-yaml-depth)) + (def (check-yaml-depth-limit! source) + (let ([len (string-length source)] + [limit max-config-yaml-depth]) + (let loop ([i 0] + [line-start? #t] + [indent 0] + [flow-depth 0] + [qchar #f] + [escaped? #f]) + (cond + [(> indent limit) + (error 'parse-config-string + "config exceeds maximum nesting depth" + limit + indent)] + [(> flow-depth limit) + (error 'parse-config-string + "config exceeds maximum nesting depth" + limit + flow-depth)] + [(< i len) + (let ([ch (string-ref source i)]) + (cond + [(char=? ch #\newline) + (loop (+ i 1) #t 0 flow-depth qchar escaped?)] + [escaped? (loop (+ i 1) #f 0 flow-depth qchar #f)] + [(and qchar (char=? ch #\\)) + (loop (+ i 1) #f 0 flow-depth qchar #t)] + [qchar + (loop (+ i 1) #f 0 flow-depth + (if (char=? ch qchar) #f qchar) #f)] + [(and line-start? + (or (char=? ch #\space) (char=? ch #\tab))) + (loop (+ i 1) #t (+ indent 1) flow-depth #f #f)] + [(or (char=? ch #\') (char=? ch #\")) + (loop (+ i 1) #f 0 flow-depth ch #f)] + [(or (char=? ch #\[) (char=? ch #\{)) + (loop (+ i 1) #f 0 (+ flow-depth 1) #f #f)] + [(or (char=? ch #\]) (char=? ch #\})) + (loop (+ i 1) #f 0 (max 0 (- flow-depth 1)) #f #f)] + [else (loop (+ i 1) #f 0 flow-depth #f #f)]))])))) (def (string-contains-nul? s) (let ([len (string-length s)]) (let loop ([i 0]) @@ -1105,6 +1151,7 @@ "config must contain rules list")) (map parse-rule rules))) (def (parse-config-string source) + (check-yaml-depth-limit! source) (parse-config-object (yaml-load-string (normalize-yaml-sequence-indentation --- a/src/.jerbuild-hashes +++ b/src/.jerbuild-hashes @@ -51,7 +51,7 @@ "221B0D787F146331") ("src/semgrep/engine/taint-specs.ss" . "6B0AA195C9B93DFB") ("src/semgrep/engine/ts-query-scan.ss" . "51AD5339F6DE47B4") - ("src/semgrep/rule/parse-rule.ss" . "F3F9857B43414A7F") + ("src/semgrep/rule/parse-rule.ss" . "89CB5B51431A3B2E") ("src/semgrep/output/json.ss" . "293881CFA2ADB7BC") ("src/semgrep/lang.ss" . "6982E07679D20836") ("src/semgrep/parse/parse-target.ss" . "97AA8FFEB12736DA") --- a/src/semgrep/rule/parse-rule.ss +++ b/src/semgrep/rule/parse-rule.ss @@ -20,6 +20,60 @@ (define max-config-chars (configured-positive-int "JSEMGREP_MAX_CONFIG_CHARS" default-max-config-chars)) +(define default-max-config-yaml-depth 512) + +(define max-config-yaml-depth + (configured-positive-int "JSEMGREP_MAX_CONFIG_DEPTH" + default-max-config-yaml-depth)) + +;; Block-style nesting depth is bounded by a line's leading indentation (each +;; nesting level adds at least one column) and flow-style nesting by the open +;; bracket depth. The std YAML reader enforces its *yaml-max-depth* only after +;; the recursive-descent parse, so a deeply nested config would overflow the +;; stack inside the parse. Reject it here, before any normalization or parse, +;; by bounding both indentation and flow depth in a single early-exit pass. +(def (check-yaml-depth-limit! source) + (let ([len (string-length source)] + [limit max-config-yaml-depth]) + (let loop ([i 0] + [line-start? #t] + [indent 0] + [flow-depth 0] + [qchar #f] + [escaped? #f]) + (cond + [(> indent limit) + (error 'parse-config-string + "config exceeds maximum nesting depth" + limit + indent)] + [(> flow-depth limit) + (error 'parse-config-string + "config exceeds maximum nesting depth" + limit + flow-depth)] + [(< i len) + (let ([ch (string-ref source i)]) + (cond + [(char=? ch #\newline) + (loop (+ i 1) #t 0 flow-depth qchar escaped?)] + [escaped? + (loop (+ i 1) #f 0 flow-depth qchar #f)] + [(and qchar (char=? ch #\\)) + (loop (+ i 1) #f 0 flow-depth qchar #t)] + [qchar + (loop (+ i 1) #f 0 flow-depth (if (char=? ch qchar) #f qchar) #f)] + [(and line-start? (or (char=? ch #\space) (char=? ch #\tab))) + (loop (+ i 1) #t (+ indent 1) flow-depth #f #f)] + [(or (char=? ch #\') (char=? ch #\")) + (loop (+ i 1) #f 0 flow-depth ch #f)] + [(or (char=? ch #\[) (char=? ch #\{)) + (loop (+ i 1) #f 0 (+ flow-depth 1) #f #f)] + [(or (char=? ch #\]) (char=? ch #\})) + (loop (+ i 1) #f 0 (max 0 (- flow-depth 1)) #f #f)] + [else + (loop (+ i 1) #f 0 flow-depth #f #f)]))])))) + (def (string-contains-nul? s) (let ([len (string-length s)]) (let loop ([i 0]) @@ -1005,6 +1059,7 @@ (map parse-rule rules))) (def (parse-config-string source) + (check-yaml-depth-limit! source) (parse-config-object (yaml-load-string (normalize-yaml-sequence-indentation --- a/tests/smoke.ss +++ b/tests/smoke.ss @@ -48,6 +48,15 @@ (thunk)) (check raised? => #t))) +(define (string-contains? haystack needle) + (let ([hlen (string-length haystack)] + [nlen (string-length needle)]) + (and (<= nlen hlen) + (let loop ([i 0]) + (and (<= (+ i nlen) hlen) + (or (string=? (substring haystack i (+ i nlen)) needle) + (loop (+ i 1)))))))) + (define (count-findings pred findings) (let loop ([xs findings] [count 0]) (cond @@ -78,6 +87,32 @@ (check (length rules) => 1) (check (rule-id rule) => "demo.eval"))) +(test-case "deeply nested YAML config raises a clean depth-limit error" + (let ([deep-block + (with-output-to-string + (lambda () + (let loop ([i 0]) + (when (< i 10000) + (display (make-string i #\space)) + (display "a:\n") + (loop (+ i 1))))))] + [deep-flow + (string-append "a: " + (make-string 100000 (integer->char 91)) + (make-string 100000 (integer->char 93)))] + [depth-error? + (lambda (e) + (guard (access-failure [#t #f]) + (string-contains? (condition-message e) "nesting depth")))]) + (let ([block-depth-error #f]) + (guard (parse-failure [#t (set! block-depth-error (depth-error? parse-failure))]) + (parse-config-string deep-block)) + (check block-depth-error => #t)) + (let ([flow-depth-error #f]) + (guard (parse-failure [#t (set! flow-depth-error (depth-error? parse-failure))]) + (parse-config-string deep-flow)) + (check flow-depth-error => #t)))) + (test-case "scan Python source" (let* ([findings (scan-config-string config