Extract Semgrep comparison engine helpers
ober
3eb80c32880b69f461198cb5089d464be56ffa44
--- a/SEMGREP_JERBOA_IMPLEMENTATION.md +++ b/SEMGREP_JERBOA_IMPLEMENTATION.md @@ -496,6 +496,9 @@ Completed in the repo: `src/semgrep/engine/py-string-scan.ss` - extracted reusable Python string/f-string literal evaluation helpers into `src/semgrep/engine/py-string-eval.ss` + - extracted shared comparison evaluation, constant-binding resolution, and + metavariable-comparison predicate handling into + `src/semgrep/engine/comparison.ss` Validation at this checkpoint: new file mode 100644 --- /dev/null +++ b/lib/semgrep/engine/comparison.sls @@ -0,0 +1,902 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/semgrep/engine/comparison.ss + +(library (semgrep engine comparison) + (export comparison-missing? comparison-value->string + constant-bindings-before comparison-value + metavariable-comparison-satisfied?) + (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 lang) (semgrep result) (semgrep result findings) + (semgrep engine regex-support) (semgrep util literals) + (semgrep match structural)) + (define missing-comparison-value + (list 'missing-comparison-value)) + (def (alist-ref/default xs key default) + (let ([found (assoc key xs)]) + (if found (cdr found) default))) + (def (comparison-missing? value) + (eq? value missing-comparison-value)) + (def (any? pred xs) + (and (not (null? xs)) + (or (pred (car xs)) (any? pred (cdr xs))))) + (def (comparison-word-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_) + (char=? ch #\$))) + (def (comparison-identifier-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_))) + (def (identifier-char? ch) + (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\_) + (char=? ch #\$))) + (def (sg-string-suffix? suffix s) + (let ([suffix-len (string-length suffix)] + [len (string-length s)]) + (and (<= suffix-len len) + (string=? (substring s (- len suffix-len) len) suffix)))) + (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 (string-map-chars proc source) + (let ([len (string-length source)]) + (let loop ([i 0] [acc '()]) + (if (= i len) + (list->string (reverse acc)) + (loop (+ i 1) (cons (proc (string-ref source i)) acc)))))) + (def (source-contains-char? source ch) + (let ([len (string-length source)]) + (let loop ([i 0]) + (cond + [(= i len) #f] + [(char=? (string-ref source i) ch) #t] + [else (loop (+ i 1))])))) + (def (numeric-literal-float-like? source) + (or (source-contains-char? source #\.) + (source-contains-char? source #\e) + (source-contains-char? source #\E) + (source-contains-char? source #\f) + (source-contains-char? source #\F) + (source-contains-char? source #\d) + (source-contains-char? source #\D))) + (def (substring-trim source start end) + (string-trim (substring source start end))) + (def (keyword-at? source index keyword) + (let* ([len (string-length source)] + [keyword-len (string-length keyword)] + [end (+ index keyword-len)]) + (and (<= end len) + (string=? (substring source index end) keyword) + (or (= index 0) + (not (comparison-word-char? + (string-ref source (- index 1))))) + (or (= end len) + (not (comparison-word-char? (string-ref source end))))))) + (def (find-top-level-keyword source keyword) + (let ([len (string-length source)]) + (let loop ([i 0] [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)] + [(or (char=? ch #\() (char=? ch #\[)) + (loop (+ i 1) (+ depth 1) state #f)] + [(or (char=? ch #\)) (char=? ch #\])) + (loop (+ i 1) (max 0 (- depth 1)) state #f)] + [(and (= depth 0) (keyword-at? source i keyword)) i] + [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 (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 (find-top-level-not-in source) + (let ([not-index (find-top-level-keyword source "not")]) + (and not-index + (let ([in-index (skip-whitespace source (+ not-index 3))]) + (and (keyword-at? source in-index "in") + (cons not-index (+ in-index 2))))))) + (def (operator-at? source index op) + (let ([end (+ index (string-length op))]) + (and (<= end (string-length source)) + (string=? (substring source index end) op)))) + (def (find-top-level-operator source ops) + (let ([len (string-length source)]) + (let loop ([i 0] [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)] + [(or (char=? ch #\() (char=? ch #\[)) + (loop (+ i 1) (+ depth 1) state #f)] + [(or (char=? ch #\)) (char=? ch #\])) + (loop (+ i 1) (max 0 (- depth 1)) state #f)] + [(= depth 0) + (let find-op ([remaining ops]) + (cond + [(null? remaining) (loop (+ i 1) depth state #f)] + [(operator-at? source i (car remaining)) + (cons (car remaining) i)] + [else (find-op (cdr remaining))]))] + [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 (split-top-level-commas source) + (let ([len (string-length source)]) + (let loop ([i 0] + [start 0] + [depth 0] + [state 'normal] + [escaped? #f] + [acc '()]) + (cond + [(>= i len) + (reverse (cons (substring-trim source start len) acc))] + [(eq? state 'normal) + (let ([ch (string-ref source i)]) + (cond + [(char=? ch #\") + (loop (+ i 1) start depth 'double #f acc)] + [(char=? ch #\') + (loop (+ i 1) start depth 'single #f acc)] + [(char=? ch #\`) + (loop (+ i 1) start depth 'backtick #f acc)] + [(or (char=? ch #\() (char=? ch #\[)) + (loop (+ i 1) start (+ depth 1) state #f acc)] + [(or (char=? ch #\)) (char=? ch #\])) + (loop (+ i 1) start (max 0 (- depth 1)) state #f acc)] + [(and (= depth 0) (char=? ch #\,)) + (loop (+ i 1) (+ i 1) depth state #f + (cons (substring-trim source start i) acc))] + [else (loop (+ i 1) start depth state #f acc)]))] + [escaped? (loop (+ i 1) start depth state #f acc)] + [(char=? (string-ref source i) #\\) + (loop (+ i 1) start depth state #t acc)] + [(and (eq? state 'double) + (char=? (string-ref source i) #\")) + (loop (+ i 1) start depth 'normal #f acc)] + [(and (eq? state 'single) + (char=? (string-ref source i) #\')) + (loop (+ i 1) start depth 'normal #f acc)] + [(and (eq? state 'backtick) + (char=? (string-ref source i) #\`)) + (loop (+ i 1) start depth 'normal #f acc)] + [else (loop (+ i 1) start depth state #f acc)])))) + (def (pair-from-index-to-end? source start open close) + (let ([len (string-length source)]) + (and (< start len) + (char=? (string-ref source start) open) + (let loop ([i start] + [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 open) + (loop (+ i 1) (+ depth 1) state #f)] + [(char=? ch close) + (let ([next-depth (- depth 1)]) + (and (>= next-depth 0) + (if (= next-depth 0) + (= (+ i 1) len) + (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 (outer-pair? source open close) + (and (>= (string-length source) 2) + (pair-from-index-to-end? source 0 open close))) + (def (comparison-function-call expr) + (let ([len (string-length expr)]) + (let loop ([i 0]) + (cond + [(or (= i len) + (not (comparison-identifier-char? (string-ref expr i)))) + (and (> i 0) + (< i len) + (pair-from-index-to-end? expr i #\( #\)) + (cons + (substring expr 0 i) + (substring expr (+ i 1) (- len 1))))] + [else (loop (+ i 1))])))) + (def (comparison-metavariable-reference-name expr) + (let ([len (string-length expr)]) + (and (>= len 1) + (or (char=? (string-ref expr 0) #\$) + (char-alphabetic? (string-ref expr 0)) + (char=? (string-ref expr 0) #\_)) + (let ([start (if (char=? (string-ref expr 0) #\$) 1 0)]) + (and (< start len) + (let loop ([i start]) + (cond + [(= i len) (substring expr start len)] + [(comparison-identifier-char? (string-ref expr i)) + (loop (+ i 1))] + [else #f]))))))) + (def (comparison-value->string value) + (cond + [(comparison-missing? value) ""] + [(string? value) value] + [(number? value) (number->string value)] + [(boolean? value) (if value "true" "false")] + [else ""])) + (def (regex-fold-matches pattern source proc seed) + (let ([rx (re pattern)] [len (string-length source)]) + (let loop ([start 0] [acc seed]) + (if (> start len) + acc + (let ([match (re-search rx source start)]) + (if match + (let ([next (max (+ (re-match-start match) 1) + (re-match-end match))]) + (loop next (proc match acc))) + acc)))))) + (def (comparison-binding-value binding strip? base) + (let* ([text (metavariable-binding-text binding)] + [number (parse-number-literal text base)]) + (cond + [(and strip? number) number] + [number number] + [else (strip-delimiter-pair (string-trim text))]))) + (def python-simple-assignment-regex + "(^|\\n)[ \\t]*([A-Za-z_][A-Za-z0-9_]*)[ \\t]*=[ \\t]*([^\\n#]+)") + (def go-simple-assignment-regex + "(^|\\n)[ \\t]*([A-Za-z_][A-Za-z0-9_]*)[ \\t]*(?::=|=)[ \\t]*([^\\n#=][^\\n#]*)") + (def java-simple-assignment-regex + "(^|\\n)[ \\t]*(?:[A-Za-z_][A-Za-z0-9_<>\\[\\].]*[ \\t]+)*([A-Za-z_][A-Za-z0-9_]*)[ \\t]*=[ \\t]*([^\\n;=][^\\n;]*)") + (def (go-language? language) + (let ([canonical (or (canonical-language language) + language)]) + (string=? canonical "go"))) + (def (java-language? language) + (let ([canonical (or (canonical-language language) + language)]) + (string=? canonical "java"))) + (def (constant-binding-from-value name value source offset) + (make-regex-capture-binding name + (comparison-value->string value) source offset offset)) + (def (constant-bindings-before + source + before-offset + language) + (regex-fold-matches + (cond + [(and language (go-language? language)) + go-simple-assignment-regex] + [(and language (java-language? language)) + java-simple-assignment-regex] + [else python-simple-assignment-regex]) + (substring source 0 before-offset) + (lambda (match acc) + (let* ([name (re-match-group match 2)] + [expr (string-trim (re-match-group match 3))] + [value (comparison-value expr acc #f #f)]) + (if (or (comparison-missing? value) + (string=? (comparison-value->string value) "")) + acc + (let* ([relative (or (string-find-substring-from + (re-match-full match) + name + 0) + 0)] + [binding (constant-binding-from-value + name + value + source + (+ (re-match-start match) relative))] + [without-old (let loop ([xs acc]) + (cond + [(null? xs) '()] + [(string=? (caar xs) name) + (loop (cdr xs))] + [else + (cons + (car xs) + (loop (cdr xs)))]))]) + (cons (cons name binding) without-old))))) + '())) + (def (binding-resolved-for-comparison + binding + constants + source) + (let* ([text (string-trim + (metavariable-binding-text binding))] + [value (comparison-value text constants #f #f)]) + (if (or (comparison-missing? value) (equal? value text)) + binding + (make-metavariable-binding (metavariable-binding-name binding) + (comparison-value->string value) + (metavariable-binding-start-byte binding) + (metavariable-binding-end-byte binding) + (metavariable-binding-start-line binding) + (metavariable-binding-start-col binding) + (metavariable-binding-end-line binding) + (metavariable-binding-end-col binding))))) + (def (comparison-bindings-with-constants + candidate + source + language) + (let* ([constants (constant-bindings-before + source + (finding-start-offset candidate) + language)] + [metavars (finding-metavars candidate)] + [resolved (map (lambda (entry) + (cons + (car entry) + (binding-resolved-for-comparison + (cdr entry) + constants + source))) + metavars)]) + (append resolved constants))) + (def (comparison-lookup-binding name bindings) + (lookup-metavariable-binding name bindings)) + (def (comparison-list-contains-missing? values) + (any? comparison-missing? values)) + (def (previous-nonspace-index source index) + (let loop ([i (- index 1)]) + (cond + [(< i 0) #f] + [(char-whitespace? (string-ref source i)) (loop (- i 1))] + [else i]))) + (def (prefix-operator-char? ch) + (or (char=? ch #\() + (char=? ch #\[) + (char=? ch #\,) + (char=? ch #\+) + (char=? ch #\-) + (char=? ch #\*) + (char=? ch #\/) + (char=? ch #\%) + (char=? ch #\&) + (char=? ch #\|) + (char=? ch #\^) + (char=? ch #\~) + (char=? ch #\<) + (char=? ch #\>) + (char=? ch #\=) + (char=? ch #\!))) + (def (binary-operator-usable? source index op) + (cond + [(or (string=? op "+") (string=? op "-")) + (let ([previous (previous-nonspace-index source index)]) + (and previous + (not (prefix-operator-char? + (string-ref source previous)))))] + [(string=? op "*") + (not (or (and (> index 0) + (char=? (string-ref source (- index 1)) #\*)) + (and (< (+ index 1) (string-length source)) + (char=? (string-ref source (+ index 1)) #\*))))] + [else #t])) + (def (find-top-level-binary-operator source ops) + (let ([len (string-length source)]) + (let loop ([i 0] + [depth 0] + [state 'normal] + [escaped? #f] + [last #f]) + (cond + [(>= i len) last] + [(eq? state 'normal) + (let ([ch (string-ref source i)]) + (cond + [(char=? ch #\") (loop (+ i 1) depth 'double #f last)] + [(char=? ch #\') (loop (+ i 1) depth 'single #f last)] + [(char=? ch #\`) (loop (+ i 1) depth 'backtick #f last)] + [(or (char=? ch #\() (char=? ch #\[)) + (loop (+ i 1) (+ depth 1) state #f last)] + [(or (char=? ch #\)) (char=? ch #\])) + (loop (+ i 1) (max 0 (- depth 1)) state #f last)] + [(= depth 0) + (let find-op ([remaining ops]) + (cond + [(null? remaining) + (loop (+ i 1) depth state #f last)] + [(and (operator-at? source i (car remaining)) + (binary-operator-usable? + source + i + (car remaining))) + (loop (+ i (string-length (car remaining))) depth + state #f (cons (car remaining) i))] + [else (find-op (cdr remaining))]))] + [else (loop (+ i 1) depth state #f last)]))] + [escaped? (loop (+ i 1) depth state #f last)] + [(char=? (string-ref source i) #\\) + (loop (+ i 1) depth state #t last)] + [(and (eq? state 'double) + (char=? (string-ref source i) #\")) + (loop (+ i 1) depth 'normal #f last)] + [(and (eq? state 'single) + (char=? (string-ref source i) #\')) + (loop (+ i 1) depth 'normal #f last)] + [(and (eq? state 'backtick) + (char=? (string-ref source i) #\`)) + (loop (+ i 1) depth 'normal #f last)] + [else (loop (+ i 1) depth state #f last)])))) + (def (comparison-number-from-value value base) + (cond + [(comparison-missing? value) #f] + [(number? value) value] + [(string? value) (parse-number-literal value base)] + [else #f])) + (def (comparison-integer? value) + (and (integer? value) value)) + (def (string-all-digits? text) + (let ([len (string-length text)]) + (and (> len 0) + (let loop ([i 0]) + (or (= i len) + (and (char-numeric? (string-ref text i)) + (loop (+ i 1)))))))) + (def (four-digit-date-part source start) + (and (<= (+ start 4) (string-length source)) + (let ([text (substring source start (+ start 4))]) + (and (string-all-digits? text) (string->number text))))) + (def (two-digit-date-part source start) + (and (<= (+ start 2) (string-length source)) + (let ([text (substring source start (+ start 2))]) + (and (string-all-digits? text) (string->number text))))) + (def (comparison-date-number year month day) + (+ (* year 10000) (* month 100) day)) + (def (parse-iso-date-number value) + (and (string? value) + (>= (string-length value) 10) + (char=? (string-ref value 4) #\-) + (char=? (string-ref value 7) #\-) + (let ([year (four-digit-date-part value 0)] + [month (two-digit-date-part value 5)] + [day (two-digit-date-part value 8)]) + (and year + month + day + (<= 1 month 12) + (<= 1 day 31) + (comparison-date-number year month day))))) + (def (today-date-number) + (let ([date (current-date)]) + (comparison-date-number + (date-year date) + (date-month date) + (date-day date)))) + (def (comparison-apply-binary-op op left right) + (let ([left-number (comparison-number-from-value left #f)] + [right-number (comparison-number-from-value right #f)]) + (cond + [(not (and left-number right-number)) + missing-comparison-value] + [(string=? op "+") (+ left-number right-number)] + [(string=? op "-") (- left-number right-number)] + [(string=? op "*") (* left-number right-number)] + [(string=? op "/") + (if (= right-number 0) + missing-comparison-value + (/ left-number right-number))] + [(string=? op "%") + (if (and (comparison-integer? left-number) + (comparison-integer? right-number) + (not (= right-number 0))) + (modulo left-number right-number) + missing-comparison-value)] + [(string=? op "**") (expt left-number right-number)] + [(string=? op "&") + (if (and (comparison-integer? left-number) + (comparison-integer? right-number)) + (bitwise-and left-number right-number) + missing-comparison-value)] + [(string=? op "|") + (if (and (comparison-integer? left-number) + (comparison-integer? right-number)) + (bitwise-ior left-number right-number) + missing-comparison-value)] + [(string=? op "^") + (if (and (comparison-integer? left-number) + (comparison-integer? right-number)) + (bitwise-xor left-number right-number) + missing-comparison-value)] + [else missing-comparison-value]))) + (def (comparison-binary-value source bindings strip? base + ops) + (let ([match (find-top-level-binary-operator source ops)]) + (and match + (let* ([op (car match)] + [index (cdr match)] + [left (comparison-value + (substring-trim source 0 index) + bindings + strip? + base)] + [right (comparison-value + (substring-trim + source + (+ index (string-length op)) + (string-length source)) + bindings + strip? + base)]) + (comparison-apply-binary-op op left right))))) + (def (comparison-unary-bitnot-value + source + bindings + strip? + base) + (let ([trimmed (string-trim source)]) + (and (>= (string-length trimmed) 1) + (char=? (string-ref trimmed 0) #\~) + (let* ([value (comparison-value + (substring-trim + trimmed + 1 + (string-length trimmed)) + bindings + strip? + base)] + [number (comparison-number-from-value value #f)]) + (if (comparison-integer? number) + (bitwise-not number) + missing-comparison-value))))) + (def (comparison-value expr bindings strip? base) + (let ([trimmed (string-trim expr)]) + (cond + [(string=? trimmed "") ""] + [(outer-pair? trimmed #\( #\)) + (comparison-value + (substring trimmed 1 (- (string-length trimmed) 1)) + bindings + strip? + base)] + [(outer-pair? trimmed #\[ #\]) + (let ([items (map (lambda (item) + (comparison-value + item + bindings + strip? + base)) + (split-top-level-commas + (substring + trimmed + 1 + (- (string-length trimmed) 1))))]) + (if (comparison-list-contains-missing? items) + missing-comparison-value + items))] + [(comparison-binary-value trimmed bindings strip? base + '("|")) => + values] + [(comparison-binary-value trimmed bindings strip? base + '("^")) => + values] + [(comparison-binary-value trimmed bindings strip? base + '("&")) => + values] + [(comparison-binary-value trimmed bindings strip? base + '("+" "-")) => + values] + [(comparison-binary-value trimmed bindings strip? base + '("*" "/" "%")) => + values] + [(comparison-binary-value trimmed bindings strip? base + '("**")) => + values] + [(comparison-unary-bitnot-value + trimmed + bindings + strip? + base) => + values] + [(comparison-function-call trimmed) => + (lambda (call) + (let* ([name (car call)] + [args (split-top-level-commas (cdr call))] + [values (map (lambda (arg) + (comparison-value + arg + bindings + strip? + base)) + args)]) + (if (comparison-list-contains-missing? values) + missing-comparison-value + (let ([first (if (null? values) "" (car values))]) + (cond + [(string=? name "str") + (comparison-value->string first)] + [(string=? name "int") + (let* ([base-value (if (and (not (null? + (cdr values))) + (number? + (cadr values))) + (cadr values) + base)] + [parsed (parse-number-literal + (comparison-value->string first) + base-value)]) + (or parsed missing-comparison-value))] + [(string=? name "float") + (let ([parsed (parse-number-literal + (comparison-value->string first) + #f)]) + (or parsed missing-comparison-value))] + [(string=? name "lower") + (string-map-chars + char-downcase + (comparison-value->string first))] + [(string=? name "upper") + (string-map-chars + char-upcase + (comparison-value->string first))] + [(string=? name "len") + (if (list? first) + (length first) + (string-length + (comparison-value->string first)))] + [(string=? name "strptime") + (or (parse-iso-date-number + (comparison-value->string first)) + missing-comparison-value)] + [(string=? name "today") + (if (or (null? args) + (and (null? (cdr args)) + (string=? + (string-trim (car args)) + ""))) + (today-date-number) + missing-comparison-value)] + [else missing-comparison-value])))))] + [(comparison-metavariable-reference-name trimmed) => + (lambda (name) + (let ([binding (comparison-lookup-binding name bindings)]) + (if binding + (comparison-binding-value binding strip? base) + missing-comparison-value)))] + [(or (string=? trimmed "true") (string=? trimmed "True")) + #t] + [(or (string=? trimmed "false") (string=? trimmed "False")) + #f] + [(quoted-string? trimmed) (unquote-string trimmed)] + [(parse-number-literal trimmed base) => values] + [else trimmed]))) + (def (compare-values op left right) + (cond + [(or (comparison-missing? left) (comparison-missing? right)) + #f] + [(and (number? left) (number? right) (string=? op "==")) + (= left right)] + [(and (number? left) (number? right) (string=? op "!=")) + (not (= left right))] + [(string=? op "==") (equal? left right)] + [(string=? op "!=") (not (equal? left right))] + [(and (number? left) (number? right)) + (cond + [(string=? op "<") (< left right)] + [(string=? op "<=") (<= left right)] + [(string=? op ">") (> left right)] + [(string=? op ">=") (>= left right)] + [else #f])] + [(and (string? left) (string? right)) + (cond + [(string=? op "<") (string<? left right)] + [(string=? op "<=") + (or (string<? left right) (string=? left right))] + [(string=? op ">") (string>? left right)] + [(string=? op ">=") + (or (string>? left right) (string=? left right))] + [else #f])] + [else #f])) + (def (comparison-in? needle haystack) + (cond + [(or (comparison-missing? needle) + (comparison-missing? haystack)) + #f] + [(list? haystack) + (any? (lambda (item) (equal? needle item)) haystack)] + [(and (string? needle) (string? haystack)) + (if (string-find-substring haystack needle) #t #f)] + [else #f])) + (def (metavariable-comparison-predicate-satisfied? + source + bindings + strip? + base) + (cond + [(find-top-level-not-in source) => + (lambda (span) + (not (comparison-in? + (comparison-value + (substring-trim source 0 (car span)) + bindings + strip? + base) + (comparison-value + (substring-trim + source + (cdr span) + (string-length source)) + bindings + strip? + base))))] + [(find-top-level-keyword source "in") => + (lambda (index) + (comparison-in? + (comparison-value + (substring-trim source 0 index) + bindings + strip? + base) + (comparison-value + (substring-trim source (+ index 2) (string-length source)) + bindings + strip? + base)))] + [(find-top-level-operator + source + '("<=" ">=" "==" "!=" "<" ">")) => + (lambda (match) + (let* ([op (car match)] [index (cdr match)]) + (compare-values + op + (comparison-value + (substring-trim source 0 index) + bindings + strip? + base) + (comparison-value + (substring-trim + source + (+ index (string-length op)) + (string-length source)) + bindings + strip? + base))))] + [else + (let ([value (comparison-value + source + bindings + strip? + base)]) + (and (not (comparison-missing? value)) + (if (boolean? value) value #t)))])) + (def (metavariable-comparison-expression-satisfied? + source + bindings + strip? + base) + (let ([trimmed (string-trim source)]) + (cond + [(find-top-level-keyword trimmed "or") => + (lambda (index) + (or (metavariable-comparison-expression-satisfied? + (substring-trim trimmed 0 index) + bindings + strip? + base) + (metavariable-comparison-expression-satisfied? + (substring-trim + trimmed + (+ index 2) + (string-length trimmed)) + bindings + strip? + base)))] + [(find-top-level-keyword trimmed "and") => + (lambda (index) + (and (metavariable-comparison-expression-satisfied? + (substring-trim trimmed 0 index) + bindings + strip? + base) + (metavariable-comparison-expression-satisfied? + (substring-trim + trimmed + (+ index 3) + (string-length trimmed)) + bindings + strip? + base)))] + [(and (keyword-at? trimmed 0 "not") + (not (find-top-level-not-in trimmed))) + (not (metavariable-comparison-expression-satisfied? + (substring-trim trimmed 3 (string-length trimmed)) + bindings + strip? + base))] + [else + (metavariable-comparison-predicate-satisfied? + trimmed + bindings + strip? + base)]))) + (def (finding-has-resolved-decomposition? finding) + (assoc + 'resolved-decomposition-vars + (finding-extra finding))) + (def (metavariable-comparison-satisfied? + candidate + clause + source + language) + (let* ([metavariable (alist-ref/default + clause + 'metavariable + #f)] + [comparison (alist-ref/default clause 'comparison #f)] + [strip? (alist-ref/default clause 'strip #f)] + [base (alist-ref/default clause 'base #f)] + [bindings (comparison-bindings-with-constants + candidate + source + language)]) + (and comparison + (not (finding-has-resolved-decomposition? candidate)) + (or (not metavariable) + (finding-metavariable-binding candidate metavariable)) + (metavariable-comparison-expression-satisfied? + comparison + bindings + strip? + base))))) --- a/lib/semgrep/scan.sls +++ b/lib/semgrep/scan.sls @@ -17,7 +17,7 @@ (tree-sitter tree-sitter) (semgrep lang) (semgrep rule) (semgrep result) (semgrep result builders) (semgrep result extras) (semgrep result findings) - (semgrep engine generic-scan) + (semgrep engine comparison) (semgrep engine generic-scan) (semgrep engine js-constructor-scan) (semgrep engine js-eval-scan) (semgrep engine js-vardef-scan) @@ -24716,10 +24716,6 @@ [(> i len) #f] [(substring-at? s needle i) i] [else (loop (+ i 1))])))) - (define missing-comparison-value - (list 'missing-comparison-value)) - (def (comparison-missing? value) - (eq? value missing-comparison-value)) (def (comparison-word-char? ch) (or (char-alphabetic? ch) (char-numeric? ch) @@ -24902,44 +24898,6 @@ (def (outer-pair? source open close) (and (>= (string-length source) 2) (pair-from-index-to-end? source 0 open close))) - (def (comparison-identifier-char? ch) - (or (char-alphabetic? ch) - (char-numeric? ch) - (char=? ch #\_))) - (def (comparison-function-call expr) - (let ([len (string-length expr)]) - (let loop ([i 0]) - (cond - [(or (= i len) - (not (comparison-identifier-char? (string-ref expr i)))) - (and (> i 0) - (< i len) - (pair-from-index-to-end? expr i #\( #\)) - (cons - (substring expr 0 i) - (substring expr (+ i 1) (- len 1))))] - [else (loop (+ i 1))])))) - (def (comparison-metavariable-reference-name expr) - (let ([len (string-length expr)]) - (and (>= len 1) - (or (char=? (string-ref expr 0) #\$) - (char-alphabetic? (string-ref expr 0)) - (char=? (string-ref expr 0) #\_)) - (let ([start (if (char=? (string-ref expr 0) #\$) 1 0)]) - (and (< start len) - (let loop ([i start]) - (cond - [(= i len) (substring expr start len)] - [(comparison-identifier-char? (string-ref expr i)) - (loop (+ i 1))] - [else #f]))))))) - (def (comparison-value->string value) - (cond - [(comparison-missing? value) ""] - [(string? value) value] - [(number? value) (number->string value)] - [(boolean? value) (if value "true" "false")] - [else ""])) (def (string-map-chars proc source) (let ([len (string-length source)]) (let loop ([i 0] [acc '()]) @@ -25573,101 +25531,8 @@ [(string=? analyzer "redos") (redos-nested-quantifier? text)] [else #f])))) - (def (comparison-binding-value binding strip? base) - (let* ([text (metavariable-binding-text binding)] - [number (parse-number-literal text base)]) - (cond - [(and strip? number) number] - [number number] - [else (strip-delimiter-pair (string-trim text))]))) (def python-simple-assignment-regex "(^|\\n)[ \\t]*([A-Za-z_][A-Za-z0-9_]*)[ \\t]*=[ \\t]*([^\\n#]+)") - (def go-simple-assignment-regex - "(^|\\n)[ \\t]*([A-Za-z_][A-Za-z0-9_]*)[ \\t]*(?::=|=)[ \\t]*([^\\n#=][^\\n#]*)") - (def java-simple-assignment-regex - "(^|\\n)[ \\t]*(?:[A-Za-z_][A-Za-z0-9_<>\\[\\].]*[ \\t]+)*([A-Za-z_][A-Za-z0-9_]*)[ \\t]*=[ \\t]*([^\\n;=][^\\n;]*)") - (def (constant-binding-from-value name value source offset)