Harden scan boundaries and dependency bootstrap
ober
82143e07a9c9ea0fc2973502ba928890a4a7a21e
--- a/.build.yml +++ b/.build.yml @@ -4,22 +4,23 @@ packages: - ca-certificates - curl - git + - openssh-client - ripgrep environment: - JERBOA_VERSION: v0.2.3 + JERBOA_TREESITTER_HOME: .deps/jerboa-treesitter sources: - https://git.sr.ht/~lisp/jerboa-semgrep - - https://git.sr.ht/~lisp/jerboa-treesitter tasks: - install-jerbuild: | - curl -fsSL "https://github.com/jerboa-lang/jerboa/releases/download/${JERBOA_VERSION}/jerbuild-linux-x86_64" -o "$HOME/jerbuild" - chmod +x "$HOME/jerbuild" + cd jerboa-semgrep + support/install-verified-jerbuild.sh "$HOME/jerbuild" - build-treesitter: | - cd jerboa-treesitter - JERBUILD="$HOME/jerbuild" make build + cd jerboa-semgrep + support/fetch-locked-deps.sh dependency-lock.tsv .deps/jerboa-treesitter + JERBUILD="$HOME/jerbuild" make -C .deps/jerboa-treesitter build - verify: | cd jerboa-semgrep - JERBUILD="$HOME/jerbuild" make verify + JERBUILD="$HOME/jerbuild" JERBOA_TREESITTER_HOME=.deps/jerboa-treesitter make verify - release-evidence: | cd jerboa-semgrep - JERBUILD="$HOME/jerbuild" make release-evidence + JERBUILD="$HOME/jerbuild" JERBOA_TREESITTER_HOME=.deps/jerboa-treesitter make release-evidence --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,27 +13,24 @@ jobs: verify: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4 + with: + persist-credentials: false - name: Install build tools - run: sudo apt-get update && sudo apt-get install -y build-essential curl ca-certificates git ripgrep + run: sudo apt-get update && sudo apt-get install -y build-essential curl ca-certificates git openssh-client ripgrep - name: Install jerbuild - run: | - set -eux - curl -fsSL "https://github.com/jerboa-lang/jerboa/releases/download/${JERBOA_VERSION}/jerbuild-linux-x86_64" -o /usr/local/bin/jerbuild - chmod +x /usr/local/bin/jerbuild - env: - JERBOA_VERSION: v0.2.3 + run: support/install-verified-jerbuild.sh /tmp/jerbuild - name: Build jerboa-treesitter run: | - set -eux - git clone https://git.sr.ht/~lisp/jerboa-treesitter ../jerboa-treesitter - JERBUILD=/usr/local/bin/jerbuild make -C ../jerboa-treesitter build + set -eu + support/fetch-locked-deps.sh dependency-lock.tsv .deps/jerboa-treesitter + JERBUILD=/tmp/jerbuild make -C .deps/jerboa-treesitter build - name: Verify - run: JERBUILD=/usr/local/bin/jerbuild make verify + run: JERBUILD=/tmp/jerbuild JERBOA_TREESITTER_HOME=.deps/jerboa-treesitter make verify - name: Release evidence - run: JERBUILD=/usr/local/bin/jerbuild make release-evidence + run: JERBUILD=/tmp/jerbuild JERBOA_TREESITTER_HOME=.deps/jerboa-treesitter make release-evidence --- a/.gitignore +++ b/.gitignore @@ -17,6 +17,8 @@ dist/ # Local tools and editor caches .claude/ +.deps/ +.deps-lock-test/ *~ \#* .#* --- a/Makefile +++ b/Makefile @@ -13,7 +13,8 @@ $(error jerbuild not found on PATH (or '$(JERBUILD) --jerboa-home' failed). Inst endif JERBOA_TREESITTER_HOME ?= ../jerboa-treesitter -LIBDIRS := lib:$(JERBOA_TREESITTER_HOME)/lib:$(JH)/lib +JERBOA_TREESITTER_ABS := $(abspath $(JERBOA_TREESITTER_HOME)) +LIBDIRS := lib:$(JERBOA_TREESITTER_ABS)/lib:$(JH)/lib JEXEC := $(JERBUILD) exec --libdirs "$(LIBDIRS)" EVIDENCE_DIR ?= dist/release-evidence SBOM_DIR ?= dist/sbom @@ -31,7 +32,7 @@ endif PATTERN_CASE_REGEX ?= ^(ac_matching_dots|ac_matching_dots1|ac_matching_explosion|ac_matching_explosion1|ac_matching_explosion2|ac_matching_explosion3|ac_matching_free|ac_matching_free1|ac_matching_if|ac_matching_if1|ac_matching_mvars|ac_matching_mvars1|ac_matching_mvars2|aliasing_attribute|assoc_matching_bug|assoc_matching_dots|assoc_matching_dots1|assoc_matching_explosion|assoc_matching_explosion1|assoc_matching_explosion2|assoc_matching_explosion3|assoc_matching_free|assoc_matching_free1|assoc_matching_mvars|assoc_matching_mvars1|constprop_dataflow|constprop_used_twice|cp_concat|cp_exception|cp_label|cp_label1|cp_method_call|cp_python_mult_string|cp_python_mult_string1|cp_rlval|cp_string_mvar|cp_strings|cp_with|cp_yield|deep_cond|deep_expr_operator|deep_expr_vs_statement|deep_exprstmt|deep_fake_dataflow|deep_try|dict_ellipsis|dots_attribute|dots_expr_plus|dots_expr_plus_string|dots_fstring|dots_fstring_with_match_stmt|dots_inherit|dots_list|dots_nested_stmts|dots_stmts|equivalence_constant_propagation|equivalence_f_string|equivalence_f_string_2|equivalence_f_string_3|equivalence_f_string_4|equivalence_interpolated_str|equivalence_interpolated_str2|equivalence_keyword_args|equivalence_naming_import|import_metavar|import_negatives|import_negatives2|imports|index_tuple|less_attributes|less_catch|less_catch_multiple|less_inherits|less_typehint|less_typehint2|matching_if_expr|metavar_anno|metavar_anno_fqn|metavar_class_def|metavar_dict|metavar_equality_param_vs_use|metavar_equality_var|metavar_func_def|metavar_stmt|metavar_typed|misc_attributes|misc_block_import|misc_class_regression|misc_dots_stmts|misc_except_matching|misc_faketok2|misc_if1|misc_metavar_vs_fstring|misc_naming_bug2|misc_paren|misc_range_statements|misc_regression1|misc_regression2|misc_stmts1|misc_tuple2|misc_with_parens|multi_import|multi_qualified_wildcard|pip614-extended-decorator-grammer1|regexp_string_backref|set_vs_dict|set_vs_dict2|standalone_decorator|standalone_decorator_single_arg|static_method|stmts_to_fields|tuple_subscript_ellipsis|tuple_subscript_ellipsis_with_match_stmt|unordered_metavar2|untyped_vs_typed|wildcard_qualified)$$ JS_PATTERN_CASE_REGEX ?= ^(ac_matching_bitor|aliasing_require|caching_deep|caching_deep_metavar|caching_different_depth|caching_flat|caching_nested|cp_conditional|cp_dataflow|cp_implicit_conversion|cp_incrdecr|cp_label|cp_throw|cp_undeclared|cp_undeclared1|deep_cond|deep_deep_stmt1|deep_deep_stmt2|deep_expr_and_ellipsis|deep_expr_vs_statement|deep_expr_xml|deep_stmt|deep_stmt2|deep_vardef|dots_field_chaining|dots_importfrom|dots_jsx_attr|dots_jsx_body|dots_jsx_body2|dots_template_literals|ellipsis_metavar_tagged_template|ellipsis_metavar_template|equivalence_aliasing_import|equivalence_import_require|equivalence_import_variations|equivalence_import_variations2|equivalence_import_variations3|equivalence_import_variations4|equivalence_keyword_args|equivalence_varlet|infer_const|infer_const_1|infer_const_regexp|equivalence_constant_propagation2|equivalence_constant_propagation3|less_class_complex|less_class_complex_2|less_inheritance|less_xml_attr|less_xml_body|metavar_class_fields|metavar_equality_vardef_vs_use|metavar_import|metavar_import2|metavar_import3|metavar_importfrom|metavar_importfrom2|metavar_jsx_val|metavar_stmt_or_expr|metavar_template|metavar_typed_bool|metavar_typed_literal|metavar_xml_attr|misc_arrow|misc_arrow2|misc_asi_pattern|misc_catch_unbound|misc_decorators_method|misc_deep_expr_stmt|misc_empty_body|misc_export|misc_method_chain_vs_stmt|misc_object_directly|misc_tagged_template_literal|object_duplicate_key|object_numeric_key|partial_catch|partial_decorators_arg_method|partial_decorators_method|partial_function|partial_lambda_or_func|partial_single_field|regexp_fieldname|switch_case_pattern|template_string_w_metavar|typed_metavar_assign|unordered_destructuring|unordered_fields|unordered_fields2|unordered_metavar|unordered_xml_attr)$$ -.PHONY: all build generate test malformed-corpus import-check security audit verify dependency-evidence sbom reproducibility-report target-evidence release-evidence oracle oracle-upstream patterns-oracle patterns-js-oracle clean clean-generated help +.PHONY: all build generate test adversarial-fs malformed-corpus import-check security dependency-lock-check audit verify dependency-evidence sbom reproducibility-report target-evidence release-evidence oracle oracle-upstream patterns-oracle patterns-js-oracle clean clean-generated help .DEFAULT_GOAL := help all: build @@ -45,29 +46,49 @@ generate: > src/semgrep/schema/lang.ss test: build - @JERBOA_TREE_SITTER_LIB=$(JERBOA_TREESITTER_HOME) \ + @JERBOA_TREE_SITTER_LIB=$(JERBOA_TREESITTER_ABS) \ $(LD_VAR)=$(JERBOA_TREESITTER_HOME):$${$(LD_VAR)} \ $(JEXEC) tests/smoke.ss +adversarial-fs: build scripts/adversarial-fs.sh + @JERBUILD="$(JERBUILD)" LIBDIRS="$(LIBDIRS)" \ + JERBOA_TREE_SITTER_LIB="$(JERBOA_TREESITTER_ABS)" \ + $(LD_VAR)="$(JERBOA_TREESITTER_ABS):$${$(LD_VAR)}" \ + REPO_ROOT="$(CURDIR)" scripts/adversarial-fs.sh + malformed-corpus: build support/malformed-corpus-evidence.ss - @JERBOA_TREE_SITTER_LIB=$(JERBOA_TREESITTER_HOME) \ + @JERBOA_TREE_SITTER_LIB=$(JERBOA_TREESITTER_ABS) \ $(LD_VAR)=$(JERBOA_TREESITTER_HOME):$${$(LD_VAR)} \ $(JEXEC) support/malformed-corpus-evidence.ss import-check: build - @JERBOA_TREE_SITTER_LIB=$(JERBOA_TREESITTER_HOME) \ + @JERBOA_TREE_SITTER_LIB=$(JERBOA_TREESITTER_ABS) \ $(LD_VAR)=$(JERBOA_TREESITTER_HOME):$${$(LD_VAR)} \ $(JEXEC) support/import-check.ss security: clean-generated scripts/security-check.sh scripts/security-check.sh -audit: security +dependency-lock-check: + @test -d "$(JERBOA_TREESITTER_HOME)/.git" || { echo "jerboa-treesitter is not a Git checkout" >&2; exit 1; } + @expected_commit=$$(awk -F '\t' '$$1 == "jerboa-treesitter" { print $$3 }' dependency-lock.tsv); \ + expected_tree=$$(awk -F '\t' '$$1 == "jerboa-treesitter" { print $$4 }' dependency-lock.tsv); \ + test "$$(git -C "$(JERBOA_TREESITTER_HOME)" rev-parse HEAD)" = "$$expected_commit" || { echo "jerboa-treesitter commit is not locked" >&2; exit 1; }; \ + test "$$(git -C "$(JERBOA_TREESITTER_HOME)" rev-parse 'HEAD^{tree}')" = "$$expected_tree" || { echo "jerboa-treesitter tree is not locked" >&2; exit 1; }; \ + test -z "$$(git -C "$(JERBOA_TREESITTER_HOME)" status --porcelain --untracked-files=normal)" || { echo "jerboa-treesitter checkout is dirty or has untracked inputs" >&2; exit 1; } + +audit: security dependency-lock-check @test -d "$(JERBOA_TREESITTER_HOME)" || { echo "missing jerboa-treesitter checkout: $(JERBOA_TREESITTER_HOME)" >&2; exit 1; } @test -f "$(JERBOA_TREESITTER_HOME)/lib/tree-sitter/tree-sitter.sls" || { echo "missing jerboa-treesitter transpiled library; build the sibling dependency first" >&2; exit 1; } @test -f "$(JERBOA_TREESITTER_HOME)/libjerboa_tree_sitter.$(SHLIB_EXT)" || { echo "missing jerboa-treesitter native shim: libjerboa_tree_sitter.$(SHLIB_EXT)" >&2; exit 1; } @echo "==> jerbuild" @$(JERBUILD) --version + @test -f "$(JH)/lib/libjerboa_native.a" || { echo "bundled native archive is missing" >&2; exit 1; } + @test -f "$(JH)/lib/libjerboa_native.$(SHLIB_EXT)" || { echo "bundled native regex/filesystem library is missing" >&2; exit 1; } + @test -f "$(JH)/jerboa-native-rs/Cargo.lock" || { echo "bundled native Cargo.lock is missing" >&2; exit 1; } + @shasum -a 256 "$(JH)/lib/libjerboa_native.a" | awk '{ print $$1 " lib/libjerboa_native.a" }' + @shasum -a 256 "$(JH)/lib/libjerboa_native.$(SHLIB_EXT)" | awk '{ print $$1 " lib/libjerboa_native.$(SHLIB_EXT)" }' + @shasum -a 256 "$(JH)/jerboa-native-rs/Cargo.lock" | awk '{ print $$1 " jerboa-native-rs/Cargo.lock" }' @echo "==> jerboa-treesitter native linkage" @if command -v otool >/dev/null 2>&1; then \ otool -L "$(JERBOA_TREESITTER_HOME)/libjerboa_tree_sitter.$(SHLIB_EXT)"; \ @@ -80,7 +101,7 @@ audit: security target-evidence: scripts/target-evidence.sh @REPO_ROOT=. TARGET_EVIDENCE_DIR="$(TARGET_EVIDENCE_DIR)" sh scripts/target-evidence.sh -verify: audit import-check malformed-corpus test target-evidence +verify: audit import-check malformed-corpus test adversarial-fs target-evidence dependency-evidence: $(MAKE) -C "$(JERBOA_TREESITTER_HOME)" JERBUILD="$(JERBUILD)" release-evidence @@ -136,11 +157,11 @@ patterns-js-oracle: build tests/oracle/patterns-sweep.sh clean: - find . \( -name '*.so' -o -name '*.dylib' -o -name '*.wpo' -o -name '*.wp.so' -o -name '*.o' -o -name '*.a' \) -delete 2>/dev/null || true + find . ! -path './.deps/*' ! -path './.deps-lock-test/*' \( -name '*.so' -o -name '*.dylib' -o -name '*.wpo' -o -name '*.wp.so' -o -name '*.o' -o -name '*.a' \) -delete 2>/dev/null || true rm -rf dist tests/oracle/out tests/oracle/tmp clean-generated: - find . \( -name '*.so' -o -name '*.dylib' -o -name '*.wpo' -o -name '*.wp.so' -o -name '*.o' -o -name '*.a' \) -delete 2>/dev/null || true + find . ! -path './.deps/*' ! -path './.deps-lock-test/*' \( -name '*.so' -o -name '*.dylib' -o -name '*.wpo' -o -name '*.wp.so' -o -name '*.o' -o -name '*.a' \) -delete 2>/dev/null || true rm -rf tests/oracle/out tests/oracle/tmp help: @@ -149,9 +170,11 @@ help: @echo "Targets:" @echo " make build Transpile src/*.ss into tracked lib/*.sls" @echo " make test Run smoke and regression tests" + @echo " make adversarial-fs Exercise no-link scan/config/autofix paths" @echo " make malformed-corpus Run hostile rule/source corpus evidence" @echo " make import-check Verify public modules load" @echo " make security Static release/security checks" + @echo " make dependency-lock-check Verify the exact parser dependency checkout" @echo " make audit Security plus jerboa-treesitter dependency audit" @echo " make verify Audit, import check, and tests" @echo " make target-evidence Record target-only production blockers" --- a/README.md +++ b/README.md @@ -33,6 +33,9 @@ supports a compatibility-oriented Semgrep subset: - Target parsing via `jerboa-treesitter` for JSON, Python, JavaScript, JSX, and TypeScript/TSX parsed through the JavaScript grammar as a fallback. - Recursive directory targets with conservative default source-file filtering. +- Descriptor-relative target/config walks that skip symlinks, reject hard + links, pin directory identities, enforce cumulative traversal budgets, and + commit autofixes only if the originally read inode is still in place. - A first `.semgrepignore` pass with `!` negation for scanned directory roots, plus line-level `nosemgrep` suppression, including rule-specific comments. - CLI compatibility for `semgrep scan --json|--sarif|--text --config RULES TARGET`, @@ -53,6 +56,11 @@ make test `JERBOA_TREESITTER_HOME` defaults to `../jerboa-treesitter`. That sibling checkout must be built first because parser FFI is isolated there. +CI instead fetches the exact commit and tree in `dependency-lock.tsv`. +The network Jerbuild bootstrap is deliberately fail-closed until a producer +signing identity, signed manifest, and asset digest are provisioned in +`support/jerbuild-bootstrap.lock` and `support/jerboa-release-signers`; CI +never executes a merely versioned, same-origin download. Run the release/security gates: @@ -83,6 +91,16 @@ Input size caps are enforced before rule configs and targets are fully read: - `JSEMGREP_MAX_CONFIG_CHARS`, default `4194304` - `JSEMGREP_MAX_TARGET_CHARS`, default `8388608` +Untrusted `pattern-regex`, `pattern-not-regex`, nested regex formulae, and +`metavariable-regex` constraints use the bundled Rust finite-automata engine. +General look-around and backreferences fail closed; the bounded compatibility +layer supports only a leading capture-free `(?!literal)` metavariable filter. +Patterns are capped at 8192 characters, capture groups at 128, and findings at +50000 per rule scan. `fix-regex` also uses the linear engine with a 50000 +replacement/16 MiB output cap; replacement text is currently literal, and +capture-template `$` syntax fails closed. `make adversarial-fs` covers external-file links, +directory cycles, hard links, linked configs, and autofix link rejection. + This repository is expected to remain network-free, process-execution-free, and free of direct Scheme FFI. Native parser linkage belongs in `jerboa-treesitter` and is audited by `make audit`. --- a/SECURITY.md +++ b/SECURITY.md @@ -29,6 +29,11 @@ must be cut from a clean checkout after: - Direct Scheme FFI is not allowed in this repository. - Parser FFI must stay isolated in `jerboa-treesitter`. - Rule config and target reads must keep the documented character limits. +- Untrusted rule regexes must stay on the guaranteed-linear native engine; + unsupported look-around/backreferences fail closed rather than falling back. +- Target and config walks must remain descriptor-relative, no-follow, and + bounded. Hard links are rejected and autofix rechecks the read inode before + atomic replacement. - `--autofix` is the only intentional target-file write path. - Finding output can include source snippets and metavariable captures; treat it as potentially sensitive. @@ -36,6 +41,9 @@ must be cut from a clean checkout after: operational hostnames, customer/user data, or private infrastructure details. - Target proof files must not contain source code, finding payloads, private paths, hostnames, credentials, or customer data. +- CI dependencies must remain exact-commit/tree locked. Jerbuild bootstrap + requires both a pinned digest and a signed manifest from a pinned signer; + absence of that trust root intentionally blocks network CI. ## Reporting --- a/bin/semgrep.ss +++ b/bin/semgrep.ss @@ -1,3 +1,3 @@ (import (semgrep cli)) -(exit (main (cdr (command-line)))) +(exit (main (command-line-arguments))) new file mode 100644 --- /dev/null +++ b/dependency-lock.tsv @@ -0,0 +1,2 @@ +# name url commit tree +jerboa-treesitter https://git.sr.ht/~lisp/jerboa-treesitter a41969db3329e9489bb0fadac4e2c051d9c7ed13 2dd66d61d070b188310b0925f7ecb65c2e0833c2 --- a/docs/parser-hardening.md +++ b/docs/parser-hardening.md @@ -14,6 +14,21 @@ defaults. Path-based readers reject empty paths and paths containing NUL bytes. Stdin is read through the same target-size limiter used for target files. +Directory targets and configuration directories are enumerated from retained +directory descriptors. Symlinks are skipped, single-file symlinks and hard +links are rejected, visited directory identities prevent cycles, and global +entry/depth/path/listing budgets stop traversal amplification. Autofix reads a +single-link inode and commits an atomic sibling replacement only after the +native layer rechecks that same device/inode immediately before rename. + +Rule-supplied regexes compile through the bundled Rust finite-automata engine. +The wrapper caps pattern length, capture count, and findings; encodes each +subject once; converts native UTF-8 byte boundaries without quadratic rescans; +and fails closed on unsupported look-around/backreferences. A narrowly parsed +leading `(?!literal)` metavariable filter is handled without a backtracking +engine. `fix-regex` is likewise linear and bounded; capture interpolation in +replacement templates is rejected until it has a size-aware expander. + Structural parse failures are limited to expected parser and structural matcher conditions. Broad catch-all guards are rejected by `scripts/security-check.sh` so unrelated implementation errors are not silently converted into misses. --- a/docs/release-evidence.md +++ b/docs/release-evidence.md @@ -7,6 +7,8 @@ The bundle includes: - git commit, status, and diff summary, - Jerboa and tree-sitter dependency environment metadata, +- the exact `jerboa-treesitter` commit/tree lock plus bundled native regex, + secure-filesystem, and Cargo lock hashes, - security, audit, import-check, malformed corpus, and test logs, - source-file SHA-256 digests, - `sbom/`, with Semgrep source/release-input hashes plus copied @@ -31,6 +33,13 @@ commits transpiled Scheme artifacts as part of its source distribution. before recording this repository's SBOM, so grammar/runtime provenance remains attached to the Semgrep evidence bundle. +`make dependency-lock-check` requires the parser checkout to equal the commit +and tree in `dependency-lock.tsv` and to contain no dirty or untracked build +inputs. Network CI fetches that detached revision without consulting a default +branch. Jerbuild installation remains blocked until the upstream producer +publishes a signed manifest and a pinned signer is provisioned; this is an +intentional release blocker, not a skipped verification step. + `make target-evidence` records local status by default. Production scanner support requires `JSEMGREP_REQUIRE_TARGET_PROOF=1` and `JSEMGREP_TARGET_PROOF_FILE=/path/to/proof.txt`; missing or marker-incomplete --- a/docs/threat-model.md +++ b/docs/threat-model.md @@ -19,12 +19,17 @@ network listeners or make outbound network requests. - `.semgrepignore` files are untrusted input. - Tree-sitter parsing crosses into the sibling `jerboa-treesitter` native shim. - `--autofix` crosses from read-only scanning to caller-approved file writes. +- The bundled Rust native library is the trust boundary for linear regex and + descriptor-relative file operations. ## Security Requirements - Runtime source must remain network-free and process-execution-free. - This repository must not use Scheme FFI directly. -- File reads must reject invalid paths and apply documented character limits. +- File reads must reject links and invalid paths, pin directory/file identity, + and apply cumulative traversal and character limits. +- Untrusted rule regexes must never fall back to the backtracking Scheme + engine. Unsupported native syntax is a configuration error. - Parser failures for unsupported or malformed structural patterns must fail closed without hiding unrelated runtime errors. - Test cleanup must use taint-aware filesystem helpers. --- a/lib/semgrep/cli.sls +++ b/lib/semgrep/cli.sls @@ -9,15 +9,27 @@ 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 text glob) - (semgrep lang) (semgrep scan) (semgrep result) - (semgrep rule) (semgrep rule parse-rule) (semgrep fix) - (semgrep output json) (semgrep output sarif) + (except (jerboa prelude) meta atom?) (std os secure-output) + (std text glob) (semgrep lang) (semgrep scan) + (semgrep result) (semgrep rule) (semgrep rule parse-rule) + (semgrep fix) (semgrep output json) (semgrep output sarif) (semgrep output text) (only (semgrep targeting path-filter) read-target-file-string + read-target-from-root-with-identity read-target-port-string)) + (define max-recursive-entries 100000) + (define max-recursive-depth 128) + (define max-recursive-path-chars (* 8 1024 1024)) + (define max-directory-entries 10000) + (define max-directory-list-bytes (* 1024 1024)) + (defstruct cli-root (handle)) + (defstruct cli-target (root relative display)) + (def (target-display target) + (if (cli-target? target) + (cli-target-display target) + target)) (def (usage) (display "usage: semgrep scan --config RULES.yml [--lang LANG] [--severity LEVEL] [--include GLOB] [--exclude GLOB] TARGET\n") @@ -199,6 +211,18 @@ [(char=? (string-ref path i) #\/) (substring path (+ i 1) len)] [else (loop (- i 1))])))) + (def (path-parent-and-name path) + (let ([len (string-length path)]) + (let loop ([i (- len 1)]) + (cond + [(< i 0) (values "." path)] + [(char=? (string-ref path i) #\/) + (when (= i (- len 1)) + (error 'semgrep-cli "target path ends with slash" path)) + (values + (if (= i 0) "/" (substring path 0 i)) + (substring path (+ i 1) len))] + [else (loop (- i 1))])))) (def (target-pattern-matches? pattern path) (or (glob-match? pattern path) (glob-match? pattern (path-basename path)))) @@ -214,46 +238,155 @@ (loop (cdr xs)))))))) (def (scannable-file? language-opt path) (or language-opt (guess-language-from-path path))) - (def (expand-directory-target language-opt dir) - (let ([ignore-patterns (read-semgrepignore dir)]) - (let walk ([current dir] [relative-dir ""] [acc '()]) - (let loop ([entries (directory-list current)] - [current-acc acc]) - (if (null? entries) - current-acc - (let* ([name (entry->string (car entries))] - [path (sg-path-join current name)] - [relative (if (string=? relative-dir "") - name - (sg-path-join relative-dir name))]) - (cond - [(or (string=? name ".") (string=? name "..")) - (loop (cdr entries) current-acc)] - [(ignored-path? ignore-patterns relative name) - (loop (cdr entries) current-acc)] - [(and (file-directory? path) - (not (skip-directory-name? name))) - (loop - (cdr entries) - (walk path relative current-acc))] - [(and (not (file-directory? path)) - (scannable-file? language-opt path)) - (loop (cdr entries) (cons path current-acc))] - [else (loop (cdr entries) current-acc)]))))))) + (def (identity-key info) + (cons (secure-entry-device info) (secure-entry-inode info))) + (def (identity-seen? key seen) + (let loop ([xs seen]) + (and (not (null? xs)) + (or (equal? key (car xs)) (loop (cdr xs)))))) + (def (expand-open-directory-target language-opt dir root) + (let ([ignore-patterns (read-semgrepignore dir)] + [entry-count 0] + [path-char-count 0] + [seen '()]) + (let walk ([relative-dir ""] [depth 0] [acc '()]) + (when (> depth max-recursive-depth) + (error 'semgrep-cli + "recursive target exceeds depth limit" + max-recursive-depth)) + (let* ([directory-info (secure-entry-info + (cli-root-handle root) + relative-dir)] + [key (identity-key directory-info)]) + (unless (eq? (secure-entry-kind directory-info) 'directory) + (error 'semgrep-cli + "recursive target changed type" + relative-dir)) + (when (identity-seen? key seen) + (error 'semgrep-cli + "recursive target contains a directory cycle" + relative-dir)) + (set! seen (cons key seen)) + (let loop ([entries (secure-directory-list + (cli-root-handle root) + relative-dir + max-directory-entries + max-directory-list-bytes)] + [current-acc acc]) + (if (null? entries) + current-acc + (let* ([name (car entries)] + [relative (if (string=? relative-dir "") + name + (sg-path-join relative-dir name))] + [display (sg-path-join dir relative)]) + (set! entry-count (+ entry-count 1)) + (set! path-char-count + (+ path-char-count (string-length relative))) + (when (> entry-count max-recursive-entries) + (error 'semgrep-cli + "recursive target exceeds entry limit" + max-recursive-entries)) + (when (> path-char-count max-recursive-path-chars) + (error 'semgrep-cli + "recursive target exceeds path-byte budget" + max-recursive-path-chars)) + (if (ignored-path? ignore-patterns relative name) + (loop (cdr entries) current-acc) + (let ([info (secure-entry-info + (cli-root-handle root) + relative)]) + (case (secure-entry-kind info) + [(symlink) (loop (cdr entries) current-acc)] + [(directory) + (if (skip-directory-name? name) + (loop (cdr entries) current-acc) + (loop + (cdr entries) + (walk + relative + (+ depth 1) + current-acc)))] + [(file) + (when (> (secure-entry-links info) 1) + (error 'semgrep-cli + "recursive target contains a hard-linked file" + display)) + (loop + (cdr entries) + (if (scannable-file? language-opt display) + (cons + (make-cli-target + root + relative + display) + current-acc) + current-acc))] + [else + (loop (cdr entries) current-acc)])))))))))) + (def (expand-file-target target) + (let-values ([(parent name) (path-parent-and-name target)]) + (let ([handle (secure-directory-open parent #f)]) + (guard (failure + [#t (secure-directory-close handle) (raise failure)]) + (let* ([root (make-cli-root handle)] + [info (secure-entry-info handle name)]) + (unless (eq? (secure-entry-kind info) 'file) + (error 'semgrep-cli + "target is not a regular file" + target)) + (when (> (secure-entry-links info) 1) + (error 'semgrep-cli + "target has multiple hard links" + target)) + (values + (list (make-cli-target root name target)) + (list root))))))) (def (expand-target language-opt target) (if (string=? target "-") - (list target) - (if (file-directory? target) - (reverse (expand-directory-target language-opt target)) - (list target)))) + (values (list target) '()) + (guard (directory-error [#t (expand-file-target target)]) + (let* ([handle (secure-directory-open-strict target)] + [root (make-cli-root handle)]) + (guard (walk-error + [#t + (secure-directory-close handle) + (raise walk-error)]) + (values + (reverse + (expand-open-directory-target + language-opt + target + root)) + (list root))))))) (def (expand-targets language-opt includes excludes targets) - (filter - (lambda (target) - (target-selected? includes excludes target)) - (apply - append - (map (lambda (target) (expand-target language-opt target)) - targets)))) + (let ([opened-roots '()]) + (guard (failure + [#t + (for-each + (lambda (root) + (secure-directory-close (cli-root-handle root))) + opened-roots) + (raise failure)]) + (let loop ([remaining targets] [expanded '()]) + (if (null? remaining) + (values + (filter + (lambda (target) + (target-selected? + includes + excludes + (target-display target))) + (reverse expanded)) + opened-roots) + (let-values ([(next-targets next-roots) + (expand-target + language-opt + (car remaining))]) + (set! opened-roots (append next-roots opened-roots)) + (loop + (cdr remaining) + (append (reverse next-targets) expanded)))))))) (def (string-list-member? needle xs) (and (not (null? xs)) (or (string=? needle (car xs)) @@ -284,8 +417,9 @@ (and (or (string=? canonical "generic") (string=? canonical "regex")) language))))) - (def (scan-one config-path language-opt target-path) - (let* ([rules (parse-config-file config-path)] + (def (scan-one config-path language-opt target) + (let* ([target-path (target-display target)] + [rules (parse-config-file config-path)] [language (or language-opt (single-text-config-language rules) (and (not (string=? target-path "-")) @@ -303,19 +437,49 @@ language "<stdin>" (read-target-port-string (current-input-port) "<stdin>")) - (scan-file rules language target-path)))) + (if (cli-target? target) + (call-with-values + (lambda () + (read-target-from-root-with-identity + (cli-root-handle (cli-target-root target)) + (cli-target-relative target) + target-path)) + (lambda (source identity) + (scan-string rules language target-path source))) + (scan-file rules language target-path))))) (def (findings-for-path path findings) (filter (lambda (finding) (string=? (finding-path finding) path)) findings)) (def (apply-autofix-to-target! target findings) - (unless (string=? target "-") - (let ([target-findings (findings-for-path target findings)]) - (unless (null? target-findings) - (let ([source (read-target-file-string target)]) - (write-file-string - target - (apply-fixes-to-string source target-findings))))))) + (let ([display (target-display target)]) + (unless (string=? display "-") + (let ([target-findings (findings-for-path + display + findings)]) + (unless (null? target-findings) + (if (cli-target? target) + (call-with-values + (lambda () + (read-target-from-root-with-identity + (cli-root-handle (cli-target-root target)) + (cli-target-relative target) + display)) + (lambda (source identity) + (let ([replacement (apply-fixes-to-string + source + target-findings)]) + (call-with-secure-replacement-file + (cli-root-handle (cli-target-root target)) + (cli-target-relative target) + identity + (lambda (port) + (put-bytevector + port + (string->utf8 replacement))))))) + (error 'semgrep-cli + "autofix requires a descriptor-relative target" + display))))))) (def (apply-autofix! targets findings) (let loop ([xs targets]) (unless (null? xs) @@ -338,22 +502,32 @@ (when (null? targets) (usage) (error 'semgrep-cli "missing target")) - (let* ([expanded-targets (expand-targets - language - includes - excludes - targets)] - [findings (filter-findings-by-severity - severities - (apply - append - (map (lambda (target) - (scan-one - config - language - target)) - expanded-targets)))]) - (when autofix? (apply-autofix! expanded-targets findings)) - (display (format-findings format findings)) - (newline) - (if (null? findings) 0 1))))))) + (let-values ([(expanded-targets roots) + (expand-targets + language + includes + excludes + targets)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([findings (filter-findings-by-severity + severities + (apply + append + (map (lambda (target) + (scan-one + config + language + target)) + expanded-targets)))]) + (when autofix? + (apply-autofix! expanded-targets findings)) + (display (format-findings format findings)) + (newline) + (if (null? findings) 0 1))) + (lambda () + (for-each + (lambda (root) + (secure-directory-close (cli-root-handle root))) + roots))))))))) --- a/lib/semgrep/engine/regex-scan.sls +++ b/lib/semgrep/engine/regex-scan.sls @@ -18,65 +18,97 @@ (semgrep result findings) (semgrep engine regex-support) (semgrep source offsets)) (def (finding-from-match rule path source match) - (let ([start (re-match-start match)] - [end (re-match-end match)]) + (let* ([start-index (re-match-start match)] + [end-index (re-match-end match)] + [start (source-index->semgrep-offset source start-index)] + [end (source-index->semgrep-offset source end-index)]) (let-values ([(start-line start-col) - (offset->line-col source start)] - [(end-line end-col) (offset->line-col source end)]) + (offset->line-col source start-index)] + [(end-line end-col) + (offset->line-col source end-index)]) (make-finding (rule-id rule) path start-line start-col end-line end-col start end (rule-message rule) (rule-severity rule) (finding-extra-for-match rule '() - (substring source start end)))))) + (substring source start-index end-index)))))) (def (finding-from-regex-match-at rule path source pattern match input-start) - (let* ([start (+ input-start (re-match-start match))] - [end (+ input-start (re-match-end match))] + (let* ([match-start (if (linear-match? match) + (linear-match-start match) + (re-match-start match))] + [match-end (if (linear-match? match) + (linear-match-end match) + (re-match-end match))] + [start-index (+ input-start match-start)] + [end-index (+ input-start match-end)] + [start (source-index->semgrep-offset source start-index)] + [end (source-index->semgrep-offset source end-index)] [bindings (regex-capture-bindings-at pattern source match input-start)]) (let-values ([(start-line start-col) - (offset->line-col source start)] - [(end-line end-col) (offset->line-col source end)]) + (offset->line-col source start-index)] + [(end-line end-col) + (offset->line-col source end-index)]) (make-finding (rule-id rule) path start-line start-col end-line end-col start end (render-fix-template (rule-message rule) bindings) (rule-severity rule) (finding-extra-for-match rule bindings - (substring source start end)))))) + (substring source start-index end-index)))))) (def (finding-from-regex-match rule path source pattern match) (finding-from-regex-match-at rule path source pattern match 0)) (def (finding-for-whole-text rule path source) - (let ([end (string-length source)]) + (let* ([end-index (string-length source)] + [end (source-index->semgrep-offset source end-index)]) (let-values ([(end-line end-col) - (offset->line-col source end)]) + (offset->line-col source end-index)]) (make-finding (rule-id rule) path 1 1 end-line end-col 0 end (rule-message rule) (rule-severity rule) (finding-extra-for-match rule '() source))))) + (define max-regex-findings-per-rule 50000) + (def (consume-regex-finding-budget! budget) + (let ([used (vector-ref budget 0)]) + (when (>= used max-regex-findings-per-rule) + (error 'scan-regex-rule + "regex finding count exceeds hard limit" + max-regex-findings-per-rule)) + (vector-set! budget 0 (+ used 1)))) + (def (scan-compiled-regex-pattern rx rule path source + pattern input input-start budget) + (let ([subject (make-linear-subject input)]) + (let loop ([start-byte 0] [acc '()]) + (let ([match (linear-regex-search rx subject start-byte)]) + (if match + (begin + (consume-regex-finding-budget! budget) + (let ([finding (finding-from-regex-match-at rule path source pattern match + input-start)]) + (loop + (linear-match-next-byte match) + (append + (reverse (apply-rule-focus rule finding)) + acc)))) + (reverse acc)))))) + (def (call-with-linear-regex pattern proc) + (let ([rx (linear-regex-compile + (regex-pattern-for-engine pattern))]) + (dynamic-wind + (lambda () (void)) + (lambda () (proc rx)) + (lambda () (linear-regex-free rx))))) (def (scan-regex-pattern rule path source pattern) - (let ([rx (re (regex-pattern-for-engine pattern))] - [len (string-length source)]) - (let loop ([start 0] [acc '()]) - (if (> start len) - (reverse acc) - (let ([match (re-search rx source start)]) - (if match - (let* ([finding (finding-from-regex-match rule path - source pattern match)] - [next (max (+ (re-match-start match) 1) - (re-match-end match))]) - (loop - next - (append - (reverse (apply-rule-focus rule finding)) - acc))) - (reverse acc))))))) + (call-with-linear-regex + pattern + (lambda (rx) + (scan-compiled-regex-pattern rx rule path source pattern + source 0 (vector 0))))) (def (regex-uses-line-anchor? pattern) (let ([len (string-length pattern)]) (let loop ([i 0] [escaped? #f]) @@ -88,26 +120,8 @@ (char=? (string-ref pattern i) #\$)) #t] [else (loop (+ i 1) #f)])))) - (def (scan-regex-pattern-line rule path source pattern line - line-start) - (let ([rx (re (regex-pattern-for-engine pattern))] - [len (string-length line)]) - (let loop ([start 0] [acc '()]) - (if (> start len) - (reverse acc) - (let ([match (re-search rx line start)]) - (if match - (let* ([finding (finding-from-regex-match-at rule path source pattern match - line-start)] - [next (max (+ (re-match-start match) 1) - (re-match-end match))]) - (loop - next - (append - (reverse (apply-rule-focus rule finding)) - acc))) - (reverse acc))))))) - (def (scan-regex-pattern-lines rule path source pattern) + (def (scan-regex-pattern-lines rx rule path source pattern + budget) (let ([len (string-length source)]) (let loop ([i 0] [line-start 0] [acc '()]) (cond @@ -115,8 +129,8 @@ (reverse (append (reverse - (scan-regex-pattern-line rule path source pattern - (substring source line-start len) line-start)) + (scan-compiled-regex-pattern rx rule path source pattern + (substring source line-start len) line-start budget)) acc))] [(char=? (string-ref source i) #\newline) (loop @@ -124,8 +138,8 @@ (+ i 1) (append (reverse - (scan-regex-pattern-line rule path source pattern - (substring source line-start i) line-start)) + (scan-compiled-regex-pattern rx rule path source pattern + (substring source line-start i) line-start budget)) acc))] [else (loop (+ i 1) line-start acc)])))) (def (scan-regex-pattern-with-line-anchors @@ -133,12 +147,19 @@ path source pattern) - (if (regex-uses-line-anchor? pattern) - (dedupe-findings - (append - (scan-regex-pattern rule path source pattern) - (scan-regex-pattern-lines rule path source pattern))) - (scan-regex-pattern rule path source pattern))) + (call-with-linear-regex + pattern + (lambda (rx) + (let* ([budget (vector 0)] + [whole (scan-compiled-regex-pattern rx rule path source + pattern source 0 budget)]) + (if (regex-uses-line-anchor? pattern) + (dedupe-findings + (append + whole + (scan-regex-pattern-lines rx rule path source pattern + budget))) + whole))))) (def (scan-regex-rule rule path source) (scan-regex-pattern-with-line-anchors rule --- a/lib/semgrep/engine/regex-support.sls +++ b/lib/semgrep/engine/regex-support.sls @@ -4,7 +4,12 @@ (library (semgrep engine regex-support) (export substring-at? string-find-substring-from - regex-pattern-for-engine make-regex-capture-binding + regex-pattern-for-engine linear-regex-compile + linear-regex-free make-linear-subject linear-regex-search + linear-regex-matches? linear-match? linear-match-start + linear-match-end linear-match-start-byte + linear-match-end-byte linear-match-full linear-match-group + linear-match-next-byte make-regex-capture-binding regex-capture-bindings-at regex-capture-bindings) (import (except (chezscheme) make-hash-table hash-table? sort sort! @@ -12,8 +17,196 @@ with-input-from-string with-output-to-string iota \x31;+ \x31;- partition make-date make-time meta atom?) (except (jerboa prelude) meta atom?) - (semgrep source offsets) + (prefix (std regex-native) native:) (semgrep source offsets) (semgrep match structural)) + (define linear-regex-max-pattern-chars 8192) + (define linear-regex-max-groups 128) + (define linear-offset-checkpoint-stride 256) + (defstruct linear-regex (handle group-count)) + (defstruct + linear-subject-data + (text utf8 checkpoint-bytes checkpoint-chars)) + (defstruct linear-match (subject byte-ranges char-ranges)) + (def (utf8-char-width ch) + (let ([code (char->integer ch)]) + (cond + [(<= code 127) 1] + [(<= code 2047) 2] + [(<= code 65535) 3] + [else 4]))) + (def (make-offset-checkpoints text byte-length) + (let* ([count (+ (quotient + byte-length + linear-offset-checkpoint-stride) + 1)] + [checkpoint-bytes (make-vector count 0)] + [checkpoint-chars (make-vector count 0)] + [char-length (string-length text)]) + (let loop ([char-index 0] [byte-index 0] [checkpoint 1]) + (cond + [(>= checkpoint count) + (values checkpoint-bytes checkpoint-chars)] + [(= char-index char-length) + (let fill ([index checkpoint]) + (when (< index count) + (vector-set! checkpoint-bytes index byte-index) + (vector-set! checkpoint-chars index char-index) + (fill (+ index 1)))) + (values checkpoint-bytes checkpoint-chars)] + [else + (let ([next-byte (+ byte-index + (utf8-char-width + (string-ref text char-index)))] + [threshold (* checkpoint + linear-offset-checkpoint-stride)]) + (if (> next-byte threshold) + (begin + (vector-set! checkpoint-bytes checkpoint byte-index) + (vector-set! checkpoint-chars checkpoint char-index) + (loop char-index byte-index (+ checkpoint 1))) + (loop (+ char-index 1) next-byte checkpoint)))])))) + (def (make-linear-subject text) + (unless (string? text) + (error 'make-linear-subject "expected string" text)) + (let* ([utf8 (string->utf8 text)] + [byte-length (bytevector-length utf8)]) + (let-values ([(checkpoint-bytes checkpoint-chars) + (make-offset-checkpoints text byte-length)]) + (make-linear-subject-data + text + utf8 + checkpoint-bytes + checkpoint-chars)))) + (def (linear-subject-byte->char subject byte-offset) + (let* ([utf8 (linear-subject-data-utf8 subject)] + [byte-length (bytevector-length utf8)]) + (unless (and (integer? byte-offset) + (exact? byte-offset) + (>= byte-offset 0) + (<= byte-offset byte-length)) + (error 'linear-subject-byte->char + "invalid UTF-8 byte offset" + byte-offset)) + (let* ([block (quotient + byte-offset + linear-offset-checkpoint-stride)] + [byte-start (vector-ref + (linear-subject-data-checkpoint-bytes + subject)