Extract Semgrep JavaScript decorator scanners
ober
360f79dbb86f8e76e33445f2e5768de55d8d7c16
--- a/SEMGREP_JERBOA_IMPLEMENTATION.md +++ b/SEMGREP_JERBOA_IMPLEMENTATION.md @@ -479,6 +479,8 @@ Completed in the repo: `src/semgrep/engine/js-vardef-scan.ss` - extracted TypeScript decorator text scanning into `src/semgrep/engine/ts-decorator-scan.ss` + - extracted JavaScript decorator-method text scanning into + `src/semgrep/engine/js-decorator-scan.ss` Validation at this checkpoint: new file mode 100644 --- /dev/null +++ b/lib/semgrep/engine/js-decorator-scan.sls @@ -0,0 +1,190 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/semgrep/engine/js-decorator-scan.ss + +(library (semgrep engine js-decorator-scan) + (export scan-javascript-decorated-method-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 engine regex-support) + (semgrep engine text-support)) + (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] + [(string=? + (substring s i (min len (+ i (string-length needle)))) + needle) + i] + [else (loop (+ i 1))])))) + (def (javascript-decorated-method-pattern-spec pattern) + (let* ([trimmed (string-trim pattern)] + [match (re-search + (re "^@\\$([A-Za-z_][A-Za-z0-9_]*)(?:[ \\t]*\\([ \\t]*\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*\\))?[ \\t]+\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*\\([ \\t]*\\)[ \\t]*:[ \\t]*string(?:[ \\t]*\\{[ \\t]*\\.\\.\\.[ \\t]*\\})?[ \\t]*$") + trimmed + 0)]) + (and match + (list + (cons 'decorator-var (re-match-group match 1)) + (cons 'field-var (re-match-group match 2)) + (cons 'name-var (re-match-group match 3)) + (cons + 'body? + (and (string-find-substring trimmed "{") #t)))))) + (def (javascript-decorator-line-info + source + line-start + line-end) + (let* ([first (line-first-nonspace + source + line-start + line-end)] + [line (substring source first line-end)] + [match (re-search + (re "^@([A-Za-z_$][A-Za-z0-9_$]*)(?:[ \\t]*\\((.*)\\))?[ \\t]*$") + line + 0)]) + (and match + (let* ([decorator (re-match-group match 1)] + [field (re-match-group match 2)] + [decorator-start (+ first 1)] + [field-start (and field + (string-find-substring-from + source + field + (+ decorator-start + (string-length decorator))))]) + (list (cons 'start first) (cons 'decorator decorator) + (cons 'decorator-start decorator-start) + (cons 'field field) (cons 'field-start field-start)))))) + (def (find-matching-close-brace source open) + (let ([len (string-length source)]) + (let loop ([i (+ open 1)] [depth 1]) + (cond + [(>= i len) #f] + [(char=? (string-ref source i) #\{) + (loop (+ i 1) (+ depth 1))] + [(char=? (string-ref source i) #\}) + (if (= depth 1) (+ i 1) (loop (+ i 1) (- depth 1)))] + [else (loop (+ i 1) depth)])))) + (def (javascript-decorated-method-signature-info + source + line-start) + (let* ([line-end (line-end-after source line-start)] + [first (line-first-nonspace source line-start line-end)] + [line (substring source first line-end)] + [match (re-search + (re "^([A-Za-z_$][A-Za-z0-9_$]*)[ \\t]*\\([ \\t]*\\)[ \\t]*:[ \\t]*string") + line + 0)]) + (and match + (let* ([name (re-match-group match 1)] + [name-start (string-find-substring-from + source + name + first)] + [signature-end (+ first (re-match-end match))] + [body-open (string-find-substring-from + source + "{" + signature-end)] + [body-close (and body-open + (find-matching-close-brace + source + body-open))]) + (list (cons 'name name) (cons 'name-start name-start) + (cons 'signature-end signature-end) + (cons 'body-open body-open) + (cons 'body-close body-close)))))) + (def (javascript-decorated-method-finding rule path source + spec decorator info) + (let* ([field-var (alist-ref/default spec 'field-var #f)] + [decorator-var (alist-ref/default spec 'decorator-var "")] + [name-var (alist-ref/default spec 'name-var "")] + [field (alist-ref/default decorator 'field #f)] + [field-start (alist-ref/default decorator 'field-start #f)] + [decorator-name (alist-ref/default decorator 'decorator "")] + [decorator-start (alist-ref/default + decorator + 'decorator-start + 0)] + [name (alist-ref/default info 'name "")] + [name-start (alist-ref/default info 'name-start #f)] + [start (alist-ref/default decorator 'start 0)] + [end (if (alist-ref/default spec 'body? #f) + (alist-ref/default info 'body-close #f) + (alist-ref/default info 'signature-end #f))]) + (and end + name-start + (if field-var field (not field)) + (let ([bindings (append + (list + (cons + decorator-var + (metavariable-binding-for-range + decorator-var + source + decorator-start + (+ decorator-start + (string-length decorator-name)))) + (cons + name-var + (metavariable-binding-for-range + name-var + source + name-start + (+ name-start + (string-length name))))) + (if (and field-var field field-start) + (list + (cons + field-var + (metavariable-binding-for-range + field-var + source + field-start + (+ field-start + (string-length field))))) + '()))]) + (finding-for-range-with-bindings rule path source start end + bindings))))) + (def (scan-javascript-decorated-method-pattern + rule + path + source + pattern) + (let ([spec (javascript-decorated-method-pattern-spec + pattern)]) + (and spec + (let ([len (string-length source)]) + (let loop ([line-start 0] [acc '()]) + (if (> line-start len) + (nonempty-findings (reverse acc)) + (let* ([line-end (line-end-after source line-start)] + [decorator (javascript-decorator-line-info + source + line-start + line-end)] + [next-line (if (< line-end len) + (+ line-end 1) + (+ len 1))] + [info (and decorator + (< next-line len) + (javascript-decorated-method-signature-info + source + next-line))] + [finding (and decorator + info + (javascript-decorated-method-finding rule path source spec + decorator info))]) + (loop + next-line + (if finding (cons finding acc) acc)))))))))) --- a/lib/semgrep/scan.sls +++ b/lib/semgrep/scan.sls @@ -18,9 +18,10 @@ (semgrep result) (semgrep result builders) (semgrep result extras) (semgrep result findings) (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 js-vardef-scan) + (semgrep engine js-decorator-scan) + (semgrep engine markup-scan) (semgrep engine regex-scan) + (semgrep engine rule-plan) (semgrep engine regex-support) (semgrep engine ts-decorator-scan) (semgrep engine text-support) (semgrep rule parse-rule) (semgrep parse parse-target) (semgrep source offsets) @@ -3010,159 +3011,6 @@ [(try-catch) (scan-javascript-try-catch-pattern rule path source spec)] [else #f])))) - (def (javascript-decorated-method-pattern-spec pattern) - (let* ([trimmed (string-trim pattern)] - [match (re-search - (re "^@\\$([A-Za-z_][A-Za-z0-9_]*)(?:[ \\t]*\\([ \\t]*\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*\\))?[ \\t]+\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*\\([ \\t]*\\)[ \\t]*:[ \\t]*string(?:[ \\t]*\\{[ \\t]*\\.\\.\\.[ \\t]*\\})?[ \\t]*$") - trimmed - 0)]) - (and match - (list - (cons 'decorator-var (re-match-group match 1)) - (cons 'field-var (re-match-group match 2)) - (cons 'name-var (re-match-group match 3)) - (cons - 'body? - (and (string-find-substring trimmed "{") #t)))))) - (def (javascript-decorator-line-info - source - line-start - line-end) - (let* ([first (line-first-nonspace - source - line-start - line-end)] - [line (substring source first line-end)] - [match (re-search - (re "^@([A-Za-z_$][A-Za-z0-9_$]*)(?:[ \\t]*\\((.*)\\))?[ \\t]*$") - line - 0)]) - (and match - (let* ([decorator (re-match-group match 1)] - [field (re-match-group match 2)] - [decorator-start (+ first 1)] - [field-start (and field - (string-find-substring-from - source - field - (+ decorator-start - (string-length decorator))))]) - (list (cons 'start first) (cons 'decorator decorator) - (cons 'decorator-start decorator-start) - (cons 'field field) (cons 'field-start field-start)))))) - (def (javascript-decorated-method-signature-info - source - line-start) - (let* ([line-end (line-end-after source line-start)] - [first (line-first-nonspace source line-start line-end)] - [line (substring source first line-end)] - [match (re-search - (re "^([A-Za-z_$][A-Za-z0-9_$]*)[ \\t]*\\([ \\t]*\\)[ \\t]*:[ \\t]*string") - line - 0)]) - (and match - (let* ([name (re-match-group match 1)] - [name-start (string-find-substring-from - source - name - first)] - [signature-end (+ first (re-match-end match))] - [body-open (string-find-substring-from - source - "{" - signature-end)] - [body-close (and body-open - (find-matching-close-brace - source - body-open))]) - (list (cons 'name name) (cons 'name-start name-start) - (cons 'signature-end signature-end) - (cons 'body-open body-open) - (cons 'body-close body-close)))))) - (def (javascript-decorated-method-finding rule path source - spec decorator info) - (let* ([field-var (alist-ref/default spec 'field-var #f)] - [decorator-var (alist-ref/default spec 'decorator-var "")] - [name-var (alist-ref/default spec 'name-var "")] - [field (alist-ref/default decorator 'field #f)] - [field-start (alist-ref/default decorator 'field-start #f)] - [decorator-name (alist-ref/default decorator 'decorator "")] - [decorator-start (alist-ref/default - decorator - 'decorator-start - 0)] - [name (alist-ref/default info 'name "")] - [name-start (alist-ref/default info 'name-start #f)] - [start (alist-ref/default decorator 'start 0)] - [end (if (alist-ref/default spec 'body? #f) - (alist-ref/default info 'body-close #f) - (alist-ref/default info 'signature-end #f))]) - (and end - name-start - (if field-var field (not field)) - (let ([bindings (append - (list - (cons - decorator-var - (metavariable-binding-for-range - decorator-var - source - decorator-start - (+ decorator-start - (string-length decorator-name)))) - (cons - name-var - (metavariable-binding-for-range - name-var - source - name-start - (+ name-start - (string-length name))))) - (if (and field-var field field-start) - (list - (cons - field-var - (metavariable-binding-for-range - field-var - source - field-start - (+ field-start - (string-length field))))) - '()))]) - (finding-for-range-with-bindings rule path source start end - bindings))))) - (def (scan-javascript-decorated-method-pattern - rule - path - source - pattern) - (let ([spec (javascript-decorated-method-pattern-spec - pattern)]) - (and spec - (let ([len (string-length source)]) - (let loop ([line-start 0] [acc '()]) - (if (> line-start len) - (nonempty-findings (reverse acc)) - (let* ([line-end (line-end-after source line-start)] - [decorator (javascript-decorator-line-info - source - line-start - line-end)] - [next-line (if (< line-end len) - (+ line-end 1) - (+ len 1))] - [info (and decorator - (< next-line len) - (javascript-decorated-method-signature-info - source - next-line))] - [finding (and decorator - info - (javascript-decorated-method-finding rule path source spec - decorator info))]) - (loop - next-line - (if finding (cons finding acc) acc))))))))) (def (javascript-export-function-pattern-spec pattern) (let* ([trimmed (string-trim pattern)] [match (re-search --- a/src/.jerbuild-hashes +++ b/src/.jerbuild-hashes @@ -16,7 +16,10 @@ ("src/semgrep/lang.ss" . "6982E07679D20836") ("src/semgrep/parse/parse-target.ss" . "97AA8FFEB12736DA") ("src/semgrep/result/extras.ss" . "DF0B3AAE2BAEB5D") - ("src/semgrep/scan.ss" . "DFDCA45558E30244") + ("src/semgrep/engine/js-decorator-scan.ss" + . + "193758AD2E444FD6") + ("src/semgrep/scan.ss" . "848B40CD850A0B6D") ("src/semgrep/output/text.ss" . "BE476CB84B807FBA") ("src/semgrep/rule.ss" . "E12C108153C181FA") ("src/semgrep/schema/lang.ss" . "CAE2CA859C9A9FD0") new file mode 100644 --- /dev/null +++ b/src/semgrep/engine/js-decorator-scan.ss @@ -0,0 +1,173 @@ +(export + scan-javascript-decorated-method-pattern) + +(import (except (jerboa prelude) meta atom?) + (std regex) + (semgrep engine regex-support) + (semgrep engine text-support)) + +(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] + [(string=? (substring s i (min len (+ i (string-length needle)))) + needle) + i] + [else (loop (+ i 1))])))) + +(def (javascript-decorated-method-pattern-spec pattern) + (let* ([trimmed (string-trim pattern)] + [match (re-search + (re "^@\\$([A-Za-z_][A-Za-z0-9_]*)(?:[ \\t]*\\([ \\t]*\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*\\))?[ \\t]+\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*\\([ \\t]*\\)[ \\t]*:[ \\t]*string(?:[ \\t]*\\{[ \\t]*\\.\\.\\.[ \\t]*\\})?[ \\t]*$") + trimmed + 0)]) + (and match + (list (cons 'decorator-var (re-match-group match 1)) + (cons 'field-var (re-match-group match 2)) + (cons 'name-var (re-match-group match 3)) + (cons 'body? (and (string-find-substring trimmed "{") #t)))))) + +(def (javascript-decorator-line-info source line-start line-end) + (let* ([first (line-first-nonspace source line-start line-end)] + [line (substring source first line-end)] + [match (re-search + (re "^@([A-Za-z_$][A-Za-z0-9_$]*)(?:[ \\t]*\\((.*)\\))?[ \\t]*$") + line + 0)]) + (and match + (let* ([decorator (re-match-group match 1)] + [field (re-match-group match 2)] + [decorator-start (+ first 1)] + [field-start + (and field + (string-find-substring-from + source + field + (+ decorator-start (string-length decorator))))]) + (list (cons 'start first) + (cons 'decorator decorator) + (cons 'decorator-start decorator-start) + (cons 'field field) + (cons 'field-start field-start)))))) + +(def (find-matching-close-brace source open) + (let ([len (string-length source)]) + (let loop ([i (+ open 1)] [depth 1]) + (cond + [(>= i len) #f] + [(char=? (string-ref source i) #\{) + (loop (+ i 1) (+ depth 1))] + [(char=? (string-ref source i) #\}) + (if (= depth 1) + (+ i 1) + (loop (+ i 1) (- depth 1)))] + [else (loop (+ i 1) depth)])))) + +(def (javascript-decorated-method-signature-info source line-start) + (let* ([line-end (line-end-after source line-start)] + [first (line-first-nonspace source line-start line-end)] + [line (substring source first line-end)] + [match (re-search + (re "^([A-Za-z_$][A-Za-z0-9_$]*)[ \\t]*\\([ \\t]*\\)[ \\t]*:[ \\t]*string") + line + 0)]) + (and match + (let* ([name (re-match-group match 1)] + [name-start (string-find-substring-from source name first)] + [signature-end (+ first (re-match-end match))] + [body-open (string-find-substring-from source "{" signature-end)] + [body-close (and body-open + (find-matching-close-brace source body-open))]) + (list (cons 'name name) + (cons 'name-start name-start) + (cons 'signature-end signature-end) + (cons 'body-open body-open) + (cons 'body-close body-close)))))) + +(def (javascript-decorated-method-finding rule path source spec decorator info) + (let* ([field-var (alist-ref/default spec 'field-var #f)] + [decorator-var (alist-ref/default spec 'decorator-var "")] + [name-var (alist-ref/default spec 'name-var "")] + [field (alist-ref/default decorator 'field #f)] + [field-start (alist-ref/default decorator 'field-start #f)] + [decorator-name (alist-ref/default decorator 'decorator "")] + [decorator-start (alist-ref/default decorator 'decorator-start 0)] + [name (alist-ref/default info 'name "")] + [name-start (alist-ref/default info 'name-start #f)] + [start (alist-ref/default decorator 'start 0)] + [end (if (alist-ref/default spec 'body? #f) + (alist-ref/default info 'body-close #f) + (alist-ref/default info 'signature-end #f))]) + (and end + name-start + (if field-var field (not field)) + (let ([bindings + (append + (list + (cons decorator-var + (metavariable-binding-for-range + decorator-var + source + decorator-start + (+ decorator-start + (string-length decorator-name)))) + (cons name-var + (metavariable-binding-for-range + name-var + source + name-start + (+ name-start (string-length name))))) + (if (and field-var field field-start) + (list + (cons field-var + (metavariable-binding-for-range + field-var + source + field-start + (+ field-start (string-length field))))) + '()))]) + (finding-for-range-with-bindings + rule + path + source + start + end + bindings))))) + +(def (scan-javascript-decorated-method-pattern rule path source pattern) + (let ([spec (javascript-decorated-method-pattern-spec pattern)]) + (and spec + (let ([len (string-length source)]) + (let loop ([line-start 0] [acc '()]) + (if (> line-start len) + (nonempty-findings (reverse acc)) + (let* ([line-end (line-end-after source line-start)] + [decorator (javascript-decorator-line-info + source + line-start + line-end)] + [next-line (if (< line-end len) + (+ line-end 1) + (+ len 1))] + [info (and decorator + (< next-line len) + (javascript-decorated-method-signature-info + source + next-line))] + [finding + (and decorator + info + (javascript-decorated-method-finding + rule + path + source + spec + decorator + info))]) + (loop next-line + (if finding (cons finding acc) acc))))))))) --- a/src/semgrep/scan.ss +++ b/src/semgrep/scan.ss @@ -15,6 +15,7 @@ (semgrep result findings) (semgrep engine generic-scan) (semgrep engine js-vardef-scan) + (semgrep engine js-decorator-scan) (semgrep engine markup-scan) (semgrep engine regex-scan) (semgrep engine rule-plan) @@ -2919,145 +2920,6 @@ (scan-javascript-try-catch-pattern rule path source spec)] [else #f])))) -(def (javascript-decorated-method-pattern-spec pattern) - (let* ([trimmed (string-trim pattern)] - [match (re-search - (re "^@\\$([A-Za-z_][A-Za-z0-9_]*)(?:[ \\t]*\\([ \\t]*\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*\\))?[ \\t]+\\$([A-Za-z_][A-Za-z0-9_]*)[ \\t]*\\([ \\t]*\\)[ \\t]*:[ \\t]*string(?:[ \\t]*\\{[ \\t]*\\.\\.\\.[ \\t]*\\})?[ \\t]*$") - trimmed - 0)]) - (and match - (list (cons 'decorator-var (re-match-group match 1)) - (cons 'field-var (re-match-group match 2)) - (cons 'name-var (re-match-group match 3)) - (cons 'body? (and (string-find-substring trimmed "{") #t)))))) - -(def (javascript-decorator-line-info source line-start line-end) - (let* ([first (line-first-nonspace source line-start line-end)] - [line (substring source first line-end)] - [match (re-search - (re "^@([A-Za-z_$][A-Za-z0-9_$]*)(?:[ \\t]*\\((.*)\\))?[ \\t]*$") - line - 0)]) - (and match - (let* ([decorator (re-match-group match 1)] - [field (re-match-group match 2)] - [decorator-start (+ first 1)] - [field-start - (and field - (string-find-substring-from - source - field - (+ decorator-start (string-length decorator))))]) - (list (cons 'start first) - (cons 'decorator decorator) - (cons 'decorator-start decorator-start) - (cons 'field field) - (cons 'field-start field-start)))))) - -(def (javascript-decorated-method-signature-info source line-start) - (let* ([line-end (line-end-after source line-start)] - [first (line-first-nonspace source line-start line-end)] - [line (substring source first line-end)] - [match (re-search - (re "^([A-Za-z_$][A-Za-z0-9_$]*)[ \\t]*\\([ \\t]*\\)[ \\t]*:[ \\t]*string") - line - 0)]) - (and match - (let* ([name (re-match-group match 1)] - [name-start (string-find-substring-from source name first)] - [signature-end (+ first (re-match-end match))] - [body-open (string-find-substring-from source "{" signature-end)] - [body-close (and body-open - (find-matching-close-brace source body-open))]) - (list (cons 'name name) - (cons 'name-start name-start) - (cons 'signature-end signature-end) - (cons 'body-open body-open) - (cons 'body-close body-close)))))) - -(def (javascript-decorated-method-finding rule path source spec decorator info) - (let* ([field-var (alist-ref/default spec 'field-var #f)] - [decorator-var (alist-ref/default spec 'decorator-var "")] - [name-var (alist-ref/default spec 'name-var "")] - [field (alist-ref/default decorator 'field #f)] - [field-start (alist-ref/default decorator 'field-start #f)] - [decorator-name (alist-ref/default decorator 'decorator "")] - [decorator-start (alist-ref/default decorator 'decorator-start 0)] - [name (alist-ref/default info 'name "")] - [name-start (alist-ref/default info 'name-start #f)] - [start (alist-ref/default decorator 'start 0)] - [end (if (alist-ref/default spec 'body? #f) - (alist-ref/default info 'body-close #f) - (alist-ref/default info 'signature-end #f))]) - (and end - name-start - (if field-var field (not field)) - (let ([bindings - (append - (list - (cons decorator-var - (metavariable-binding-for-range - decorator-var - source - decorator-start - (+ decorator-start - (string-length decorator-name)))) - (cons name-var - (metavariable-binding-for-range - name-var - source - name-start - (+ name-start (string-length name))))) - (if (and field-var field field-start) - (list - (cons field-var - (metavariable-binding-for-range - field-var - source - field-start - (+ field-start (string-length field))))) - '()))]) - (finding-for-range-with-bindings - rule - path - source - start - end - bindings))))) - -(def (scan-javascript-decorated-method-pattern rule path source pattern) - (let ([spec (javascript-decorated-method-pattern-spec pattern)]) - (and spec - (let ([len (string-length source)]) - (let loop ([line-start 0] [acc '()]) - (if (> line-start len) - (nonempty-findings (reverse acc)) - (let* ([line-end (line-end-after source line-start)] - [decorator (javascript-decorator-line-info - source - line-start - line-end)] - [next-line (if (< line-end len) - (+ line-end 1) - (+ len 1))] - [info (and decorator - (< next-line len) - (javascript-decorated-method-signature-info - source - next-line))] - [finding - (and decorator - info - (javascript-decorated-method-finding - rule - path - source - spec - decorator - info))]) - (loop next-line - (if finding (cons finding acc) acc))))))))) - (def (javascript-export-function-pattern-spec pattern) (let* ([trimmed (string-trim pattern)] [match (re-search