Extract Semgrep JavaScript constructor scanner

ober

6966631ff998b39c1ce0881a815e8c42864a9d8d

diff --git a/SEMGREP_JERBOA_IMPLEMENTATION.md b/SEMGREP_JERBOA_IMPLEMENTATION.md
index 22ca06f..fe3a337 100644
--- a/SEMGREP_JERBOA_IMPLEMENTATION.md
+++ b/SEMGREP_JERBOA_IMPLEMENTATION.md
@@ -483,6 +483,8 @@ Completed in the repo:
     `src/semgrep/engine/js-decorator-scan.ss`
   - extracted TypeScript `req.params.id` and Mongo `$where` text scanning
     into `src/semgrep/engine/ts-query-scan.ss`
+  - extracted JavaScript decorated-class constructor typed-param scanning
+    into `src/semgrep/engine/js-constructor-scan.ss`
 
 Validation at this checkpoint:
 
diff --git a/lib/semgrep/engine/js-constructor-scan.sls b/lib/semgrep/engine/js-constructor-scan.sls
new file mode 100644
index 0000000..5a860db
--- /dev/null
+++ b/lib/semgrep/engine/js-constructor-scan.sls
@@ -0,0 +1,142 @@
+#!chezscheme
+;;; Generated by jerbuild — DO NOT EDIT
+;;; Source: src/semgrep/engine/js-constructor-scan.ss
+
+(library (semgrep engine js-constructor-scan)
+  (export scan-javascript-constructor-typed-param-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))
+  (def (string-find-substring s needle)
+       (let ([len (string-length s)]
+             [needle-len (string-length needle)])
+         (let loop ([i 0])
+           (cond
+             [(> i len) #f]
+             [(and (<= (+ i needle-len) len)
+                   (string=? (substring s i (+ i needle-len)) needle))
+              i]
+             [else (loop (+ i 1))]))))
+  (def (javascript-constructor-typed-param-pattern? pattern)
+       (and (string-find-substring pattern "$THING: Ty")
+            (string-find-substring pattern "(")
+            (string-find-substring pattern ")")))
+  (define javascript-typed-constructor-regex
+    "constructor[ \\t\\r\\n]*\\([ \\t\\r\\n]*([A-Za-z_$][A-Za-z0-9_$]*)[ \\t\\r\\n]*:[ \\t\\r\\n]*Ty[ \\t\\r\\n]*\\)")
+  (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 (decorated-class-ranges source)
+       (let ([len (string-length source)])
+         (let loop ([start 0] [acc '()])
+           (let ([decorator (or (string-find-substring-from
+                                  source
+                                  "@Injectable"
+                                  start)
+                                (string-find-substring-from
+                                  source
+                                  "@Component"
+                                  start))])
+             (if (not decorator)
+                 (reverse acc)
+                 (let* ([class-index (string-find-substring-from
+                                       source
+                                       "class "
+                                       decorator)]
+                        [open (and class-index
+                                   (string-find-substring-from
+                                     source
+                                     "{"
+                                     class-index))]
+                        [close (and open
+                                    (find-matching-close-brace
+                                      source
+                                      open))]
+                        [next (if close close (min len (+ decorator 1)))])
+                   (loop
+                     next
+                     (if (and class-index open close)
+                         (cons (cons open close) acc)
+                         acc))))))))
+  (def (scan-javascript-constructor-typed-param-pattern
+         rule
+         path
+         source
+         pattern)
+       (and (javascript-constructor-typed-param-pattern? pattern)
+            (let ([rx (re javascript-typed-constructor-regex)])
+              (apply
+                append
+                (map (lambda (range)
+                       (let* ([class-open (car range)]
+                              [class-close (cdr range)]
+                              [class-body (substring
+                                            source
+                                            class-open
+                                            class-close)]
+                              [ctor (re-search rx class-body 0)])
+                         (if (not ctor)
+                             '()
+                             (let* ([param (re-match-group ctor 1)]
+                                    [needle (string-append "this." param)]
+                                    [needle-len (string-length needle)])
+                               (let scan ([start (+ class-open 1)]
+                                          [acc '()])
+                                 (let ([found (string-find-substring-from
+                                                source
+                                                needle
+                                                start)])
+                                   (if (or (not found)
+                                           (>= found class-close))
+                                       (reverse acc)
+                                       (let* ([end (+ found needle-len)]
+                                              [binding (make-regex-capture-binding "THING" param
+                                                         source (+ found 5)
+                                                         end)]
+                                              [bindings (list
+                                                          (cons
+                                                            "THING"
+                                                            binding))]
+                                              [message (render-fix-template
+                                                         (rule-message
+                                                           rule)
+                                                         bindings)]
+                                              [extra (finding-extra-for-match
+                                                       rule
+                                                       bindings
+                                                       (substring
+                                                         source
+                                                         found
+                                                         end))])
+                                         (let-values ([(start-line start-col)
+                                                       (offset->line-col
+                                                         source
+                                                         found)]
+                                                      [(end-line end-col)
+                                                       (offset->line-col
+                                                         source
+                                                         end)])
+                                           (scan
+                                             end
+                                             (cons
+                                               (make-finding (rule-id rule) path
+                                                 start-line start-col
+                                                 end-line end-col found end
+                                                 message
+                                                 (rule-severity rule)
+                                                 extra)
+                                               acc)))))))))))
+                     (decorated-class-ranges source)))))))
diff --git a/lib/semgrep/scan.sls b/lib/semgrep/scan.sls
index a50e9c3..8ff9b1b 100644
--- a/lib/semgrep/scan.sls
+++ b/lib/semgrep/scan.sls
@@ -18,6 +18,7 @@
    (semgrep result) (semgrep result builders)
    (semgrep result extras) (semgrep result findings)
    (semgrep engine generic-scan)
+   (semgrep engine js-constructor-scan)
    (semgrep engine js-vardef-scan)
    (semgrep engine js-decorator-scan)
    (semgrep engine markup-scan) (semgrep engine regex-scan)
@@ -509,113 +510,6 @@
                                          object-end match block-start)
                                        acc)))
                                  (reverse acc))))))))))
-  (def (javascript-constructor-typed-param-pattern? pattern)
-       (and (string-find-substring pattern "$THING: Ty")
-            (string-find-substring pattern "(")
-            (string-find-substring pattern ")")))
-  (def javascript-typed-constructor-regex
-       "constructor[ \\t\\r\\n]*\\([ \\t\\r\\n]*([A-Za-z_$][A-Za-z0-9_$]*)[ \\t\\r\\n]*:[ \\t\\r\\n]*Ty[ \\t\\r\\n]*\\)")
-  (def (decorated-class-ranges source)
-       (let ([len (string-length source)])
-         (let loop ([start 0] [acc '()])
-           (let ([decorator (or (string-find-substring-from
-                                  source
-                                  "@Injectable"
-                                  start)
-                                (string-find-substring-from
-                                  source
-                                  "@Component"
-                                  start))])
-             (if (not decorator)
-                 (reverse acc)
-                 (let* ([class-index (string-find-substring-from
-                                       source
-                                       "class "
-                                       decorator)]
-                        [open (and class-index
-                                   (string-find-substring-from
-                                     source
-                                     "{"
-                                     class-index))]
-                        [close (and open
-                                    (find-matching-close-brace
-                                      source
-                                      open))]
-                        [next (if close close (min len (+ decorator 1)))])
-                   (loop
-                     next
-                     (if (and class-index open close)
-                         (cons (cons open close) acc)
-                         acc))))))))
-  (def (scan-javascript-constructor-typed-param-pattern
-         rule
-         path
-         source
-         pattern)
-       (and (javascript-constructor-typed-param-pattern? pattern)
-            (let ([rx (re javascript-typed-constructor-regex)])
-              (apply
-                append
-                (map (lambda (range)
-                       (let* ([class-open (car range)]
-                              [class-close (cdr range)]
-                              [class-body (substring
-                                            source
-                                            class-open
-                                            class-close)]
-                              [ctor (re-search rx class-body 0)])
-                         (if (not ctor)
-                             '()
-                             (let* ([param (re-match-group ctor 1)]
-                                    [needle (string-append "this." param)]
-                                    [needle-len (string-length needle)])
-                               (let scan ([start (+ class-open 1)]
-                                          [acc '()])
-                                 (let ([found (string-find-substring-from
-                                                source
-                                                needle
-                                                start)])
-                                   (if (or (not found)
-                                           (>= found class-close))
-                                       (reverse acc)
-                                       (let* ([end (+ found needle-len)]
-                                              [binding (make-regex-capture-binding "THING" param
-                                                         source (+ found 5)
-                                                         end)]
-                                              [bindings (list
-                                                          (cons
-                                                            "THING"
-                                                            binding))]
-                                              [message (render-fix-template
-                                                         (rule-message
-                                                           rule)
-                                                         bindings)]
-                                              [extra (finding-extra-for-match
-                                                       rule
-                                                       bindings
-                                                       (substring
-                                                         source
-                                                         found
-                                                         end))])
-                                         (let-values ([(start-line start-col)
-                                                       (offset->line-col
-                                                         source
-                                                         found)]
-                                                      [(end-line end-col)
-                                                       (offset->line-col
-                                                         source
-                                                         end)])
-                                           (scan
-                                             end
-                                             (cons
-                                               (make-finding (rule-id rule) path
-                                                 start-line start-col
-                                                 end-line end-col found end
-                                                 message
-                                                 (rule-severity rule)
-                                                 extra)
-                                               acc)))))))))))
-                     (decorated-class-ranges source))))))
   (def (javascript-new-function-sequence-pattern? pattern)
        (and (string-find-substring pattern "new Function(")
             (string-find-substring pattern "$FUNC();")))
diff --git a/src/.jerbuild-hashes b/src/.jerbuild-hashes
index f5d377a..1267407 100644
--- a/src/.jerbuild-hashes
+++ b/src/.jerbuild-hashes
@@ -17,7 +17,7 @@
  ("src/semgrep/lang.ss" . "6982E07679D20836")
  ("src/semgrep/parse/parse-target.ss" . "97AA8FFEB12736DA")
  ("src/semgrep/result/extras.ss" . "DF0B3AAE2BAEB5D")
- ("src/semgrep/scan.ss" . "94E771EEFE98041B")
+ ("src/semgrep/scan.ss" . "939EBAEF9257C1B4")
  ("src/semgrep/engine/js-decorator-scan.ss"
    .
    "193758AD2E444FD6")
@@ -26,6 +26,9 @@
  ("src/semgrep/rule.ss" . "E12C108153C181FA")
  ("src/semgrep/output/text.ss" . "BE476CB84B807FBA")
  ("src/semgrep/source/offsets.ss" . "834EFDB706823794")
+ ("src/semgrep/engine/js-constructor-scan.ss"
+   .
+   "6B226B8D0584A7A")
  ("src/semgrep/engine/regex-support.ss" . "9FCF118903259C97")
  ("src/semgrep/main.ss" . "A4EC9E7F2A09D25E")
  ("src/semgrep/result/builders.ss" . "93A64AF4435E6132")
diff --git a/src/semgrep/engine/js-constructor-scan.ss b/src/semgrep/engine/js-constructor-scan.ss
new file mode 100644
index 0000000..fbedc90
--- /dev/null
+++ b/src/semgrep/engine/js-constructor-scan.ss
@@ -0,0 +1,132 @@
+(export
+  scan-javascript-constructor-typed-param-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))
+
+(def (string-find-substring s needle)
+  (let ([len (string-length s)]
+        [needle-len (string-length needle)])
+    (let loop ([i 0])
+      (cond
+        [(> i len) #f]
+        [(and (<= (+ i needle-len) len)
+              (string=? (substring s i (+ i needle-len)) needle))
+         i]
+        [else (loop (+ i 1))]))))
+
+(def (javascript-constructor-typed-param-pattern? pattern)
+  (and (string-find-substring pattern "$THING: Ty")
+       (string-find-substring pattern "(")
+       (string-find-substring pattern ")")))
+
+(define javascript-typed-constructor-regex
+  "constructor[ \\t\\r\\n]*\\([ \\t\\r\\n]*([A-Za-z_$][A-Za-z0-9_$]*)[ \\t\\r\\n]*:[ \\t\\r\\n]*Ty[ \\t\\r\\n]*\\)")
+
+(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 (decorated-class-ranges source)
+  (let ([len (string-length source)])
+    (let loop ([start 0] [acc '()])
+      (let ([decorator (or (string-find-substring-from source "@Injectable" start)
+                           (string-find-substring-from source "@Component" start))])
+        (if (not decorator)
+            (reverse acc)
+            (let* ([class-index (string-find-substring-from
+                                  source
+                                  "class "
+                                  decorator)]
+                   [open (and class-index
+                              (string-find-substring-from
+                                source
+                                "{"
+                                class-index))]
+                   [close (and open (find-matching-close-brace source open))]
+                   [next (if close
+                             close
+                             (min len (+ decorator 1)))])
+              (loop next
+                    (if (and class-index open close)
+                        (cons (cons open close) acc)
+                        acc))))))))
+
+(def (scan-javascript-constructor-typed-param-pattern rule path source pattern)
+  (and (javascript-constructor-typed-param-pattern? pattern)
+       (let ([rx (re javascript-typed-constructor-regex)])
+         (apply append
+                (map (lambda (range)
+                       (let* ([class-open (car range)]
+                              [class-close (cdr range)]
+                              [class-body (substring source class-open class-close)]
+                              [ctor (re-search rx class-body 0)])
+                         (if (not ctor)
+                             '()
+                             (let* ([param (re-match-group ctor 1)]
+                                    [needle (string-append "this." param)]
+                                    [needle-len (string-length needle)])
+                               (let scan ([start (+ class-open 1)] [acc '()])
+                                 (let ([found (string-find-substring-from
+                                                source
+                                                needle
+                                                start)])
+                                   (if (or (not found)
+                                           (>= found class-close))
+                                       (reverse acc)
+                                       (let* ([end (+ found needle-len)]
+                                              [binding
+                                               (make-regex-capture-binding
+                                                 "THING"
+                                                 param
+                                                 source
+                                                 (+ found 5)
+                                                 end)]
+                                              [bindings
+                                               (list (cons "THING" binding))]
+                                              [message
+                                               (render-fix-template
+                                                 (rule-message rule)
+                                                 bindings)]
+                                              [extra
+                                               (finding-extra-for-match
+                                                 rule
+                                                 bindings
+                                                 (substring source found end))])
+                                         (let-values
+                                           ([(start-line start-col)
+                                             (offset->line-col source found)]
+                                            [(end-line end-col)
+                                             (offset->line-col source end)])
+                                           (scan
+                                             end
+                                             (cons
+                                               (make-finding
+                                                 (rule-id rule)
+                                                 path
+                                                 start-line
+                                                 start-col
+                                                 end-line
+                                                 end-col
+                                                 found
+                                                 end
+                                                 message
+                                                 (rule-severity rule)
+                                                 extra)
+                                               acc)))))))))))
+                     (decorated-class-ranges source))))))
diff --git a/src/semgrep/scan.ss b/src/semgrep/scan.ss
index 27a27bb..e17c956 100644
--- a/src/semgrep/scan.ss
+++ b/src/semgrep/scan.ss
@@ -14,6 +14,7 @@
         (semgrep result extras)
         (semgrep result findings)
         (semgrep engine generic-scan)
+        (semgrep engine js-constructor-scan)
         (semgrep engine js-vardef-scan)
         (semgrep engine js-decorator-scan)
         (semgrep engine markup-scan)
@@ -561,103 +562,6 @@
                                   acc)))
                             (reverse acc))))))))))
 
-(def (javascript-constructor-typed-param-pattern? pattern)
-  (and (string-find-substring pattern "$THING: Ty")
-       (string-find-substring pattern "(")
-       (string-find-substring pattern ")")))
-
-(def javascript-typed-constructor-regex
-  "constructor[ \\t\\r\\n]*\\([ \\t\\r\\n]*([A-Za-z_$][A-Za-z0-9_$]*)[ \\t\\r\\n]*:[ \\t\\r\\n]*Ty[ \\t\\r\\n]*\\)")
-
-(def (decorated-class-ranges source)
-  (let ([len (string-length source)])
-    (let loop ([start 0] [acc '()])
-      (let ([decorator (or (string-find-substring-from source "@Injectable" start)
-                           (string-find-substring-from source "@Component" start))])
-        (if (not decorator)
-            (reverse acc)
-            (let* ([class-index (string-find-substring-from
-                                  source
-                                  "class "
-                                  decorator)]
-                   [open (and class-index
-                              (string-find-substring-from
-                                source
-                                "{"
-                                class-index))]
-                   [close (and open (find-matching-close-brace source open))]
-                   [next (if close
-                             close
-                             (min len (+ decorator 1)))])
-              (loop next
-                    (if (and class-index open close)
-                        (cons (cons open close) acc)
-                        acc))))))))
-
-(def (scan-javascript-constructor-typed-param-pattern rule path source pattern)
-  (and (javascript-constructor-typed-param-pattern? pattern)
-       (let ([rx (re javascript-typed-constructor-regex)])
-         (apply append
-                (map (lambda (range)
-                       (let* ([class-open (car range)]
-                              [class-close (cdr range)]
-                              [class-body (substring source class-open class-close)]
-                              [ctor (re-search rx class-body 0)])
-                         (if (not ctor)
-                             '()
-                             (let* ([param (re-match-group ctor 1)]
-                                    [needle (string-append "this." param)]
-                                    [needle-len (string-length needle)])
-                               (let scan ([start (+ class-open 1)] [acc '()])
-                                 (let ([found (string-find-substring-from
-                                                source
-                                                needle
-                                                start)])
-                                   (if (or (not found)
-                                           (>= found class-close))
-                                       (reverse acc)
-                                       (let* ([end (+ found needle-len)]
-                                              [binding
-                                               (make-regex-capture-binding
-                                                 "THING"
-                                                 param
-                                                 source
-                                                 (+ found 5)
-                                                 end)]
-                                              [bindings
-                                               (list (cons "THING" binding))]
-                                              [message
-                                               (render-fix-template
-                                                 (rule-message rule)
-                                                 bindings)]
-                                              [extra
-                                               (finding-extra-for-match
-                                                 rule
-                                                 bindings
-                                                 (substring source found end))])
-                                         (let-values
-                                           ([(start-line start-col)
-                                             (offset->line-col source found)]
-                                            [(end-line end-col)
-                                             (offset->line-col source end)])
-                                           (scan
-                                             end
-                                             (cons
-                                               (make-finding
-                                                 (rule-id rule)
-                                                 path
-                                                 start-line
-                                                 start-col
-                                                 end-line
-                                                 end-col
-                                                 found
-                                                 end
-                                                 message
-                                                 (rule-severity rule)
-                                                 extra)
-                                               acc)))))))))))
-                     (decorated-class-ranges source))))))
-
 (def (javascript-new-function-sequence-pattern? pattern)
   (and (string-find-substring pattern "new Function(")
        (string-find-substring pattern "$FUNC();")))