Extract Semgrep generic text scanner
ober
26a9d3f0d495e4f64c44be215d50dbcfd82463b6
--- a/SEMGREP_JERBOA_IMPLEMENTATION.md +++ b/SEMGREP_JERBOA_IMPLEMENTATION.md @@ -469,6 +469,8 @@ Completed in the repo: `src/semgrep/result/extras.ss` - extracted regex rule scanning and regex-backed finding builders into `src/semgrep/engine/regex-scan.ss` + - extracted generic/text pattern scanning helpers into + `src/semgrep/engine/generic-scan.ss` Validation at this checkpoint: new file mode 100644 --- /dev/null +++ b/lib/semgrep/engine/generic-scan.sls @@ -0,0 +1,339 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/semgrep/engine/generic-scan.ss + +(library (semgrep engine generic-scan) + (export + regex-escape-string + join-strings + string-contains-char? + scan-generic-pattern) + (import + (except (chezscheme) make-hash-table hash-table? sort sort! + 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) + (semgrep engine regex-support) (semgrep source offsets) + (semgrep match structural)) + (define generic-separator-regex + "(?:\\s+|//[^\\n]*(?:\\n|$)|/\\*(?:.|\\n)*?\\*/)+") + (define generic-optional-separator-regex + "(?:\\s+|//[^\\n]*(?:\\n|$)|/\\*(?:.|\\n)*?\\*/)*") + (define generic-metavariable-regex + "(\\$?[A-Za-z0-9_]+|'[^'\\n]*'|\"[^\"\\n]*\")") + (define generic-metavariable-identifier-regex + "(\\$?[A-Za-z0-9_]+)") + (def (generic-metavariable-in-argument-position? source i) + (let loop ([j (- i 1)]) + (cond + [(< j 0) #f] + [(char-whitespace? (string-ref source j)) (loop (- j 1))] + [(or (char=? (string-ref source j) #\() + (char=? (string-ref source j) #\,)) + #t] + [else #f]))) + (def (regex-special-char? ch) + (let loop ([xs '(#\\ #\. #\^ #\$ #\| #\? #\* #\+ #\( #\) #\[ + #\] #\{ #\})]) + (and (not (null? xs)) + (or (char=? ch (car xs)) (loop (cdr xs)))))) + (def (regex-escape-char ch) + (if (regex-special-char? ch) (string #\\ ch) (string ch))) + (def (regex-escape-string source) + (let ([len (string-length source)]) + (let loop ([i 0] [acc '()]) + (if (= i len) + (join-strings (reverse acc)) + (loop + (+ i 1) + (cons (regex-escape-char (string-ref source i)) acc)))))) + (def (join-strings parts) + (let loop ([xs parts] [acc ""]) + (if (null? xs) + acc + (loop (cdr xs) (string-append acc (car xs)))))) + (def (string-contains-char? s ch) + (let ([len (string-length s)]) + (let loop ([i 0]) + (cond + [(>= i len) #f] + [(char=? (string-ref s i) ch) #t] + [else (loop (+ i 1))])))) + (def (generic-plain-ellipsis-at? source i) + (and (<= (+ i 3) (string-length source)) + (char=? (string-ref source i) #\.) + (char=? (string-ref source (+ i 1)) #\.) + (char=? (string-ref source (+ i 2)) #\.))) + (def (generic-ellipsis-metavariable-at? source i) + (and (<= (+ i 4) (string-length source)) + (char=? (string-ref source i) #\$) + (char=? (string-ref source (+ i 1)) #\.) + (char=? (string-ref source (+ i 2)) #\.) + (char=? (string-ref source (+ i 3)) #\.) + (or (char-alphabetic? (string-ref source (+ i 4))) + (char=? (string-ref source (+ i 4)) #\_)))) + (def (generic-skip-whitespace source i) + (let ([len (string-length source)]) + (let loop ([j i]) + (if (and (< j len) (char-whitespace? (string-ref source j))) + (loop (+ j 1)) + j)))) + (def (generic-comma-ellipsis-at? source i) + (and (< i (string-length source)) + (char=? (string-ref source i) #\,) + (generic-plain-ellipsis-at? + source + (generic-skip-whitespace source (+ i 1))))) + (def (generic-ellipsis-inside-call-parens? source i) + (let loop ([j 0] [stack '()]) + (cond + [(>= j i) + (and (pair? stack) + (let ([open (car stack)]) + (and (> open 0) + (identifier-token-char? + (string-ref source (- open 1))))))] + [(char=? (string-ref source j) #\() + (loop (+ j 1) (cons j stack))] + [(char=? (string-ref source j) #\)) + (loop (+ j 1) (if (pair? stack) (cdr stack) stack))] + [else (loop (+ j 1) stack)]))) + (def (generic-word-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_))) + (def (identifier-token-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_))) + (def (generic-space-punctuation? ch) + (and (not (char-whitespace? ch)) + (not (generic-word-char? ch)) + (not (char=? ch #\$)))) + (def (generic-optional-space-context? source start end) + (let ([prev (and (> start 0) + (string-ref source (- start 1)))] + [next (and (< end (string-length source)) + (string-ref source end))]) + (or (and prev (generic-space-punctuation? prev)) + (and next (generic-space-punctuation? next))))) + (def (generic-capture-name + source + marker-start + name-start + end) + (if (and (< (+ marker-start 3) name-start) + (char=? (string-ref source (+ marker-start 1)) #\.) + (char=? (string-ref source (+ marker-start 2)) #\.) + (char=? (string-ref source (+ marker-start 3)) #\.)) + (string-append "..." (substring source name-start end)) + (substring source name-start end))) + (def (generic-pattern->regex-spec pattern) + (let* ([source (string-trim pattern)] + [len (string-length source)] + [plain-ellipsis (if (string-contains-char? source #\newline) + "(?:.|\\n)*?" + "[^\\n]*?")]) + (let loop ([i 0] [parts '()] [captures '()]) + (cond + [(>= i len) + (cons (join-strings (reverse parts)) (reverse captures))] + [(char-whitespace? (string-ref source i)) + (let ws-loop ([j (+ i 1)]) + (if (and (< j len) + (char-whitespace? (string-ref source j))) + (ws-loop (+ j 1)) + (if (or (generic-plain-ellipsis-at? source j) + (generic-ellipsis-metavariable-at? source j) + (and (pair? parts) + (string=? (car parts) "((?:.|\\n)*?)"))) + (loop j parts captures) + (loop + j + (cons + (if (generic-optional-space-context? + source + i + j) + generic-optional-separator-regex + generic-separator-regex) + parts) + captures))))] + [(and (char=? (string-ref source i) #\$) + (< (+ i 4) len) + (char=? (string-ref source (+ i 1)) #\.) + (char=? (string-ref source (+ i 2)) #\.) + (char=? (string-ref source (+ i 3)) #\.) + (or (char-alphabetic? (string-ref source (+ i 4))) + (char=? (string-ref source (+ i 4)) #\_))) + (let name-loop ([j (+ i 5)]) + (if (and (< j len) + (or (char-alphabetic? (string-ref source j)) + (char-numeric? (string-ref source j)) + (char=? (string-ref source j) #\_))) + (name-loop (+ j 1)) + (loop + j + (cons "((?:.|\\n)*?)" parts) + (cons + (generic-capture-name source i (+ i 4) j) + captures))))] + [(and (char=? (string-ref source i) #\$) + (< (+ i 1) len) + (or (char-alphabetic? (string-ref source (+ i 1))) + (char=? (string-ref source (+ i 1)) #\_))) + (let name-loop ([j (+ i 2)]) + (if (and (< j len) + (or (char-alphabetic? (string-ref source j)) + (char-numeric? (string-ref source j)) + (char=? (string-ref source j) #\_))) + (name-loop (+ j 1)) + (loop + j + (cons + (if (generic-metavariable-in-argument-position? + source + i) + generic-metavariable-regex + generic-metavariable-identifier-regex) + parts) + (cons + (generic-capture-name source i (+ i 1) j) + captures))))] + [(generic-comma-ellipsis-at? source i) + (let ([after (generic-skip-whitespace + source + (+ (generic-skip-whitespace source (+ i 1)) + 3))]) + (loop + after + (cons + (string-append "(?:" generic-optional-separator-regex "," + generic-optional-separator-regex plain-ellipsis ")?") + parts) + captures))] + [(and (< (+ i 2) len) + (char=? (string-ref source i) #\.) + (char=? (string-ref source (+ i 1)) #\.) + (char=? (string-ref source (+ i 2)) #\.)) + (loop + (generic-skip-whitespace source (+ i 3)) + (cons + (if (generic-ellipsis-inside-call-parens? source i) + "(?:.|\\n)*?" + plain-ellipsis) + parts) + captures)] + [(generic-word-char? (string-ref source i)) + (let word-loop ([j (+ i 1)]) + (if (and (< j len) + (generic-word-char? (string-ref source j))) + (word-loop (+ j 1)) + (loop + j + (cons + (string-append "\\b" (substring source i j) "\\b") + parts) + captures)))] + [else + (loop + (+ i 1) + (cons (regex-escape-char (string-ref source i)) parts) + 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 loop ([names capture-names] + [index 1] + [search-start 0] + [acc '()]) + (cond + [(null? names) (reverse acc)] + [else + (let ([text (re-match-group match index)]) + (if (not text) + (loop (cdr names) (+ index 1) search-start acc) + (let* ([relative (or (string-find-substring-from + full + text + search-start) + search-start)] + [start (+ match-start relative)] + [end (+ start (string-length text))] + [name (car names)] + [existing (assoc name acc)]) + (cond + [(and existing + (not (string=? + (metavariable-binding-text + (cdr existing)) + text))) + #f] + [existing + (loop + (cdr names) + (+ index 1) + (+ relative (string-length text)) + acc)] + [else + (loop + (cdr names) + (+ index 1) + (+ relative (string-length text)) + (cons + (cons + name + (make-regex-capture-binding name text source + start end)) + acc))]))))])))) + (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)] + [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)]) + (make-finding (rule-id rule) path start-line start-col end-line + end-col start end + (render-fix-template (rule-message rule) bindings) + (rule-severity rule) + (finding-extra-for-match + rule + bindings + match-text))))))) + (def (scan-generic-pattern rule path source pattern) + (let* ([spec (generic-pattern->regex-spec pattern)] + [rx (re (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)]) + (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))]) + (loop + next + (if finding + (append + (reverse (apply-rule-focus rule finding)) + acc) + acc))) + (reverse acc)))))))) --- a/lib/semgrep/scan.sls +++ b/lib/semgrep/scan.sls @@ -9,19 +9,19 @@ scan-config-string scan-config-file) (import - (except (chezscheme) make-hash-table hash-table? sort sort! - 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) - (tree-sitter tree-sitter) (semgrep lang) (semgrep rule) - (semgrep result) (semgrep result builders) - (semgrep result extras) (semgrep result findings) - (semgrep engine regex-scan) (semgrep engine rule-plan) - (semgrep engine regex-support) (semgrep rule parse-rule) - (semgrep parse parse-target) (semgrep source offsets) - (semgrep targeting path-filter) (semgrep util literals) - (semgrep match structural)) + (except (chezscheme) make-hash-table hash-table? sort sort! + 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) + (tree-sitter tree-sitter) (semgrep lang) (semgrep rule) + (semgrep result) (semgrep result builders) + (semgrep result extras) (semgrep result findings) + (semgrep engine generic-scan) (semgrep engine regex-scan) + (semgrep engine rule-plan) (semgrep engine regex-support) + (semgrep rule parse-rule) (semgrep parse parse-target) + (semgrep source offsets) (semgrep targeting path-filter) + (semgrep util literals) (semgrep match structural)) (def (alist-ref/default xs key default) (let ([found (assoc key xs)]) (if found (cdr found) default))) @@ -138,322 +138,6 @@ (or (string=? language "typescript") (string=? language "ts") (string=? language "tsx"))) - (def generic-separator-regex - "(?:\\s+|//[^\\n]*(?:\\n|$)|/\\*(?:.|\\n)*?\\*/)+") - (def generic-optional-separator-regex - "(?:\\s+|//[^\\n]*(?:\\n|$)|/\\*(?:.|\\n)*?\\*/)*") - (def generic-metavariable-regex - "(\\$?[A-Za-z0-9_]+|'[^'\\n]*'|\"[^\"\\n]*\")") - (def generic-metavariable-identifier-regex - "(\\$?[A-Za-z0-9_]+)") - (def (generic-metavariable-in-argument-position? source i) - (let loop ([j (- i 1)]) - (cond - [(< j 0) #f] - [(char-whitespace? (string-ref source j)) (loop (- j 1))] - [(or (char=? (string-ref source j) #\() - (char=? (string-ref source j) #\,)) - #t] - [else #f]))) - (def (regex-special-char? ch) - (let loop ([xs '(#\\ #\. #\^ #\$ #\| #\? #\* #\+ #\( #\) #\[ - #\] #\{ #\})]) - (and (not (null? xs)) - (or (char=? ch (car xs)) (loop (cdr xs)))))) - (def (regex-escape-char ch) - (if (regex-special-char? ch) (string #\\ ch) (string ch))) - (def (regex-escape-string source) - (let ([len (string-length source)]) - (let loop ([i 0] [acc '()]) - (if (= i len) - (join-strings (reverse acc)) - (loop - (+ i 1) - (cons (regex-escape-char (string-ref source i)) acc)))))) - (def (join-strings parts) - (let loop ([xs parts] [acc ""]) - (if (null? xs) - acc - (loop (cdr xs) (string-append acc (car xs)))))) - (def (string-contains-char? s ch) - (let ([len (string-length s)]) - (let loop ([i 0]) - (cond - [(>= i len) #f] - [(char=? (string-ref s i) ch) #t] - [else (loop (+ i 1))])))) - (def (generic-plain-ellipsis-at? source i) - (and (<= (+ i 3) (string-length source)) - (char=? (string-ref source i) #\.) - (char=? (string-ref source (+ i 1)) #\.) - (char=? (string-ref source (+ i 2)) #\.))) - (def (generic-ellipsis-metavariable-at? source i) - (and (<= (+ i 4) (string-length source)) - (char=? (string-ref source i) #\$) - (char=? (string-ref source (+ i 1)) #\.) - (char=? (string-ref source (+ i 2)) #\.) - (char=? (string-ref source (+ i 3)) #\.) - (or (char-alphabetic? (string-ref source (+ i 4))) - (char=? (string-ref source (+ i 4)) #\_)))) - (def (generic-skip-whitespace source i) - (let ([len (string-length source)]) - (let loop ([j i]) - (if (and (< j len) (char-whitespace? (string-ref source j))) - (loop (+ j 1)) - j)))) - (def (generic-comma-ellipsis-at? source i) - (and (< i (string-length source)) - (char=? (string-ref source i) #\,) - (generic-plain-ellipsis-at? - source - (generic-skip-whitespace source (+ i 1))))) - (def (generic-ellipsis-inside-call-parens? source i) - (let loop ([j 0] [stack '()]) - (cond - [(>= j i) - (and (pair? stack) - (let ([open (car stack)]) - (and (> open 0) - (identifier-token-char? - (string-ref source (- open 1))))))] - [(char=? (string-ref source j) #\() - (loop (+ j 1) (cons j stack))] - [(char=? (string-ref source j) #\)) - (loop (+ j 1) (if (pair? stack) (cdr stack) stack))] - [else (loop (+ j 1) stack)]))) - (def (generic-word-char? ch) - (or (char-alphabetic? ch) - (char-numeric? ch) - (char=? ch #\_))) - (def (generic-space-punctuation? ch) - (and (not (char-whitespace? ch)) - (not (generic-word-char? ch)) - (not (char=? ch #\$)))) - (def (generic-optional-space-context? source start end) - (let ([prev (and (> start 0) - (string-ref source (- start 1)))] - [next (and (< end (string-length source)) - (string-ref source end))]) - (or (and prev (generic-space-punctuation? prev)) - (and next (generic-space-punctuation? next))))) - (def (generic-capture-name - source - marker-start - name-start - end) - (if (and (< (+ marker-start 3) name-start) - (char=? (string-ref source (+ marker-start 1)) #\.) - (char=? (string-ref source (+ marker-start 2)) #\.) - (char=? (string-ref source (+ marker-start 3)) #\.)) - (string-append "..." (substring source name-start end)) - (substring source name-start end))) - (def (generic-pattern->regex-spec pattern) - (let* ([source (string-trim pattern)] - [len (string-length source)] - [plain-ellipsis (if (string-contains-char? source #\newline) - "(?:.|\\n)*?" - "[^\\n]*?")]) - (let loop ([i 0] [parts '()] [captures '()]) - (cond - [(>= i len) - (cons (join-strings (reverse parts)) (reverse captures))] - [(char-whitespace? (string-ref source i)) - (let ws-loop ([j (+ i 1)]) - (if (and (< j len) - (char-whitespace? (string-ref source j))) - (ws-loop (+ j 1)) - (if (or (generic-plain-ellipsis-at? source j) - (generic-ellipsis-metavariable-at? source j) - (and (pair? parts) - (string=? (car parts) "((?:.|\\n)*?)"))) - (loop j parts captures) - (loop - j - (cons - (if (generic-optional-space-context? - source - i - j) - generic-optional-separator-regex - generic-separator-regex) - parts) - captures))))] - [(and (char=? (string-ref source i) #\$) - (< (+ i 4) len) - (char=? (string-ref source (+ i 1)) #\.) - (char=? (string-ref source (+ i 2)) #\.) - (char=? (string-ref source (+ i 3)) #\.) - (or (char-alphabetic? (string-ref source (+ i 4))) - (char=? (string-ref source (+ i 4)) #\_))) - (let name-loop ([j (+ i 5)]) - (if (and (< j len) - (or (char-alphabetic? (string-ref source j)) - (char-numeric? (string-ref source j)) - (char=? (string-ref source j) #\_))) - (name-loop (+ j 1)) - (loop - j - (cons "((?:.|\\n)*?)" parts) - (cons - (generic-capture-name source i (+ i 4) j) - captures))))] - [(and (char=? (string-ref source i) #\$) - (< (+ i 1) len) - (or (char-alphabetic? (string-ref source (+ i 1))) - (char=? (string-ref source (+ i 1)) #\_))) - (let name-loop ([j (+ i 2)]) - (if (and (< j len) - (or (char-alphabetic? (string-ref source j)) - (char-numeric? (string-ref source j)) - (char=? (string-ref source j) #\_))) - (name-loop (+ j 1)) - (loop - j - (cons - (if (generic-metavariable-in-argument-position? - source - i) - generic-metavariable-regex - generic-metavariable-identifier-regex) - parts) - (cons - (generic-capture-name source i (+ i 1) j) - captures))))] - [(generic-comma-ellipsis-at? source i) - (let ([after (generic-skip-whitespace - source - (+ (generic-skip-whitespace source (+ i 1)) - 3))]) - (loop - after - (cons - (string-append "(?:" generic-optional-separator-regex "," - generic-optional-separator-regex plain-ellipsis ")?") - parts) - captures))] - [(and (< (+ i 2) len) - (char=? (string-ref source i) #\.) - (char=? (string-ref source (+ i 1)) #\.) - (char=? (string-ref source (+ i 2)) #\.)) - (loop - (generic-skip-whitespace source (+ i 3)) - (cons - (if (generic-ellipsis-inside-call-parens? source i) - "(?:.|\\n)*?" - plain-ellipsis) - parts) - captures)] - [(generic-word-char? (string-ref source i)) - (let word-loop ([j (+ i 1)]) - (if (and (< j len) - (generic-word-char? (string-ref source j))) - (word-loop (+ j 1)) - (loop - j - (cons - (string-append "\\b" (substring source i j) "\\b") - parts) - captures)))] - [else - (loop - (+ i 1) - (cons (regex-escape-char (string-ref source i)) parts) - 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 loop ([names capture-names] - [index 1] - [search-start 0] - [acc '()]) - (cond - [(null? names) (reverse acc)] - [else - (let ([text (re-match-group match index)]) - (if (not text) - (loop (cdr names) (+ index 1) search-start acc) - (let* ([relative (or (string-find-substring-from - full - text - search-start) - search-start)] - [start (+ match-start relative)] - [end (+ start (string-length text))] - [name (car names)] - [existing (assoc name acc)]) - (cond - [(and existing - (not (string=? - (metavariable-binding-text - (cdr existing)) - text))) - #f] - [existing - (loop - (cdr names) - (+ index 1) - (+ relative (string-length text)) - acc)] - [else - (loop - (cdr names) - (+ index 1) - (+ relative (string-length text)) - (cons - (cons - name - (make-regex-capture-binding name text source - start end)) - acc))]))))])))) - (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)] - [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)]) - (make-finding (rule-id rule) path start-line start-col end-line - end-col start end - (render-fix-template (rule-message rule) bindings) - (rule-severity rule) - (finding-extra-for-match - rule - bindings - match-text))))))) - (def (scan-generic-pattern rule path source pattern) - (let* ([spec (generic-pattern->regex-spec pattern)] - [rx (re (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)]) - (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))]) - (loop - next - (if finding - (append - (reverse (apply-rule-focus rule finding)) - acc) - acc))) - (reverse acc))))))) (def (xml-unordered-plugin-pattern? rule pattern) (let ([trimmed (string-trim pattern)]) (and (rule-option-explicit-false? --- a/src/.jerbuild-hashes +++ b/src/.jerbuild-hashes @@ -1,6 +1,6 @@ (("src/semgrep/output/sarif.ss" . "E935456E4B1921FB") - ("src/semgrep/engine/regex-scan.ss" . "D75414F0AEFE2F66") ("src/semgrep/result.ss" . "22D23E40B49BA529") + ("src/semgrep/engine/regex-scan.ss" . "D75414F0AEFE2F66") ("src/semgrep/engine/rule-plan.ss" . "6631789392AB5F80") ("src/semgrep/result/findings.ss" . "547811661239D9C7") ("src/semgrep/util/literals.ss" . "8A094085551B216E") @@ -12,10 +12,11 @@ ("src/semgrep/lang.ss" . "6982E07679D20836") ("src/semgrep/parse/parse-target.ss" . "97AA8FFEB12736DA") ("src/semgrep/result/extras.ss" . "DF0B3AAE2BAEB5D") - ("src/semgrep/scan.ss" . "A2521D6C86290D1C") - ("src/semgrep/output/text.ss" . "BE476CB84B807FBA") - ("src/semgrep/rule.ss" . "E12C108153C181FA") + ("src/semgrep/scan.ss" . "F4C01A26DBDDC2A5") ("src/semgrep/schema/lang.ss" . "CAE2CA859C9A9FD0") + ("src/semgrep/engine/generic-scan.ss" . "F69D0ACD0DD62610") + ("src/semgrep/rule.ss" . "E12C108153C181FA") + ("src/semgrep/output/text.ss" . "BE476CB84B807FBA") ("src/semgrep/source/offsets.ss" . "834EFDB706823794") ("src/semgrep/engine/regex-support.ss" . "9FCF118903259C97") ("src/semgrep/main.ss" . "A4EC9E7F2A09D25E") new file mode 100644 --- /dev/null +++ b/src/semgrep/engine/generic-scan.ss @@ -0,0 +1,347 @@ +(export + regex-escape-string + join-strings + string-contains-char? + scan-generic-pattern) + +(import (except (jerboa prelude) meta atom?) + (std regex) + (semgrep rule) + (semgrep result) + (semgrep result extras) + (semgrep engine regex-support) + (semgrep source offsets) + (semgrep match structural)) + +(define generic-separator-regex + "(?:\\s+|//[^\\n]*(?:\\n|$)|/\\*(?:.|\\n)*?\\*/)+") + +(define generic-optional-separator-regex + "(?:\\s+|//[^\\n]*(?:\\n|$)|/\\*(?:.|\\n)*?\\*/)*") + +;; A metavariable normally matches a bare or `$`-prefixed identifier. In +;; argument position (right after `(` or `,`) it may also be a single quoted +;; string, so call patterns like `f($X, ...)` can bind a string literal. The +;; string form is NOT allowed elsewhere, or a bare `$EXPR` pattern would match +;; string literals it should not. +(define generic-metavariable-regex + "(\\$?[A-Za-z0-9_]+|'[^'\\n]*'|\"[^\"\\n]*\")") + +(define generic-metavariable-identifier-regex + "(\\$?[A-Za-z0-9_]+)") + +(def (generic-metavariable-in-argument-position? source i) + (let loop ([j (- i 1)]) + (cond + [(< j 0) #f] + [(char-whitespace? (string-ref source j)) (loop (- j 1))] + [(or (char=? (string-ref source j) #\() + (char=? (string-ref source j) #\,)) + #t] + [else #f]))) + +(def (regex-special-char? ch) + (let loop ([xs '(#\\ #\. #\^ #\$ #\| #\? #\* #\+ #\( #\) #\[ #\] #\{ #\})]) + (and (not (null? xs)) + (or (char=? ch (car xs)) + (loop (cdr xs)))))) + +(def (regex-escape-char ch) + (if (regex-special-char? ch) + (string #\\ ch) + (string ch))) + +(def (regex-escape-string source) + (let ([len (string-length source)]) + (let loop ([i 0] [acc '()]) + (if (= i len) + (join-strings (reverse acc)) + (loop (+ i 1) + (cons (regex-escape-char (string-ref source i)) + acc)))))) + +(def (join-strings parts) + (let loop ([xs parts] [acc ""]) + (if (null? xs) + acc + (loop (cdr xs) (string-append acc (car xs)))))) + +(def (string-contains-char? s ch) + (let ([len (string-length s)]) + (let loop ([i 0]) + (cond + [(>= i len) #f] + [(char=? (string-ref s i) ch) #t] + [else (loop (+ i 1))])))) + +(def (generic-plain-ellipsis-at? source i) + (and (<= (+ i 3) (string-length source)) + (char=? (string-ref source i) #\.) + (char=? (string-ref source (+ i 1)) #\.) + (char=? (string-ref source (+ i 2)) #\.))) + +(def (generic-ellipsis-metavariable-at? source i) + (and (<= (+ i 4) (string-length source)) + (char=? (string-ref source i) #\$) + (char=? (string-ref source (+ i 1)) #\.) + (char=? (string-ref source (+ i 2)) #\.) + (char=? (string-ref source (+ i 3)) #\.) + (or (char-alphabetic? (string-ref source (+ i 4))) + (char=? (string-ref source (+ i 4)) #\_)))) + +(def (generic-skip-whitespace source i) + (let ([len (string-length source)]) + (let loop ([j i]) + (if (and (< j len) (char-whitespace? (string-ref source j))) + (loop (+ j 1)) + j)))) + +;; `, ...` in an argument list means "and zero or more further arguments", so +;; the comma and trailing ellipsis are together optional: `f($X, ...)` matches +;; both `f(a)` and `f(a, b)`. +(def (generic-comma-ellipsis-at? source i) + (and (< i (string-length source)) + (char=? (string-ref source i) #\,) + (generic-plain-ellipsis-at? + source + (generic-skip-whitespace source (+ i 1))))) + +;; An ellipsis inside an open CALL parenthesis should match across newlines, so +;; `sink(...)` matches a call whose arguments span multiple lines. The enclosing +;; `(` must be a call (preceded by an identifier): a bare grouping `(...)` keeps +;; the line-bounded form, so it does not span across whole files/statements. +(def (generic-ellipsis-inside-call-parens? source i) + (let loop ([j 0] [stack '()]) + (cond + [(>= j i) + (and (pair? stack) + (let ([open (car stack)]) + (and (> open 0) + (identifier-token-char? (string-ref source (- open 1))))))] + [(char=? (string-ref source j) #\() (loop (+ j 1) (cons j stack))] + [(char=? (string-ref source j) #\)) + (loop (+ j 1) (if (pair? stack) (cdr stack) stack))] + [else (loop (+ j 1) stack)]))) + +(def (generic-word-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_))) + +(def (identifier-token-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_))) + +(def (generic-space-punctuation? ch) + (and (not (char-whitespace? ch)) + (not (generic-word-char? ch)) + (not (char=? ch #\$)))) + +(def (generic-optional-space-context? source start end) + (let ([prev (and (> start 0) (string-ref source (- start 1)))] + [next (and (< end (string-length source)) (string-ref source end))]) + (or (and prev (generic-space-punctuation? prev)) + (and next (generic-space-punctuation? next))))) + +(def (generic-capture-name source marker-start name-start end) + (if (and (< (+ marker-start 3) name-start) + (char=? (string-ref source (+ marker-start 1)) #\.) + (char=? (string-ref source (+ marker-start 2)) #\.) + (char=? (string-ref source (+ marker-start 3)) #\.)) + (string-append "..." (substring source name-start end)) + (substring source name-start end))) + +(def (generic-pattern->regex-spec pattern) + (let* ([source (string-trim pattern)] + [len (string-length source)] + [plain-ellipsis (if (string-contains-char? source #\newline) + "(?:.|\\n)*?" + "[^\\n]*?")]) + (let loop ([i 0] [parts '()] [captures '()]) + (cond + [(>= i len) + (cons (join-strings (reverse parts)) (reverse captures))] + [(char-whitespace? (string-ref source i)) + (let ws-loop ([j (+ i 1)]) + (if (and (< j len) (char-whitespace? (string-ref source j))) + (ws-loop (+ j 1)) + (if (or (generic-plain-ellipsis-at? source j) + (generic-ellipsis-metavariable-at? source j) + (and (pair? parts) + (string=? (car parts) "((?:.|\\n)*?)"))) + (loop j parts captures) + (loop j + (cons (if (generic-optional-space-context? + source + i + j) + generic-optional-separator-regex + generic-separator-regex) + parts) + captures))))] + [(and (char=? (string-ref source i) #\$) + (< (+ i 4) len) + (char=? (string-ref source (+ i 1)) #\.) + (char=? (string-ref source (+ i 2)) #\.) + (char=? (string-ref source (+ i 3)) #\.) + (or (char-alphabetic? (string-ref source (+ i 4))) + (char=? (string-ref source (+ i 4)) #\_))) + (let name-loop ([j (+ i 5)]) + (if (and (< j len) + (or (char-alphabetic? (string-ref source j)) + (char-numeric? (string-ref source j)) + (char=? (string-ref source j) #\_))) + (name-loop (+ j 1)) + (loop j + (cons "((?:.|\\n)*?)" parts) + (cons (generic-capture-name source i (+ i 4) j) + captures))))] + [(and (char=? (string-ref source i) #\$) + (< (+ i 1) len) + (or (char-alphabetic? (string-ref source (+ i 1))) + (char=? (string-ref source (+ i 1)) #\_))) + (let name-loop ([j (+ i 2)]) + (if (and (< j len) + (or (char-alphabetic? (string-ref source j)) + (char-numeric? (string-ref source j)) + (char=? (string-ref source j) #\_))) + (name-loop (+ j 1)) + (loop j + (cons (if (generic-metavariable-in-argument-position? source i) + generic-metavariable-regex + generic-metavariable-identifier-regex) + parts) + (cons (generic-capture-name source i (+ i 1) j) + captures))))] + [(generic-comma-ellipsis-at? source i) + (let ([after (generic-skip-whitespace + source + (+ (generic-skip-whitespace source (+ i 1)) 3))]) + (loop after + (cons (string-append "(?:" + generic-optional-separator-regex + "," + generic-optional-separator-regex + plain-ellipsis + ")?") + parts) + captures))] + [(and (< (+ i 2) len) + (char=? (string-ref source i) #\.) + (char=? (string-ref source (+ i 1)) #\.) + (char=? (string-ref source (+ i 2)) #\.)) + (loop (generic-skip-whitespace source (+ i 3)) + (cons (if (generic-ellipsis-inside-call-parens? source i) + "(?:.|\\n)*?" + plain-ellipsis) + parts) + captures)] + [(generic-word-char? (string-ref source i)) + (let word-loop ([j (+ i 1)]) + (if (and (< j len) + (generic-word-char? (string-ref source j))) + (word-loop (+ j 1)) + (loop j + (cons (string-append "\\b" + (substring source i j) + "\\b") + parts) + captures)))] + [else + (loop (+ i 1) + (cons (regex-escape-char (string-ref source i)) parts) + 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 loop ([names capture-names] + [index 1] + [search-start 0] + [acc '()]) + (cond + [(null? names) (reverse acc)] + [else