Extract Semgrep TypeScript decorator scanners
ober
3ae0adbab089fc70368be40e7e3c1584c94074d6
--- a/SEMGREP_JERBOA_IMPLEMENTATION.md +++ b/SEMGREP_JERBOA_IMPLEMENTATION.md @@ -477,6 +477,8 @@ Completed in the repo: `src/semgrep/engine/markup-scan.ss` - extracted JavaScript `vardef_assign` text scanning into `src/semgrep/engine/js-vardef-scan.ss` + - extracted TypeScript decorator text scanning into + `src/semgrep/engine/ts-decorator-scan.ss` Validation at this checkpoint: new file mode 100644 --- /dev/null +++ b/lib/semgrep/engine/ts-decorator-scan.sls @@ -0,0 +1,460 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/semgrep/engine/ts-decorator-scan.ss + +(library (semgrep engine ts-decorator-scan) + (export + scan-typescript-decorated-field-pattern + scan-typescript-decorated-async-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 result findings) (semgrep engine regex-support) + (semgrep engine text-support) (semgrep source offsets) + (semgrep match structural)) + (def (alist-ref/default xs key default) + (let ([found (assoc key xs)]) + (if found (cdr found) default))) + (def (string-find-substring s needle) + (let ([len (string-length s)]) + (let loop ([i 0]) + (cond + [(> i len) #f] + [(substring-at? s needle i) i] + [else (loop (+ i 1))])))) + (def (sg-string-prefix? prefix s) + (let ([prefix-len (string-length prefix)] + [len (string-length s)]) + (and (<= prefix-len len) + (string=? (substring s 0 prefix-len) prefix)))) + (def (identifier-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_) + (char=? ch #\$))) + (def (identifier-start-char? ch) + (or (char-alphabetic? ch) (char=? ch #\_) (char=? ch #\$))) + (def (access-path-identifier-end text start) + (let ([len (string-length text)]) + (let loop ([i start]) + (if (and (< i len) (identifier-char? (string-ref text i))) + (loop (+ i 1)) + i)))) + (def (skip-whitespace source index) + (let ([len (string-length source)]) + (let loop ([i index]) + (if (and (< i len) (char-whitespace? (string-ref source i))) + (loop (+ i 1)) + i)))) + (def (jsx-name-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_) + (char=? ch #\$) + (char=? ch #\-) + (char=? ch #\:) + (char=? ch #\.))) + (def (jsx-name-range-at source start) + (let ([len (string-length source)]) + (and (< start len) + (jsx-name-char? (string-ref source start)) + (let loop ([i (+ start 1)]) + (if (and (< i len) (jsx-name-char? (string-ref source i))) + (loop (+ i 1)) + (cons start i)))))) + (def (find-matching-close-brace source open-index) + (let ([len (string-length source)]) + (let loop ([i open-index] + [depth 0] + [state 'normal] + [escaped? #f]) + (cond + [(= i len) #f] + [(eq? state 'string) + (let ([ch (string-ref source i)]) + (cond + [escaped? (loop (+ i 1) depth state #f)] + [(char=? ch #\\) (loop (+ i 1) depth state #t)] + [(char=? ch #\") (loop (+ i 1) depth 'normal #f)] + [else (loop (+ i 1) depth state #f)]))] + [(eq? state 'single) + (let ([ch (string-ref source i)]) + (cond + [escaped? (loop (+ i 1) depth state #f)] + [(char=? ch #\\) (loop (+ i 1) depth state #t)] + [(char=? ch #\') (loop (+ i 1) depth 'normal #f)] + [else (loop (+ i 1) depth state #f)]))] + [(eq? state 'template) + (let ([ch (string-ref source i)]) + (cond + [escaped? (loop (+ i 1) depth state #f)] + [(char=? ch #\\) (loop (+ i 1) depth state #t)] + [(char=? ch #\`) (loop (+ i 1) depth 'normal #f)] + [else (loop (+ i 1) depth state #f)]))] + [else + (let ([ch (string-ref source i)]) + (cond + [(char=? ch #\") (loop (+ i 1) depth 'string #f)] + [(char=? ch #\') (loop (+ i 1) depth 'single #f)] + [(char=? ch #\`) (loop (+ i 1) depth 'template #f)] + [(char=? ch #\{) (loop (+ i 1) (+ depth 1) state #f)] + [(char=? ch #\}) + (let ([next-depth (- depth 1)]) + (if (= next-depth 0) + (+ i 1) + (and (>= next-depth 0) + (loop (+ i 1) next-depth state #f))))] + [else (loop (+ i 1) depth state #f)]))])))) + (def (find-matching-close-paren source open-index) + (let ([len (string-length source)]) + (let loop ([i open-index] + [depth 0] + [state 'normal] + [escaped? #f]) + (cond + [(>= i len) #f] + [(eq? state 'normal) + (let ([ch (string-ref source i)]) + (cond + [(char=? ch #\") (loop (+ i 1) depth 'double #f)] + [(char=? ch #\') (loop (+ i 1) depth 'single #f)] + [(char=? ch #\`) (loop (+ i 1) depth 'backtick #f)] + [(char=? ch #\() (loop (+ i 1) (+ depth 1) state #f)] + [(char=? ch #\)) + (let ([next-depth (- depth 1)]) + (and (>= next-depth 0) + (if (= next-depth 0) + (+ i 1) + (loop (+ i 1) next-depth state #f))))] + [else (loop (+ i 1) depth state #f)]))] + [escaped? (loop (+ i 1) depth state #f)] + [(char=? (string-ref source i) #\\) + (loop (+ i 1) depth state #t)] + [(and (eq? state 'double) + (char=? (string-ref source i) #\")) + (loop (+ i 1) depth 'normal #f)] + [(and (eq? state 'single) + (char=? (string-ref source i) #\')) + (loop (+ i 1) depth 'normal #f)] + [(and (eq? state 'backtick) + (char=? (string-ref source i) #\`)) + (loop (+ i 1) depth 'normal #f)] + [else (loop (+ i 1) depth state #f)])))) + (def (drop-trailing-call-parens text) + (let ([len (string-length text)]) + (if (and (>= len 2) + (string=? (substring text (- len 2) len) "()")) + (substring text 0 (- len 2)) + text))) + (def (decorated-field-pattern-spec pattern) + (let* ([trimmed (string-trim pattern)] + [len (string-length trimmed)]) + (if (or (= len 0) (not (char=? (string-ref trimmed 0) #\@))) + #f + (let ([space (string-find-substring trimmed " ")]) + (if (not space) + #f + (let* ([decorator (drop-trailing-call-parens + (substring trimmed 1 space))] + [tail (string-trim + (substring trimmed (+ space 1) len))] + [colon (string-find-substring tail ":")]) + (if (not colon) + #f + (let ([field (string-trim + (substring tail 0 colon))] + [type-text (string-trim + (substring + tail + (+ colon 1) + (string-length tail)))]) + (and (string=? type-text "string") + (> (string-length field) 0) + (char=? (string-ref field 0) #\$) + (list + (cons 'decorator decorator) + (cons + 'decorator-metavariable + (and (> (string-length decorator) 0) + (char=? + (string-ref decorator 0) + #\$) + (normalize-metavariable-name + decorator))) + (cons + 'field-metavariable + (normalize-metavariable-name + field)))))))))))) + (define decorated-field-regex + "@([A-Za-z_$][A-Za-z0-9_$]*)(?:\\(\\))?[ \\t]+([A-Za-z_$][A-Za-z0-9_$]*)[ \\t]*:[ \\t]*string\\b") + (def (decorated-field-finding rule path source match spec) + (let* ([full (re-match-full match)] + [start (re-match-start match)] + [end (re-match-end match)] + [decorator-text (re-match-group match 1)] + [field-text (re-match-group match 2)] + [literal-decorator (alist-ref/default spec 'decorator #f)] + [decorator-var (alist-ref/default + spec + 'decorator-metavariable + #f)] + [field-var (alist-ref/default spec 'field-metavariable #f)]) + (and (or decorator-var + (string=? decorator-text literal-decorator)) + (let* ([decorator-relative (or (string-find-substring-from + full + decorator-text + 1) + 1)] + [field-relative (or (string-find-substring-from + full + field-text + (+ decorator-relative + (string-length + decorator-text))) + decorator-relative)] + [bindings (append + (if decorator-var + (list + (cons + decorator-var + (make-regex-capture-binding decorator-var decorator-text + source + (+ start decorator-relative) + (+ start + decorator-relative + (string-length + decorator-text))))) + '()) + (list + (cons + field-var + (make-regex-capture-binding field-var field-text source + (+ start field-relative) + (+ start + field-relative + (string-length field-text))))))] + [message (render-fix-template + (rule-message rule) + bindings)] + [extra (finding-extra-for-match + rule + bindings + (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 message (rule-severity rule) + extra)))))) + (def (scan-typescript-decorated-field-pattern + rule + path + source + pattern) + (let ([spec (decorated-field-pattern-spec pattern)]) + (and spec + (let ([rx (re decorated-field-regex)] + [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 (decorated-field-finding rule path source match spec)] + [next (max (+ (re-match-start match) 1) + (re-match-end match))]) + (loop + next + (if finding (cons finding acc) acc))) + (reverse acc))))))))) + (def (drop-decorator-call-suffix text) + (let ([open (string-find-substring text "(")]) + (if open (substring text 0 open) text))) + (def (first-line-end text) + (or (string-find-substring text "\n") (string-length text))) + (def (decorator-token-boundary? source index) + (or (>= index (string-length source)) + (not (identifier-char? (string-ref source index))))) + (def (decorated-modifier-at? source index modifier) + (let ([end (+ index (string-length modifier))]) + (and (substring-at? source modifier index) + (or (>= end (string-length source)) + (not (identifier-char? (string-ref source end))))))) + (def (decorated-modifier-end source index modifier) + (and (decorated-modifier-at? source index modifier) + (skip-whitespace + source + (+ index (string-length modifier))))) + (def (decorated-async-pattern-spec pattern) + (let* ([trimmed (string-trim pattern)] + [len (string-length trimmed)]) + (and (> len 0) + (char=? (string-ref trimmed 0) #\@) + (let* ([line-end (first-line-end trimmed)] + [decorator (drop-decorator-call-suffix + (string-trim + (substring trimmed 1 line-end)))] + [tail (string-trim (substring trimmed line-end len))] + [modifier (cond + [(sg-string-prefix? "async " tail) 'async] + [(sg-string-prefix? "static " tail) + 'static] + [else #f])] + [name-start (case modifier + [(async) (string-length "async ")] + [(static) (string-length "static ")] + [else #f])] + [name-range (and name-start + (jsx-name-range-at tail name-start))] + [name (and name-range + (substring + tail + (car name-range) + (cdr name-range)))] + [after-name (and name-range + (skip-whitespace + tail + (cdr name-range)))] + [method? (and after-name + (< after-name (string-length tail)) + (char=? + (string-ref tail after-name) + #\())] + [body? (and (string-find-substring tail "{") #t)]) + (and (> (string-length decorator) 0) + name + (list + (cons 'decorator decorator) + (cons 'modifier modifier) + (cons 'name name) + (cons + 'kind + (cond + [body? 'method-body] + [method? 'method] + [else 'property])))))))) + (def (decorated-async-target-at source start spec) + (let* ([decorator (alist-ref/default spec 'decorator "")] + [decorator-end (+ start 1 (string-length decorator))] + [kind (alist-ref/default spec 'kind #f)] + [modifier (alist-ref/default spec 'modifier #f)] + [target-name (alist-ref/default spec 'name "")] + [after-decorator0 (skip-whitespace source decorator-end)] + [after-decorator (and (decorator-token-boundary? + source + decorator-end) + (if (and (< after-decorator0 + (string-length source)) + (char=? + (string-ref + source + after-decorator0) + #\()) + (find-matching-close-paren + source + after-decorator0) + after-decorator0))] + [line-end (and after-decorator + (line-end-after source after-decorator))] + [decl-start (and line-end + (< line-end (string-length source)) + (skip-whitespace source (+ line-end 1)))] + [after-static (and decl-start + (decorated-modifier-end + source + decl-start + "static"))] + [after-optional-static (or after-static decl-start)] + [after-async (and after-optional-static + (decorated-modifier-end + source + after-optional-static + "async"))] + [after-static-optional-async (and after-static + (or (decorated-modifier-end + source + after-static + "async") + after-static))] + [after-modifiers (case modifier + [(async) after-async] + [(static) after-static-optional-async] + [else #f])] + [name-end (and after-modifiers + (< after-modifiers (string-length source)) + (identifier-start-char? + (string-ref source after-modifiers)) + (access-path-identifier-end + source + after-modifiers))] + [name (and name-end + (substring source after-modifiers name-end))] + [after-name (and name-end + (skip-whitespace source name-end))] + [method-open? (and after-name + (< after-name (string-length source)) + (char=? + (string-ref source after-name) + #\())] + [param-close (and method-open? + (find-matching-close-paren + source + after-name))] + [body-open (and param-close + (skip-whitespace source param-close))] + [body-close (and body-open + (< body-open (string-length source)) + (char=? (string-ref source body-open) #\{) + (find-matching-close-brace + source + body-open))] + [end (and name + (string=? name target-name) + (case kind + [(property) (and (not method-open?) name-end)] + [(method) param-close] + [(method-body) body-close] + [else #f]))]) + (and end (cons start end)))) + (def (decorated-async-finding rule path source range) + (finding-for-range-with-bindings rule path source + (car range) (cdr range) '())) + (def (scan-typescript-decorated-async-pattern + rule + path + source + pattern) + (let ([spec (decorated-async-pattern-spec pattern)]) + (and spec + (let* ([decorator (alist-ref/default spec 'decorator "")] + [needle (string-append "@" decorator)] + [len (string-length source)]) + (let loop ([start 0] [acc '()]) + (let ([index (string-find-substring-from + source + needle + start)]) + (if (or (not index) (> index len)) + (reverse acc) + (let* ([range (decorated-async-target-at + source + index + spec)] + [finding (and range + (decorated-async-finding + rule + path + source + range))] + [next (if range + (max (+ index 1) (cdr range)) + (+ index 1))]) + (loop + next + (if finding (cons finding acc) acc))))))))))) --- a/lib/semgrep/scan.sls +++ b/lib/semgrep/scan.sls @@ -20,10 +20,12 @@ (semgrep engine generic-scan) (semgrep engine js-vardef-scan) (semgrep engine markup-scan) (semgrep engine regex-scan) (semgrep engine rule-plan) - (semgrep engine regex-support) (semgrep engine text-support) - (semgrep rule parse-rule) (semgrep parse parse-target) - (semgrep source offsets) (semgrep targeting path-filter) - (semgrep util literals) (semgrep match structural)) + (semgrep engine regex-support) + (semgrep engine ts-decorator-scan) + (semgrep engine text-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))) @@ -146,12 +148,6 @@ (char=? (string-ref source (- i 1)) #\newline)) (loop (- i 1)) i))) - (def (drop-trailing-call-parens text) - (let ([len (string-length text)]) - (if (and (>= len 2) - (string=? (substring text (- len 2) len) "()")) - (substring text 0 (- len 2)) - text))) (def (identifier-boundary-before? source index) (or (= index 0) (not (identifier-char? (string-ref source (- index 1)))))) @@ -170,314 +166,6 @@ (string-ref source (- start 1)))) (loop (- start 1)) (substring source start (+ before 1))))))) - (def (decorated-field-pattern-spec pattern) - (let* ([trimmed (string-trim pattern)] - [len (string-length trimmed)]) - (if (or (= len 0) (not (char=? (string-ref trimmed 0) #\@))) - #f - (let ([space (string-find-substring trimmed " ")]) - (if (not space) - #f - (let* ([decorator (drop-trailing-call-parens - (substring trimmed 1 space))] - [tail (string-trim - (substring trimmed (+ space 1) len))] - [colon (string-find-substring tail ":")]) - (if (not colon) - #f - (let ([field (string-trim - (substring tail 0 colon))] - [type-text (string-trim - (substring - tail - (+ colon 1) - (string-length tail)))]) - (and (string=? type-text "string") - (> (string-length field) 0) - (char=? (string-ref field 0) #\$) - (list - (cons 'decorator decorator) - (cons - 'decorator-metavariable - (and (> (string-length decorator) 0) - (char=? - (string-ref decorator 0) - #\$) - (normalize-metavariable-name - decorator))) - (cons - 'field-metavariable - (normalize-metavariable-name - field)))))))))))) - (def decorated-field-regex - "@([A-Za-z_$][A-Za-z0-9_$]*)(?:\\(\\))?[ \\t]+([A-Za-z_$][A-Za-z0-9_$]*)[ \\t]*:[ \\t]*string\\b") - (def (decorated-field-finding rule path source match spec) - (let* ([full (re-match-full match)] - [start (re-match-start match)] - [end (re-match-end match)] - [decorator-text (re-match-group match 1)] - [field-text (re-match-group match 2)] - [literal-decorator (alist-ref/default spec 'decorator #f)] - [decorator-var (alist-ref/default - spec - 'decorator-metavariable - #f)] - [field-var (alist-ref/default spec 'field-metavariable #f)]) - (and (or decorator-var - (string=? decorator-text literal-decorator)) - (let* ([decorator-relative (or (string-find-substring-from - full - decorator-text - 1) - 1)] - [field-relative (or (string-find-substring-from - full - field-text - (+ decorator-relative - (string-length - decorator-text))) - decorator-relative)] - [bindings (append - (if decorator-var - (list - (cons - decorator-var - (make-regex-capture-binding decorator-var decorator-text - source - (+ start decorator-relative) - (+ start - decorator-relative - (string-length - decorator-text))))) - '()) - (list - (cons - field-var - (make-regex-capture-binding field-var field-text source - (+ start field-relative) - (+ start - field-relative - (string-length field-text))))))] - [message (render-fix-template - (rule-message rule) - bindings)] - [extra (finding-extra-for-match - rule - bindings - (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 message (rule-severity rule) - extra)))))) - (def (scan-typescript-decorated-field-pattern - rule - path - source - pattern) - (let ([spec (decorated-field-pattern-spec pattern)]) - (and spec - (let ([rx (re decorated-field-regex)] - [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 (decorated-field-finding rule path source match spec)] - [next (max (+ (re-match-start match) 1) - (re-match-end match))]) - (loop - next - (if finding (cons finding acc) acc))) - (reverse acc))))))))) - (def (drop-decorator-call-suffix text) - (let ([open (string-find-substring text "(")]) - (if open (substring text 0 open) text))) - (def (first-line-end text) - (or (string-find-substring text "\n") (string-length text))) - (def (decorated-async-pattern-spec pattern) - (let* ([trimmed (string-trim pattern)] - [len (string-length trimmed)]) - (and (> len 0) - (char=? (string-ref trimmed 0) #\@) - (let* ([line-end (first-line-end trimmed)] - [decorator (drop-decorator-call-suffix - (string-trim - (substring trimmed 1 line-end)))] - [tail (string-trim (substring trimmed line-end len))] - [modifier (cond - [(sg-string-prefix? "async " tail) 'async] - [(sg-string-prefix? "static " tail) - 'static] - [else #f])] - [name-start (case modifier - [(async) (string-length "async ")] - [(static) (string-length "static ")] - [else #f])] - [name-range (and name-start - (jsx-name-range-at tail name-start))] - [name (and name-range - (substring - tail - (car name-range) - (cdr name-range)))] - [after-name (and name-range - (skip-whitespace - tail - (cdr name-range)))] - [method? (and after-name - (< after-name (string-length tail)) - (char=? - (string-ref tail after-name) - #\())] - [body? (and (string-find-substring tail "{") #t)]) - (and (> (string-length decorator) 0) - name - (list - (cons 'decorator decorator) - (cons 'modifier modifier) - (cons 'name name) - (cons - 'kind - (cond - [body? 'method-body] - [method? 'method] - [else 'property])))))))) - (def (decorator-token-boundary? source index) - (or (>= index (string-length source)) - (not (identifier-char? (string-ref source index))))) - (def (decorated-modifier-at? source index modifier) - (let ([end (+ index (string-length modifier))]) - (and (substring-at? source modifier index) - (or (>= end (string-length source)) - (not (identifier-char? (string-ref source end))))))) - (def (decorated-modifier-end source index modifier) - (and (decorated-modifier-at? source index modifier) - (skip-whitespace - source - (+ index (string-length modifier))))) - (def (decorated-async-target-at source start spec) - (let* ([decorator (alist-ref/default spec 'decorator "")] - [decorator-end (+ start 1 (string-length decorator))] - [kind (alist-ref/default spec 'kind #f)] - [modifier (alist-ref/default spec 'modifier #f)] - [target-name (alist-ref/default spec 'name "")] - [after-decorator0 (skip-whitespace source decorator-end)] - [after-decorator (and (decorator-token-boundary? - source - decorator-end) - (if (and (< after-decorator0 - (string-length source)) - (char=? - (string-ref - source - after-decorator0) - #\()) - (find-matching-close-paren - source - after-decorator0) - after-decorator0))] - [line-end (and after-decorator - (line-end-after source after-decorator))] - [decl-start (and line-end - (< line-end (string-length source)) - (skip-whitespace source (+ line-end 1)))] - [after-static (and decl-start - (decorated-modifier-end - source - decl-start - "static"))] - [after-optional-static (or after-static decl-start)] - [after-async (and after-optional-static - (decorated-modifier-end - source - after-optional-static - "async"))] - [after-static-optional-async (and after-static - (or (decorated-modifier-end - source - after-static - "async") - after-static))] - [after-modifiers (case modifier - [(async) after-async] - [(static) after-static-optional-async] - [else #f])] - [name-end (and after-modifiers - (< after-modifiers (string-length source)) - (identifier-start-char? - (string-ref source after-modifiers)) - (access-path-identifier-end - source - after-modifiers))] - [name (and name-end - (substring source after-modifiers name-end))] - [after-name (and name-end - (skip-whitespace source name-end))] - [method-open? (and after-name - (< after-name (string-length source)) - (char=? - (string-ref source after-name) - #\())] - [param-close (and method-open? - (find-matching-close-paren - source - after-name))] - [body-open (and param-close - (skip-whitespace source param-close))] - [body-close (and body-open - (< body-open (string-length source)) - (char=? (string-ref source body-open) #\{) - (find-matching-close-brace - source - body-open))] - [end (and name - (string=? name target-name) - (case kind - [(property) (and (not method-open?) name-end)] - [(method) param-close] - [(method-body) body-close] - [else #f]))]) - (and end (cons start end)))) - (def (decorated-async-finding rule path source range) - (finding-for-range-with-bindings rule path source - (car range) (cdr range) '())) - (def (scan-typescript-decorated-async-pattern - rule - path - source - pattern) - (let ([spec (decorated-async-pattern-spec pattern)]) - (and spec - (let* ([decorator (alist-ref/default spec 'decorator "")] - [needle (string-append "@" decorator)] - [len (string-length source)]) - (let loop ([start 0] [acc '()]) - (let ([index (string-find-substring-from - source - needle - start)]) - (if (or (not index) (> index len)) - (reverse acc) - (let* ([range (decorated-async-target-at - source - index - spec)] - [finding (and range - (decorated-async-finding - rule - path - source - range))] - [next (if range - (max (+ index 1) (cdr range)) - (+ index 1))]) - (loop - next - (if finding (cons finding acc) acc)))))))))) (def (json-key-value-pattern-spec pattern) (let* ([match (re-search (re "\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*:[ \\t]*([^,}\\n]+)") --- a/src/.jerbuild-hashes +++ b/src/.jerbuild-hashes @@ -1,14 +1,14 @@ -(("src/semgrep/output/sarif.ss" . "E935456E4B1921FB") - ("src/semgrep/engine/js-vardef-scan.ss" +(("src/semgrep/engine/js-vardef-scan.ss" . "BD82BDDFEDD7242D") - ("src/semgrep/result.ss" . "22D23E40B49BA529") + ("src/semgrep/output/sarif.ss" . "E935456E4B1921FB") ("src/semgrep/engine/regex-scan.ss" . "D75414F0AEFE2F66") + ("src/semgrep/result.ss" . "22D23E40B49BA529") ("src/semgrep/engine/rule-plan.ss" . "6631789392AB5F80") ("src/semgrep/result/findings.ss" . "547811661239D9C7") ("src/semgrep/util/literals.ss" . "8A094085551B216E") - ("src/semgrep/fix.ss" . "2E5B65B1FEF3B2B1") ("src/semgrep/engine/markup-scan.ss" . "40AF9B537485FE0") + ("src/semgrep/fix.ss" . "2E5B65B1FEF3B2B1") ("src/semgrep/match/structural.ss" . "5BA4F1566448AF3A") ("src/semgrep/targeting/path-filter.ss" . "9900721941C6B96") ("src/semgrep/rule/parse-rule.ss" . "EFA6D401699CEDEF") @@ -16,14 +16,17 @@ ("src/semgrep/lang.ss" . "6982E07679D20836") ("src/semgrep/parse/parse-target.ss" . "97AA8FFEB12736DA") ("src/semgrep/result/extras.ss" . "DF0B3AAE2BAEB5D") - ("src/semgrep/scan.ss" . "D0040BF672A86721") - ("src/semgrep/engine/generic-scan.ss" . "F69D0ACD0DD62610") - ("src/semgrep/schema/lang.ss" . "CAE2CA859C9A9FD0") - ("src/semgrep/rule.ss" . "E12C108153C181FA") + ("src/semgrep/scan.ss" . "DFDCA45558E30244") ("src/semgrep/output/text.ss" . "BE476CB84B807FBA") + ("src/semgrep/rule.ss" . "E12C108153C181FA") + ("src/semgrep/schema/lang.ss" . "CAE2CA859C9A9FD0") + ("src/semgrep/engine/generic-scan.ss" . "F69D0ACD0DD62610") ("src/semgrep/source/offsets.ss" . "834EFDB706823794") ("src/semgrep/engine/regex-support.ss" . "9FCF118903259C97") ("src/semgrep/main.ss" . "A4EC9E7F2A09D25E") - ("src/semgrep/result/builders.ss" . "93A64AF4435E6132") + ("src/semgrep/engine/ts-decorator-scan.ss" + . + "610AA3A90D6A95F8") ("src/semgrep/engine/text-support.ss" . "644AF29394C53045") + ("src/semgrep/result/builders.ss" . "93A64AF4435E6132") ("src/semgrep/cli.ss" . "EBDC4B1DAD3F13CC")) new file mode 100644 --- /dev/null +++ b/src/semgrep/engine/ts-decorator-scan.ss @@ -0,0 +1,460 @@ +(export + scan-typescript-decorated-field-pattern + scan-typescript-decorated-async-pattern) + +(import (except (jerboa prelude) meta atom?) + (std regex) + (semgrep rule) + (semgrep result) + (semgrep result extras) + (semgrep result findings) + (semgrep engine regex-support) + (semgrep engine text-support) + (semgrep source offsets) + (semgrep match structural)) + +(def (alist-ref/default xs key default) + (let ([found (assoc key xs)]) + (if found (cdr found) default))) + +(def (string-find-substring s needle) + (let ([len (string-length s)]) + (let loop ([i 0]) + (cond + [(> i len) #f] + [(substring-at? s needle i) i] + [else (loop (+ i 1))])))) + +(def (sg-string-prefix? prefix s) + (let ([prefix-len (string-length prefix)] + [len (string-length s)]) + (and (<= prefix-len len) + (string=? (substring s 0 prefix-len) prefix)))) + +(def (identifier-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_) + (char=? ch #\$))) + +(def (identifier-start-char? ch) + (or (char-alphabetic? ch) + (char=? ch #\_) + (char=? ch #\$))) + +(def (access-path-identifier-end text start) + (let ([len (string-length text)]) + (let loop ([i start]) + (if (and (< i len) + (identifier-char? (string-ref text i))) + (loop (+ i 1)) + i)))) + +(def (skip-whitespace source index) + (let ([len (string-length source)]) + (let loop ([i index]) + (if (and (< i len) (char-whitespace? (string-ref source i))) + (loop (+ i 1)) + i)))) + +(def (jsx-name-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_) + (char=? ch #\$) + (char=? ch #\-) + (char=? ch #\:) + (char=? ch #\.))) + +(def (jsx-name-range-at source start) + (let ([len (string-length source)]) + (and (< start len) + (jsx-name-char? (string-ref source start)) + (let loop ([i (+ start 1)]) + (if (and (< i len) + (jsx-name-char? (string-ref source i))) + (loop (+ i 1)) + (cons start i)))))) + +(def (find-matching-close-brace source open-index) + (let ([len (string-length source)]) + (let loop ([i open-index] [depth 0] [state 'normal] [escaped? #f]) + (cond + [(= i len) #f] + [(eq? state 'string) + (let ([ch (string-ref source i)]) + (cond + [escaped? (loop (+ i 1) depth state #f)] + [(char=? ch #\\) (loop (+ i 1) depth state #t)] + [(char=? ch #\") (loop (+ i 1) depth 'normal #f)] + [else (loop (+ i 1) depth state #f)]))] + [(eq? state 'single) + (let ([ch (string-ref source i)]) + (cond + [escaped? (loop (+ i 1) depth state #f)] + [(char=? ch #\\) (loop (+ i 1) depth state #t)] + [(char=? ch #\') (loop (+ i 1) depth 'normal #f)] + [else (loop (+ i 1) depth state #f)]))] + [(eq? state 'template) + (let ([ch (string-ref source i)]) + (cond + [escaped? (loop (+ i 1) depth state #f)] + [(char=? ch #\\) (loop (+ i 1) depth state #t)] + [(char=? ch #\`) (loop (+ i 1) depth 'normal #f)] + [else (loop (+ i 1) depth state #f)]))] + [else + (let ([ch (string-ref source i)]) + (cond + [(char=? ch #\") (loop (+ i 1) depth 'string #f)] + [(char=? ch #\') (loop (+ i 1) depth 'single #f)] + [(char=? ch #\`) (loop (+ i 1) depth 'template #f)] + [(char=? ch #\{) (loop (+ i 1) (+ depth 1) state #f)] + [(char=? ch #\}) + (let ([next-depth (- depth 1)]) + (if (= next-depth 0) + (+ i 1) + (and (>= next-depth 0) + (loop (+ i 1) next-depth state #f))))] + [else (loop (+ i 1) depth state #f)]))])))) + +(def (find-matching-close-paren source open-index) + (let ([len (string-length source)]) + (let loop ([i open-index] [depth 0] [state 'normal] [escaped? #f]) + (cond + [(>= i len) #f] + [(eq? state 'normal) + (let ([ch (string-ref source i)]) + (cond + [(char=? ch #\") (loop (+ i 1) depth 'double #f)] + [(char=? ch #\') (loop (+ i 1) depth 'single #f)] + [(char=? ch #\`) (loop (+ i 1) depth 'backtick #f)] + [(char=? ch #\() (loop (+ i 1) (+ depth 1) state #f)] + [(char=? ch #\)) + (let ([next-depth (- depth 1)]) + (and (>= next-depth 0) + (if (= next-depth 0) + (+ i 1)