fix: ReDoS in generic matcher, exponent cap, SARIF severity mapping, config parse once, fix overlap
ober
48c1f47aab9d28a456d9654305966546c72ceb32
--- a/lib/semgrep/cli.sls +++ b/lib/semgrep/cli.sls @@ -417,9 +417,8 @@ (and (or (string=? canonical "generic") (string=? canonical "regex")) language))))) - (def (scan-one config-path language-opt target) + (def (scan-one rules language-opt target) (let* ([target-path (target-display target)] - [rules (parse-config-file config-path)] [language (or language-opt (single-text-config-language rules) (and (not (string=? target-path "-")) @@ -502,32 +501,33 @@ (when (null? targets) (usage) (error 'semgrep-cli "missing target")) - (let-values ([(expanded-targets roots) - (expand-targets - language - includes - excludes - targets)]) - (dynamic-wind - (lambda () (void)) - (lambda () - (let ([findings (filter-findings-by-severity - severities - (apply - append - (map (lambda (target) - (scan-one - config - language - target)) - expanded-targets)))]) - (when autofix? - (apply-autofix! expanded-targets findings)) - (display (format-findings format findings)) - (newline) - (if (null? findings) 0 1))) - (lambda () - (for-each - (lambda (root) - (secure-directory-close (cli-root-handle root))) - roots))))))))) + (let ([rules (parse-config-file config)]) + (let-values ([(expanded-targets roots) + (expand-targets + language + includes + excludes + targets)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([findings (filter-findings-by-severity + severities + (apply + append + (map (lambda (target) + (scan-one + rules + language + target)) + expanded-targets)))]) + (when autofix? + (apply-autofix! expanded-targets findings)) + (display (format-findings format findings)) + (newline) + (if (null? findings) 0 1))) + (lambda () + (for-each + (lambda (root) + (secure-directory-close (cli-root-handle root))) + roots)))))))))) --- a/lib/semgrep/engine/comparison.sls +++ b/lib/semgrep/engine/comparison.sls @@ -18,6 +18,7 @@ (semgrep match structural)) (define missing-comparison-value (list 'missing-comparison-value)) + (define comparison-max-exponent 1000) (def (alist-ref/default xs key default) (let ([found (assoc key xs)]) (if found (cdr found) default))) @@ -544,7 +545,10 @@ (not (= right-number 0))) (modulo left-number right-number) missing-comparison-value)] - [(string=? op "**") (expt left-number right-number)] + [(string=? op "**") + (if (<= (abs right-number) comparison-max-exponent) + (expt left-number right-number) + missing-comparison-value)] [(string=? op "&") (if (and (comparison-integer? left-number) (comparison-integer? right-number)) --- a/lib/semgrep/engine/generic-scan.sls +++ b/lib/semgrep/engine/generic-scan.sls @@ -13,8 +13,8 @@ printf fprintf format path-extension path-absolute? with-input-from-string with-output-to-string iota \x31;+ \x31;- partition make-date make-time meta atom?) - (except (jerboa prelude) meta atom?) (std regex) - (semgrep rule) (semgrep result) (semgrep result extras) + (except (jerboa prelude) meta atom?) (semgrep rule) + (semgrep result) (semgrep result extras) (semgrep engine regex-support) (semgrep source offsets) (semgrep match structural)) (define generic-separator-regex @@ -247,8 +247,9 @@ source match input-start) - (let* ([match-start (+ input-start (re-match-start match))] - [full (re-match-full match)]) + (let* ([match-start (+ input-start + (linear-match-start match))] + [full (linear-match-full match)]) (let loop ([names capture-names] [index 1] [search-start 0] @@ -256,7 +257,7 @@ (cond [(null? names) (reverse acc)] [else - (let ([text (re-match-group match index)]) + (let ([text (linear-match-group match index)]) (if (not text) (loop (cdr names) (+ index 1) search-start acc) (let* ([relative (or (string-find-substring-from @@ -300,8 +301,8 @@ match 0)]) (and bindings - (let* ([start (re-match-start match)] - [end (re-match-end match)] + (let* ([start (linear-match-start match)] + [end (linear-match-end match)] [match-text (substring source start end)]) (let-values ([(start-line start-col) (offset->line-col source start)] @@ -317,18 +318,19 @@ match-text))))))) (def (scan-generic-pattern rule path source pattern) (let* ([spec (generic-pattern->regex-spec pattern)] - [rx (re (car spec))] + [rx (linear-regex-compile + (regex-pattern-for-engine (car spec)))] [capture-names (cdr spec)] - [len (string-length source)]) - (let loop ([start 0] [acc '()]) - (if (> start len) - (reverse acc) - (let ([match (re-search rx source start)]) + [subject (make-linear-subject source)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let loop ([start-byte 0] [acc '()]) + (let ([match (linear-regex-search rx subject start-byte)]) (if match (let* ([finding (finding-from-generic-match rule path source match capture-names)] - [next (max (+ (re-match-start match) 1) - (re-match-end match))]) + [next (linear-match-next-byte match)]) (loop next (if finding @@ -336,4 +338,5 @@ (reverse (apply-rule-focus rule finding)) acc) acc))) - (reverse acc)))))))) + (reverse acc))))) + (lambda () (linear-regex-free rx)))))) --- a/lib/semgrep/fix.sls +++ b/lib/semgrep/fix.sls @@ -42,14 +42,20 @@ (substring source end (string-length source)))) (def (apply-fixes-to-string source findings) (let loop ([current source] - [xs (sorted-fixable-findings findings)]) + [xs (sorted-fixable-findings findings)] + [frontier #f]) (if (null? xs) current - (let ([finding (car xs)]) - (loop - (replace-range - current - (finding-start-offset finding) - (finding-end-offset finding) - (finding-fix finding)) - (cdr xs))))))) + (let* ([finding (car xs)] + [start (finding-start-offset finding)] + [end (finding-end-offset finding)]) + (if (and frontier (> end frontier)) + (loop current (cdr xs) frontier) + (loop + (replace-range + current + start + end + (finding-fix finding)) + (cdr xs) + start))))))) --- a/lib/semgrep/output/sarif.sls +++ b/lib/semgrep/output/sarif.sls @@ -47,8 +47,12 @@ (def (severity->sarif-level severity) (cond [(string=? severity "ERROR") "error"] + [(string=? severity "CRITICAL") "error"] + [(string=? severity "HIGH") "error"] [(string=? severity "WARNING") "warning"] + [(string=? severity "MEDIUM") "warning"] [(string=? severity "INFO") "note"] + [(string=? severity "LOW") "note"] [else "warning"])) (def (rule-seen? rule-id seen) (and (not (null? seen)) --- a/src/.jerbuild-hashes +++ b/src/.jerbuild-hashes @@ -5,7 +5,7 @@ . "DBAD99DB5C22F6A1") ("src/semgrep/util/literals.ss" . "8A094085551B216E") - ("src/semgrep/fix.ss" . "2E5B65B1FEF3B2B1") + ("src/semgrep/fix.ss" . "3C4F15F61564C5C8") ("src/semgrep/engine/markup-scan.ss" . "40AF9B537485FE0") ("src/semgrep/match/structural.ss" . "5BA4F1566448AF3A") ("src/semgrep/engine/fallback-positive-dispatch.ss" @@ -34,8 +34,8 @@ . "285FDB423AD7E28C") ("src/semgrep/result/builders.ss" . "93A64AF4435E6132") - ("src/semgrep/cli.ss" . "85895FE966E0C49C") - ("src/semgrep/output/sarif.ss" . "E935456E4B1921FB") + ("src/semgrep/cli.ss" . "DF74D39C29AC0141") + ("src/semgrep/output/sarif.ss" . "740FF3708E6C1BB") ("src/semgrep/engine/js-vardef-scan.ss" . "BD82BDDFEDD7242D") @@ -56,14 +56,14 @@ ("src/semgrep/lang.ss" . "6982E07679D20836") ("src/semgrep/parse/parse-target.ss" . "97AA8FFEB12736DA") ("src/semgrep/scan.ss" . "E5E3900F4CA79795") - ("src/semgrep/engine/generic-scan.ss" . "F69D0ACD0DD62610") + ("src/semgrep/engine/generic-scan.ss" . "925C9DC8F6C8188F") ("src/semgrep/engine/py-constant-prop.ss" . "76462D0EB71F2180") ("src/semgrep/engine/js-constructor-scan.ss" . "6B226B8D0584A7A") - ("src/semgrep/engine/comparison.ss" . "5B5731915BCB8E6") + ("src/semgrep/engine/comparison.ss" . "39F51E8BBC7F761") ("src/semgrep/main.ss" . "A4EC9E7F2A09D25E") ("src/semgrep/engine/py-import-scan.ss" . --- a/src/semgrep/cli.ss +++ b/src/semgrep/cli.ss @@ -435,9 +435,8 @@ (string=? canonical "regex")) language))))) -(def (scan-one config-path language-opt target) +(def (scan-one rules language-opt target) (let* ([target-path (target-display target)] - [rules (parse-config-file config-path)] [language (or language-opt (single-text-config-language rules) (and (not (string=? target-path "-")) @@ -515,8 +514,9 @@ (when (null? targets) (usage) (error 'semgrep-cli "missing target")) - (let-values ([(expanded-targets roots) - (expand-targets language includes excludes targets)]) + (let ([rules (parse-config-file config)]) + (let-values ([(expanded-targets roots) + (expand-targets language includes excludes targets)]) (dynamic-wind (lambda () (void)) (lambda () @@ -525,7 +525,7 @@ severities (apply append (map (lambda (target) - (scan-one config language target)) + (scan-one rules language target)) expanded-targets)))]) (when autofix? (apply-autofix! expanded-targets findings)) @@ -536,4 +536,4 @@ (for-each (lambda (root) (secure-directory-close (cli-root-handle root))) - roots)))))))) + roots))))))))) --- a/src/semgrep/engine/comparison.ss +++ b/src/semgrep/engine/comparison.ss @@ -20,6 +20,10 @@ (define missing-comparison-value (list 'missing-comparison-value)) + ;; Bound the `**` exponent so an untrusted comparison expression cannot force + ;; `expt` to materialize an astronomically large bignum (CPU/memory DoS). + (define comparison-max-exponent 1000) + (def (alist-ref/default xs key default) (let ([found (assoc key xs)]) (if found (cdr found) default))) @@ -563,7 +567,10 @@ (not (= right-number 0))) (modulo left-number right-number) missing-comparison-value)] - [(string=? op "**") (expt left-number right-number)] + [(string=? op "**") + (if (<= (abs right-number) comparison-max-exponent) + (expt left-number right-number) + missing-comparison-value)] [(string=? op "&") (if (and (comparison-integer? left-number) (comparison-integer? right-number)) --- a/src/semgrep/engine/generic-scan.ss +++ b/src/semgrep/engine/generic-scan.ss @@ -5,7 +5,6 @@ scan-generic-pattern) (import (except (jerboa prelude) meta atom?) - (std regex) (semgrep rule) (semgrep result) (semgrep result extras) @@ -254,8 +253,8 @@ captures)])))) (def (generic-capture-bindings capture-names source match input-start) - (let* ([match-start (+ input-start (re-match-start match))] - [full (re-match-full match)]) + (let* ([match-start (+ input-start (linear-match-start match))] + [full (linear-match-full match)]) (let loop ([names capture-names] [index 1] [search-start 0] @@ -263,7 +262,7 @@ (cond [(null? names) (reverse acc)] [else - (let ([text (re-match-group match index)]) + (let ([text (linear-match-group match index)]) (if (not text) (loop (cdr names) (+ index 1) search-start acc) (let* ([relative (or (string-find-substring-from @@ -303,8 +302,8 @@ (def (finding-from-generic-match rule path source match capture-names) (let ([bindings (generic-capture-bindings capture-names source match 0)]) (and bindings - (let* ([start (re-match-start match)] - [end (re-match-end match)] + (let* ([start (linear-match-start match)] + [end (linear-match-end match)] [match-text (substring source start end)]) (let-values ([(start-line start-col) (offset->line-col source start)] [(end-line end-col) (offset->line-col source end)]) @@ -321,15 +320,20 @@ (rule-severity rule) (finding-extra-for-match rule bindings match-text))))))) +;; The generated regex is built from an untrusted rule pattern, so it must run +;; on the guaranteed-linear native engine (SECURITY.md). The native compiler +;; also enforces pattern-length and capture-group limits and fails closed on +;; unsupported syntax, which bounds the matcher against ReDoS/DoS. (def (scan-generic-pattern rule path source pattern) (let* ([spec (generic-pattern->regex-spec pattern)] - [rx (re (car spec))] + [rx (linear-regex-compile (regex-pattern-for-engine (car spec)))] [capture-names (cdr spec)] - [len (string-length source)]) - (let loop ([start 0] [acc '()]) - (if (> start len) - (reverse acc) - (let ([match (re-search rx source start)]) + [subject (make-linear-subject source)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let loop ([start-byte 0] [acc '()]) + (let ([match (linear-regex-search rx subject start-byte)]) (if match (let* ([finding (finding-from-generic-match rule @@ -337,11 +341,11 @@ source match capture-names)] - [next (max (+ (re-match-start match) 1) - (re-match-end match))]) + [next (linear-match-next-byte match)]) (loop next (if finding (append (reverse (apply-rule-focus rule finding)) acc) acc))) - (reverse acc))))))) + (reverse acc))))) + (lambda () (linear-regex-free rx))))) --- a/src/semgrep/fix.ss +++ b/src/semgrep/fix.ss @@ -38,13 +38,22 @@ replacement (substring source end (string-length source)))) +;; Fixes are applied from the end of the string backward (descending start +;; offset), so earlier offsets stay valid. `frontier` is the smallest start +;; offset of an already-applied fix; because applied fixes never overlap, a +;; candidate overlaps an applied fix exactly when its end reaches past +;; `frontier`. Such candidates are skipped rather than corrupting the output. (def (apply-fixes-to-string source findings) - (let loop ([current source] [xs (sorted-fixable-findings findings)]) + (let loop ([current source] + [xs (sorted-fixable-findings findings)] + [frontier #f]) (if (null? xs) current - (let ([finding (car xs)]) - (loop (replace-range current - (finding-start-offset finding) - (finding-end-offset finding) - (finding-fix finding)) - (cdr xs)))))) + (let* ([finding (car xs)] + [start (finding-start-offset finding)] + [end (finding-end-offset finding)]) + (if (and frontier (> end frontier)) + (loop current (cdr xs) frontier) + (loop (replace-range current start end (finding-fix finding)) + (cdr xs) + start)))))) --- a/src/semgrep/output/sarif.ss +++ b/src/semgrep/output/sarif.ss @@ -40,8 +40,12 @@ (def (severity->sarif-level severity) (cond [(string=? severity "ERROR") "error"] + [(string=? severity "CRITICAL") "error"] + [(string=? severity "HIGH") "error"] [(string=? severity "WARNING") "warning"] + [(string=? severity "MEDIUM") "warning"] [(string=? severity "INFO") "note"] + [(string=? severity "LOW") "note"] [else "warning"])) (def (rule-seen? rule-id seen)