Close go/zip-traversal via structural matcher (taint 8/9)

ober

27de8bba15d6be379befa30da3c61267549fd1fa

diff --git a/lib/semgrep/match/structural.sls b/lib/semgrep/match/structural.sls
index c1954be..d13d92c 100644
--- a/lib/semgrep/match/structural.sls
+++ b/lib/semgrep/match/structural.sls
@@ -977,23 +977,64 @@
                    (loop (cdr remaining) inner-acc)
                    (inner (cdr ys) (cons (car ys) inner-acc)))))))
   (def (go-deep-pattern-arg pattern)
-       (and (string=? (node-type pattern) "call_expression")
-            (>= (node-matchable-child-count pattern) 2)
-            (let ([fn (node-matchable-child pattern 0)])
-              (and fn
-                   (let ([is-deep (and (string=?
-                                         (node-type fn)
-                                         "identifier")
-                                       (string=?
-                                         (node-text fn)
-                                         deep-token-name))])
-                     (node-close! fn)
-                     (and is-deep
-                          (let ([args (node-matchable-child pattern 1)])
-                            (and args
-                                 (let ([arg (single-named-child args)])
-                                   (node-close! args)
-                                   arg)))))))))
+       (cond
+         [(string=? (node-type pattern) "expression_statement")
+          (let ([child (single-named-child pattern)])
+            (and child
+                 (let ([arg (go-deep-pattern-arg child)])
+                   (node-close! child)
+                   arg)))]
+         [else
+          (and (string=? (node-type pattern) "call_expression")
+               (>= (node-matchable-child-count pattern) 2)
+               (let ([fn (node-matchable-child pattern 0)])
+                 (and fn
+                      (let ([is-deep (and (string=?
+                                            (node-type fn)
+                                            "identifier")
+                                          (string=?
+                                            (node-text fn)
+                                            deep-token-name))])
+                        (node-close! fn)
+                        (and is-deep
+                             (let ([args (node-matchable-child pattern 1)])
+                               (and args
+                                    (let ([arg (single-named-child args)])
+                                      (node-close! args)
+                                      arg))))))))]))
+  (def (go-descendant-texts-of-type node type)
+       (let recur ([n node] [acc '()])
+         (let ([acc2 (if (string=? (node-type n) type)
+                         (cons (node-text n) acc)
+                         acc)])
+           (let child-loop ([i 0] [a acc2])
+             (if (>= i (node-matchable-child-count n))
+                 a
+                 (let ([c (node-matchable-child n i)])
+                   (if c
+                       (let ([a2 (recur c a)])
+                         (node-close! c)
+                         (child-loop (+ i 1) a2))
+                       (child-loop (+ i 1) a))))))))
+  (def (go-import-declaration-matches
+         language
+         pattern
+         target
+         bindings)
+       (and (go-language? language)
+            (string=? (node-type pattern) "import_declaration")
+            (string=? (node-type target) "import_declaration")
+            (let ([pspecs (go-descendant-texts-of-type
+                            pattern
+                            "import_spec")]
+                  [tspecs (go-descendant-texts-of-type
+                            target
+                            "import_spec")])
+              (and (not (null? pspecs))
+                   (let all ([xs pspecs])
+                     (or (null? xs)
+                         (and (member (car xs) tspecs) (all (cdr xs)))))
+                   (list bindings)))))
   (def (go-deep-match-here-or-descendant
          language
          pat
@@ -1058,6 +1099,12 @@
               target
               bindings) =>
             (lambda (matches) matches)]
+           [(go-import-declaration-matches
+              language
+              pattern
+              target
+              bindings) =>
+            (lambda (matches) matches)]
            [(quoted-ellipsis-metavariable-name-from-text text) =>
             (lambda (name)
               (let ([next (if (string=? language "json")
@@ -1121,11 +1168,109 @@
             (if (string=? (node-text pattern) (node-text target))
                 (list bindings)
                 '())]
+           [(go-subsequence-matchable? language pattern target)
+            (go-statement-subsequence-matches
+              language
+              pattern
+              target
+              bindings)]
            [else
             (let ([pcount (node-matchable-child-count pattern)]
                   [tcount (node-matchable-child-count target)])
               (match-child-sequence-matches language pattern target pcount
                 tcount bindings))])))
+  (def (go-subseq-match-from language pattern target pcount
+         tcount pi ti bindings)
+       (cond
+         [(= pi pcount) (list bindings)]
+         [else
+          (let ([pfield (node-field-name-for-matchable-child
+                          pattern
+                          pi)]
+                [pchild (node-matchable-child pattern pi)])
+            (cond
+              [(and pchild
+                    (not pfield)
+                    (ellipsis-metavariable-name-from-text
+                      (node-text pchild))) =>
+               (lambda (name)
+                 (let ([result (let try ([next-ti ti] [acc '()])
+                                 (let ([nb (bind-ellipsis-metavariable name target ti next-ti
+                                             bindings)])
+                                   (let ([matched (if nb
+                                                      (go-subseq-match-from language pattern
+                                                        target pcount
+                                                        tcount (+ pi 1)
+                                                        next-ti nb)
+                                                      '())])
+                                     (if (< next-ti tcount)
+                                         (try (+ next-ti 1)
+                                              (append
+                                                (reverse matched)
+                                                acc))
+                                         (reverse
+                                           (append
+                                             (reverse matched)
+                                             acc))))))])
+                   (node-close! pchild)
+                   result))]
+              [(and pchild (not pfield) (ellipsis-node? pchild))
+               (let ([result (let try ([next-ti ti] [acc '()])
+                               (let ([matched (go-subseq-match-from language pattern target
+                                                pcount tcount (+ pi 1)
+                                                next-ti bindings)])
+                                 (if (< next-ti tcount)
+                                     (try (+ next-ti 1)
+                                          (append (reverse matched) acc))
+                                     (reverse
+                                       (append (reverse matched) acc)))))])
+                 (node-close! pchild)
+                 result)]
+              [(>= ti tcount) (when pchild (node-close! pchild)) '()]
+              [else
+               (let ([tfield (node-field-name-for-matchable-child
+                               target
+                               ti)]
+                     [tchild (node-matchable-child target ti)])
+                 (let ([nb (if (and (same-field-name? pfield tfield)
+                                    pchild
+                                    tchild)
+                               (structural-node-matches
+                                 language
+                                 pchild
+                                 tchild
+                                 bindings)
+                               '())])
+                   (when pchild (node-close! pchild))
+                   (when tchild (node-close! tchild))
+                   (sg-append-map
+                     (lambda (next)
+                       (go-subseq-match-from language pattern target pcount
+                         tcount (+ pi 1) (+ ti 1) next))
+                     nb)))]))]))
+  (def (go-subsequence-matchable? language pattern target)
+       (and (go-language? language)
+            (string=? (node-type pattern) (node-type target))
+            (let ([t (node-type pattern)])
+              (or (string=? t "statement_list")
+                  (string=? t "block")
+                  (string=? t "source_file")))
+            (> (node-matchable-child-count pattern) 1)))
+  (def (go-statement-subsequence-matches
+         language
+         pattern
+         target
+         bindings)
+       (let ([pcount (node-matchable-child-count pattern)]
+             [tcount (node-matchable-child-count target)])
+         (let start-loop ([si 0] [acc '()])
+           (if (> si tcount)
+               (reverse acc)
+               (let ([here (go-subseq-match-from language pattern target
+                             pcount tcount 0 si bindings)])
+                 (start-loop
+                   (+ si 1)
+                   (if (null? here) acc (append (reverse here) acc))))))))
   (def (match-child-sequence language pattern target pcount
          tcount bindings)
        (let ([matches (match-child-sequence-matches language pattern target pcount tcount bindings)])
diff --git a/src/.jerbuild-hashes b/src/.jerbuild-hashes
index 4f26a00..e26c09f 100644
--- a/src/.jerbuild-hashes
+++ b/src/.jerbuild-hashes
@@ -4,10 +4,10 @@
   ("src/semgrep/lang.ss" . "6982E07679D20836")
   ("src/semgrep/parse/parse-target.ss" . "B1616180DE7038ED")
   ("src/semgrep/scan.ss" . "A09A5F4FE16A2036")
+  ("src/semgrep/rule.ss" . "E12C108153C181FA")
+  ("src/semgrep/schema/lang.ss" . "CAE2CA859C9A9FD0")
   ("src/semgrep/output/text.ss" . "BE476CB84B807FBA")
   ("src/semgrep/fix.ss" . "2E5B65B1FEF3B2B1")
-  ("src/semgrep/schema/lang.ss" . "CAE2CA859C9A9FD0")
-  ("src/semgrep/rule.ss" . "E12C108153C181FA")
-  ("src/semgrep/match/structural.ss" . "F93B68FF81D41586")
+  ("src/semgrep/match/structural.ss" . "633743099E28CC58")
   ("src/semgrep/main.ss" . "A4EC9E7F2A09D25E")
   ("src/semgrep/cli.ss" . "EBDC4B1DAD3F13CC"))
diff --git a/src/semgrep/match/structural.ss b/src/semgrep/match/structural.ss
index 0decc04..cb20419 100644
--- a/src/semgrep/match/structural.ss
+++ b/src/semgrep/match/structural.ss
@@ -1012,7 +1012,15 @@
 ;; If `pattern` is such a call, return the inner pattern node X (caller closes),
 ;; else #f.
 (def (go-deep-pattern-arg pattern)
-  (and (string=? (node-type pattern) "call_expression")
+  (cond
+    [(string=? (node-type pattern) "expression_statement")
+     (let ([child (single-named-child pattern)])
+       (and child
+            (let ([arg (go-deep-pattern-arg child)])
+              (node-close! child)
+              arg)))]
+    [else
+     (and (string=? (node-type pattern) "call_expression")
        (>= (node-matchable-child-count pattern) 2)
        (let ([fn (node-matchable-child pattern 0)])
          (and fn
@@ -1024,7 +1032,38 @@
                        (and args
                             (let ([arg (single-named-child args)])
                               (node-close! args)
-                              arg)))))))))
+                              arg))))))))]))
+
+;; Collect the texts of all descendant nodes of the given type.
+(def (go-descendant-texts-of-type node type)
+  (let recur ([n node] [acc '()])
+    (let ([acc2 (if (string=? (node-type n) type)
+                    (cons (node-text n) acc)
+                    acc)])
+      (let child-loop ([i 0] [a acc2])
+        (if (>= i (node-matchable-child-count n))
+            a
+            (let ([c (node-matchable-child n i)])
+              (if c
+                  (let ([a2 (recur c a)])
+                    (node-close! c)
+                    (child-loop (+ i 1) a2))
+                  (child-loop (+ i 1) a))))))))
+
+;; Go imports: `import "x"` (single) and `import ( "x" ... )` (grouped) have
+;; different trees (import_spec vs import_spec_list), but Semgrep treats an
+;; import pattern as matching whenever every named spec is present.
+(def (go-import-declaration-matches language pattern target bindings)
+  (and (go-language? language)
+       (string=? (node-type pattern) "import_declaration")
+       (string=? (node-type target) "import_declaration")
+       (let ([pspecs (go-descendant-texts-of-type pattern "import_spec")]
+             [tspecs (go-descendant-texts-of-type target "import_spec")])
+         (and (not (null? pspecs))
+              (let all ([xs pspecs])
+                (or (null? xs)
+                    (and (member (car xs) tspecs) (all (cdr xs)))))
+              (list bindings)))))
 
 ;; X matches `target` or any of its descendants (deep search).
 (def (go-deep-match-here-or-descendant language pat target bindings)
@@ -1063,6 +1102,8 @@
       [(ellipsis-node? pattern) (list bindings)]
       [(go-deep-expression-matches language pattern target bindings)
        => (lambda (matches) matches)]
+      [(go-import-declaration-matches language pattern target bindings)
+       => (lambda (matches) matches)]
       [(quoted-ellipsis-metavariable-name-from-text text)
        => (lambda (name)
             (let ([next (if (string=? language "json")
@@ -1116,6 +1157,8 @@
        (if (string=? (node-text pattern) (node-text target))
            (list bindings)
            '())]
+      [(go-subsequence-matchable? language pattern target)
+       (go-statement-subsequence-matches language pattern target bindings)]
       [else
        (let ([pcount (node-matchable-child-count pattern)]
              [tcount (node-matchable-child-count target)])
@@ -1126,6 +1169,82 @@
                                        tcount
                                        bindings))])))
 
+;; Go subsequence matching for multi-statement / file patterns. Semgrep matches
+;; a multi-statement pattern against a CONTIGUOUS-with-ellipsis subsequence of a
+;; block (leading and trailing statements in the block are allowed). The base
+;; matcher is anchored (pattern must align at child 0 and consume all), so for
+;; Go statement_list / block / source_file patterns we iterate the start offset
+;; (leading slack) and accept any remaining target tail (trailing slack).
+(def (go-subseq-match-from language pattern target pcount tcount pi ti bindings)
+  (cond
+    [(= pi pcount) (list bindings)]                ; trailing slack: tail is free
+    [else
+     (let ([pfield (node-field-name-for-matchable-child pattern pi)]
+           [pchild (node-matchable-child pattern pi)])
+       (cond
+         [(and pchild (not pfield)
+               (ellipsis-metavariable-name-from-text (node-text pchild)))
+          => (lambda (name)
+               (let ([result
+                      (let try ([next-ti ti] [acc '()])
+                        (let ([nb (bind-ellipsis-metavariable
+                                    name target ti next-ti bindings)])
+                          (let ([matched (if nb
+                                             (go-subseq-match-from
+                                               language pattern target pcount
+                                               tcount (+ pi 1) next-ti nb)
+                                             '())])
+                            (if (< next-ti tcount)
+                                (try (+ next-ti 1) (append (reverse matched) acc))
+                                (reverse (append (reverse matched) acc))))))])
+                 (node-close! pchild)
+                 result))]
+         [(and pchild (not pfield) (ellipsis-node? pchild))
+          (let ([result
+                 (let try ([next-ti ti] [acc '()])
+                   (let ([matched (go-subseq-match-from
+                                    language pattern target pcount tcount
+                                    (+ pi 1) next-ti bindings)])
+                     (if (< next-ti tcount)
+                         (try (+ next-ti 1) (append (reverse matched) acc))
+                         (reverse (append (reverse matched) acc)))))])
+            (node-close! pchild)
+            result)]
+         [(>= ti tcount) (when pchild (node-close! pchild)) '()]
+         [else
+          (let ([tfield (node-field-name-for-matchable-child target ti)]
+                [tchild (node-matchable-child target ti)])
+            (let ([nb (if (and (same-field-name? pfield tfield) pchild tchild)
+                          (structural-node-matches language pchild tchild bindings)
+                          '())])
+              (when pchild (node-close! pchild))
+              (when tchild (node-close! tchild))
+              (sg-append-map
+                (lambda (next)
+                  (go-subseq-match-from language pattern target pcount tcount
+                                        (+ pi 1) (+ ti 1) next))
+                nb)))]))]))
+
+(def (go-subsequence-matchable? language pattern target)
+  (and (go-language? language)
+       (string=? (node-type pattern) (node-type target))
+       (let ([t (node-type pattern)])
+         (or (string=? t "statement_list")
+             (string=? t "block")
+             (string=? t "source_file")))
+       (> (node-matchable-child-count pattern) 1)))
+
+(def (go-statement-subsequence-matches language pattern target bindings)
+  (let ([pcount (node-matchable-child-count pattern)]
+        [tcount (node-matchable-child-count target)])
+    (let start-loop ([si 0] [acc '()])
+      (if (> si tcount)
+          (reverse acc)
+          (let ([here (go-subseq-match-from
+                        language pattern target pcount tcount 0 si bindings)])
+            (start-loop (+ si 1)
+                        (if (null? here) acc (append (reverse here) acc))))))))
+
 (def (match-child-sequence language pattern target pcount tcount bindings)
   (let ([matches
          (match-child-sequence-matches language