mcp: add module and changed-line tooling
ober
7de6f493130614cbabeb8b25655c052e59b8b242
--- a/data/changelog.sexp +++ b/data/changelog.sexp @@ -3,6 +3,7 @@ "Machine-readable changelog of Jerboa API drift. Consumers (LLM tooling, lints, jerboa_verify) use this to invalidate stale recommendations and to suggest migrations when a symbol is renamed or relocated.") ("entries" (("added" "jerboa_symbol_exists_batch" "jerboa_verify_changes" + "jerboa_module_exists" "jerboa_variadic_ffi_check" "tools/gen-api-signatures.ss" "make api-signatures") ("date" . "2026-05-27") ("modules_added" @@ -18,11 +19,12 @@ ("moved") ("notes" . - "Refreshed MCP/LSP knowledge data from source: data/api-signatures.sexp now covers 679 modules, 9,907 symbols, and 13,077 exports with 0 parse errors. LSP completion tables were regenerated from the refreshed map. MCP added compact dispatcher search/catalog/describe with stable t: ids, project_path/extra_libdirs support for compile_check/verify/run_tests, new jerboa_symbol_exists_batch and jerboa_verify_changes tools, writer tools promoted to critical hybrid surface, and feature status metadata.") + "Refreshed MCP/LSP knowledge data from source: data/api-signatures.sexp now covers 679 modules, 9,907 symbols, and 13,077 exports with 0 parse errors. LSP completion tables were regenerated from the refreshed map. MCP added compact dispatcher search/catalog/describe with stable t: ids, project_path/extra_libdirs support for compile_check/verify/run_tests, new jerboa_symbol_exists_batch and jerboa_verify_changes tools, writer tools promoted to critical hybrid surface, feature status metadata, jerboa_module_exists, changed-line filtering in jerboa_security_scan, #!chezscheme reader autodetection for verify/compile_check, and jerboa_variadic_ffi_check.") ("removed") ("renamed") ("tier_changes") - ("tools_added" "jerboa_symbol_exists_batch" "jerboa_verify_changes") + ("tools_added" "jerboa_symbol_exists_batch" "jerboa_verify_changes" + "jerboa_module_exists" "jerboa_variadic_ffi_check") ("version" . #f)) (("added") ("date" . "2026-04-22") ("moved") ("notes" --- a/data/cookbooks.sexp +++ b/data/cookbooks.sexp @@ -4514,4 +4514,37 @@ "data/api-signatures.sexp is the shared API catalog used by MCP symbol lookup and by lsp/gen-completion-tables.ss. Refresh it after adding stdlib, jerboa, or lsp library modules, then run make lsp-gen so lsp/analysis/completion-tables.ss follows the same source of truth.") ("tags" "api-signatures" "lsp" "mcp" "completion" "data") - ("title" . "Regenerate MCP/LSP API signatures from source"))) + ("title" . "Regenerate MCP/LSP API signatures from source")) + (("code" + . + ";; Check whether a module exists without importing it.\n;; Accepts canonical, slash, and colon module path forms:\n;; {\"name\":\"jerboa_module_exists\",\n;; \"arguments\":{\"module_path\":\"(std sort)\"}}\n;; {\"name\":\"jerboa_module_exists\",\n;; \"arguments\":{\"module_path\":\":std/text/json\"}}\n\n;; For project-local modules, include local libdirs:\n;; {\"name\":\"jerboa_module_exists\",\n;; \"arguments\":{\"module_path\":\"(app core)\",\n;; \"project_path\":\"/path/to/project\"}}\n\n;; The response is compact text with exists: true/false and the first matching .ss/.sls/.so path.") + ("id" . "mcp-module-exists") + ("imports") + ("notes" + . + "Use jerboa_module_exists before jerboa_module_exports when you only need a clean boolean. It resolves candidate files in extra_libdirs, project_path-derived libdirs, and JERBOA_HOME/lib without running an import, so absent modules do not produce noisy reader/import errors.") + ("tags" "mcp" "module" "exists" "stdlib" "libdirs" + "discovery") + ("title" . "Check whether a Jerboa module exists without importing it")) + (("code" + . + ";; Report only findings on changed lines by passing explicit lines:\n;; {\"name\":\"jerboa_security_scan\",\n;; \"arguments\":{\"file_path\":\"src/ffi.ss\",\n;; \"changed_lines\":[42,\"50-55\"]}}\n\n;; Or pass file-qualified line specs for multi-file scans:\n;; {\"name\":\"jerboa_security_scan\",\n;; \"arguments\":{\"project_path\":\"/path/to/project\",\n;; \"changed_lines\":[{\"file\":\"src/ffi.ss\",\"start\":42,\"end\":55}]}}\n\n;; Or derive changed lines from a unified diff/base ref:\n;; {\"name\":\"jerboa_security_scan\",\n;; \"arguments\":{\"project_path\":\"/path/to/project\",\n;; \"base_ref\":\"main\",\n;; \"changed_only\":true}}") + ("id" . "mcp-security-scan-changed-lines") + ("imports") + ("notes" + . + "The changed-line mode still scans with the normal rules, then filters findings by line number and reports total/outside-filter counts. Use this when a large legacy file has historical findings and you only need to know whether the current patch introduced a new issue.") + ("tags" "mcp" "security-scan" "diff" "changed-lines" + "baseline" "review") + ("title" . "Limit MCP security scan output to changed lines")) + (("code" + . + ";; #!chezscheme library files are verified with the Chez reader path:\n;; {\"name\":\"jerboa_verify\",\n;; \"arguments\":{\"file_path\":\"lib/std/ergo.ss\"}}\n\n;; Lint fixed-arity FFI declarations for known variadic libc symbols:\n;; {\"name\":\"jerboa_variadic_ffi_check\",\n;; \"arguments\":{\"file_path\":\"lib/std/net/io.ss\"}}\n\n;; A finding includes file, line, symbol, declared arity, and the fixed-prefix threshold.") + ("id" . "mcp-chez-reader-and-variadic-ffi-checks") + ("imports") + ("notes" + . + "jerboa_verify and jerboa_compile_check auto-route .sls and #!chezscheme sources through Chez datum reading, which avoids false failures on library-form .ss files with colon-prefixed Chez identifiers. jerboa_variadic_ffi_check complements security_scan by reporting known variadic libc foreign-procedure declarations with arity details and C-shim guidance.") + ("tags" "mcp" "verify" "chez-reader" "ffi" "variadic" + "foreign-procedure") + ("title" . "Verify Chez-reader libraries and lint variadic FFI declarations"))) --- a/data/features.sexp +++ b/data/features.sexp @@ -269,6 +269,12 @@ . "Phase 4 of jerboa-edge planned to use (std crdt) for replicated state. Confirmed non-existence required attempting jerboa_module_exports which returned an error message — one extra tool call plus a confusing error. A jerboa_module_exists (std crdt) returning {exists: false} in 0 tokens of error noise would be cleaner and could be batched with other checks.") ("id" . "module-exists-check") ("impact" . "low") + ("status" . "implemented") + ("implemented_tool" . "jerboa_module_exists") + ("implemented_in" . "mcp/server.ss") + ("closed_reason" + . + "Added jerboa_module_exists with direct libdir path resolution for (std ...), :std/..., project_path, extra_libdirs, and jerboa_home without importing the module.") ("tags" "module" "exists" "stdlib" "check" "discovery") ("title" . @@ -430,6 +436,12 @@ "jerboa-emacs `vendor/jerboa-repl-socket.sls` declared `(foreign-procedure \"fcntl\" (int int int) int)` to set a listen socket non-blocking. On Linux this worked. On macOS arm64 (Chez 10.4 tarm64osx), the call returned 0 but post-call F_GETFL showed `0x40000A` instead of expected `0x6` — O_NONBLOCK bit not set, plus garbage high bits. Symptom at the editor level: TICK debug-repl took 6–8 seconds because accept() blocked. Diagnosis took ~2 hours of incrementally wrapping fcntl with debug printfs and writing a standalone Chez test before the ABI mismatch was identified. A linter would have flagged fcntl-with-3-args as the first hypothesis. Fix in jerboa-emacs: switch to ioctl(FIONBIO, &one) — ioctl's `(int unsigned-long void*)` signature is non-variadic-safe.") ("id" . "detect-variadic-libc-fixed-arity-ffi") ("impact" . "high") + ("status" . "implemented") + ("implemented_tool" . "jerboa_variadic_ffi_check") + ("implemented_in" . "mcp/server.ss") + ("closed_reason" + . + "Added jerboa_variadic_ffi_check for line-level foreign-procedure scanning of known variadic libc symbols, with declared arity and fixed-prefix threshold reporting. The existing variadic-libc security rule remains available through jerboa_security_scan.") ("tags" "ffi" "variadic" "foreign-procedure" "abi" "darwin" "arm64" "lint") ("title" @@ -536,6 +548,12 @@ "While updating ffi-shim.c in jerboa-shell, the scan reported 44 high missing-EINTR findings across the whole file, including pre-existing lines and some already-wrapped loops. None were on the new fork helper, but confirming that required manual line comparison and a large output dump.") ("id" . "security-scan-changed-lines-mode") ("impact" . "medium") + ("status" . "implemented") + ("implemented_tool" . "jerboa_security_scan") + ("implemented_in" . "mcp/server.ss") + ("closed_reason" + . + "jerboa_security_scan now accepts changed_only, changed_lines, diff, and base_ref. It filters findings to changed lines and reports total/outside-filter counts to keep historical findings quiet.") ("tags" "security-scan" "diff" "changed-lines" "baseline" "noise") ("title" @@ -556,6 +574,12 @@ "Editing a #!chezscheme .sls compatibility shim with let bindings written as ([rest args]) caused jerboa_verify to report invalid syntax, forcing an extra compile_check call with force_chez_reader to distinguish a tool false positive from a real syntax error.") ("id" . "verify-sls-chez-reader-autodetect") ("impact" . "medium") + ("status" . "implemented") + ("implemented_tool" . "jerboa_verify") + ("implemented_in" . "mcp/server.ss") + ("closed_reason" + . + "jerboa_verify and jerboa_compile_check now auto-route .sls files and #!chezscheme sources through the Chez datum reader path instead of Jerboa reader translation.") ("tags" "verify" "sls" "chez-reader" "syntax" "library") ("title" . @@ -575,6 +599,12 @@ "Editing lib/std/ergo.ss to export :?, :-, and :~ caused jerboa_verify to report invalid export spec (?) even though force-Chez compile_check, make build, and tests passed. This forced an extra verification path and could be mistaken for a real syntax error.") ("id" . "verify-chez-reader-colon-prefix-ss") ("impact" . "medium") + ("status" . "implemented") + ("implemented_tool" . "jerboa_verify") + ("implemented_in" . "mcp/server.ss") + ("closed_reason" + . + "The same #!chezscheme autodetection applies to .ss library files, so colon-prefixed Chez identifiers are read by Chez rather than translated as Jerboa keyword syntax.") ("tags" "verify" "chez-reader" "ss" "colon-identifiers" "ergo") ("title" --- a/mcp/server.ss +++ b/mcp/server.ss @@ -23,6 +23,7 @@ "jerboa_check_syntax" "jerboa_compile_check" "jerboa_module_exports" + "jerboa_module_exists" "jerboa_function_signature" "jerboa_howto" "jerboa_howto_get" @@ -124,6 +125,14 @@ "")) s)) +(def (chez-reader-source? source) + (string-prefix? "#!chezscheme" (string-trim source))) + +(def (chez-reader-file? file source) + (and file + (or (string-suffix? ".sls" file) + (chez-reader-source? source)))) + (def (join-lines lines) (string-join lines "\n")) @@ -724,7 +733,7 @@ (if (not source) (text-result "Provide file_path or code." #t) (let* ([home (hash-get* args "jerboa_home" #f)] - [script (if (and file (string-suffix? ".sls" file)) + [script (if (chez-reader-file? file source) (build-library-syntax-script file) (build-syntax-script (strip-shebang source) '()))] [out (run-jerboa-script script home (tool-extra-libdirs args file home))] @@ -764,7 +773,7 @@ [hits (if (hash-get* args "skip_prescan" #f) '() (divergence-hits source))] [hit-text (if (null? hits) "" (string-append "\n\nDivergence pre-scan:\n" (string-join (map format-divergence-hit hits) "\n")))] [home (hash-get* args "jerboa_home" #f)] - [script (if (and file (string-suffix? ".sls" file)) + [script (if (chez-reader-file? file source) (build-library-syntax-script file) (build-syntax-script (strip-shebang source) '()))] [out (run-jerboa-script script home (tool-extra-libdirs args file home))]) @@ -795,6 +804,52 @@ "lib: " (libdirs home) " " (if lib-ok "OK" "MISSING") "\n" "eval: " (if (index-of eval-out result-marker) "OK" "FAILED")))) +(def (module-components module-path) + (let* ([normalized (normalize-import module-path)] + [trimmed (string-trim normalized)] + [len (string-length trimmed)] + [inner (if (and (>= len 2) + (char=? (string-ref trimmed 0) #\() + (char=? (string-ref trimmed (- len 1)) #\))) + (substring trimmed 1 (- len 1)) + trimmed)]) + (filter (lambda (part) (> (string-length part) 0)) + (string-split inner #\space)))) + +(def (module-relative-path module-path) + (string-join (module-components module-path) "/")) + +(def (module-candidate-paths module-path libdirs*) + (let ([rel (module-relative-path module-path)]) + (apply append + (map (lambda (dir) + (let ([base (path-join dir rel)]) + (list (string-append base ".ss") + (string-append base ".sls") + (string-append base ".so")))) + libdirs*)))) + +(def (tool-module-exists args) + (let ([module-path (hash-get* args "module_path" #f)]) + (if (not module-path) + (text-result "module_path is required." #t) + (let* ([normalized (normalize-import module-path)] + [home (hash-get* args "jerboa_home" #f)] + [dirs (unique-strings + (append (tool-extra-libdirs args #f home) + (list (libdirs (jerboa-home home)))))] + [candidates (module-candidate-paths normalized dirs)] + [hits (filter file-exists? candidates)]) + (if (null? hits) + (text-result (string-append "Module " normalized "\nexists: false\nchecked_libdirs: " + (string-join dirs ":"))) + (text-result (string-append "Module " normalized "\nexists: true\npath: " + (car hits) + (if (> (length hits) 1) + (string-append "\nother_matches:\n " + (string-join (cdr hits) "\n ")) + "")))))))) + (def (tool-module-exports args) (def module-path (hash-get* args "module_path" #f)) (if (not module-path) @@ -1017,6 +1072,170 @@ (guard (e [else '()]) (directory-list d)))) (reverse results)) +(def (seq->list value) + (cond + [(not value) '()] + [(list? value) value] + [(vector? value) (vector->list value)] + [else (list value)])) + +(def (digit-char? ch) + (and (char>=? ch #\0) (char<=? ch #\9))) + +(def (scan-digits s start) + (let loop ([i start]) + (if (and (< i (string-length s)) + (digit-char? (string-ref s i))) + (loop (+ i 1)) + i))) + +(def (parse-int s) + (guard (e [else #f]) + (let ([n (string->number s)]) + (and (integer? n) n)))) + +(def (finding-file-line finding) + (let ([space (string-index finding #\space)]) + (and space + (let loop ([i (+ space 1)]) + (cond + [(>= i (string-length finding)) #f] + [(and (char=? (string-ref finding i) #\:) + (< (+ i 1) (string-length finding)) + (digit-char? (string-ref finding (+ i 1)))) + (let* ([end (scan-digits finding (+ i 1))] + [line (parse-int (substring finding (+ i 1) end))]) + (and line (cons (substring finding (+ space 1) i) line)))] + [else (loop (+ i 1))]))))) + +(def (strip-diff-prefix path) + (cond + [(string-prefix? "a/" path) (substring path 2 (string-length path))] + [(string-prefix? "b/" path) (substring path 2 (string-length path))] + [else path])) + +(def (file-pattern-match? file pattern) + (let ([p (strip-diff-prefix pattern)]) + (or (string=? file p) + (string-suffix? p file) + (string-suffix? file p)))) + +(def (line-token-match? token line) + (let ([dash (string-index token #\-)]) + (if dash + (let ([start (parse-int (substring token 0 dash))] + [end (parse-int (substring token (+ dash 1) (string-length token)))]) + (and start end (<= start line) (<= line end))) + (let ([n (parse-int token)]) + (and n (= n line)))))) + +(def (changed-line-spec-match? spec file line) + (cond + [(number? spec) (= spec line)] + [(string? spec) + (let ([colon (last-index-char spec #\:)]) + (if colon + (let ([spec-file (substring spec 0 colon)] + [token (substring spec (+ colon 1) (string-length spec))]) + (and (file-pattern-match? file spec-file) + (line-token-match? token line))) + (line-token-match? spec line)))] + [(hash-table? spec) + (let* ([spec-file (hash-get* spec "file" #f)] + [line-value (hash-get* spec "line" #f)] + [start (hash-get* spec "start" #f)] + [end (hash-get* spec "end" #f)] + [file-ok (or (not spec-file) (file-pattern-match? file spec-file))]) + (and file-ok + (cond + [line-value (changed-line-spec-match? line-value file line)] + [(and start end) (and (<= start line) (<= line end))] + [start (= start line)] + [else #f])))] + [else #f])) + +(def (finding-on-changed-line? specs finding) + (let ([parsed (finding-file-line finding)]) + (and parsed + (any (lambda (spec) + (changed-line-spec-match? spec (car parsed) (cdr parsed))) + specs)))) + +(def (space-or-tab? ch) + (or (char=? ch #\space) (char=? ch #\tab))) + +(def (token-end s start) + (let loop ([i start]) + (if (and (< i (string-length s)) + (not (space-or-tab? (string-ref s i)))) + (loop (+ i 1)) + i))) + +(def (diff-file-token line) + (let* ([start 4] + [end (token-end line start)] + [token (substring line start end)]) + (and (not (string=? token "/dev/null")) + (strip-diff-prefix token)))) + +(def (parse-hunk-range token) + (let ([comma (string-index token #\,)]) + (if comma + (let ([start (parse-int (substring token 0 comma))] + [count (parse-int (substring token (+ comma 1) (string-length token)))]) + (and start count (> count 0) (cons start (+ start count -1)))) + (let ([start (parse-int token)]) + (and start (cons start start)))))) + +(def (diff-hunk-new-range line) + (let ([plus (string-contains line " +")]) + (and plus + (let* ([start (+ plus 2)] + [end (token-end line start)] + [token (substring line start end)]) + (parse-hunk-range token))))) + +(def (diff-changed-line-specs diff) + (let loop ([lines (string-split diff #\newline)] + [current-file #f] + [specs '()]) + (cond + [(null? lines) (reverse specs)] + [else + (let ([line (car lines)]) + (cond + [(string-prefix? "+++ " line) + (loop (cdr lines) (diff-file-token line) specs)] + [(and current-file (string-prefix? "@@ " line)) + (let ([range (diff-hunk-new-range line)]) + (loop (cdr lines) + current-file + (if range + (cons (jhash "file" current-file + "start" (car range) + "end" (cdr range)) + specs) + specs)))] + [else (loop (cdr lines) current-file specs)]))]))) + +(def (base-ref-diff args file project) + (let ([base (hash-get* args "base_ref" #f)]) + (if (and base (> (string-length base) 0)) + (guard (e [else ""]) + (let ([root (or project (repo-root))]) + (run-process + (append (list "git" "-C" root "diff" "--unified=0" base "--") + (if file (list file) '()))))) + ""))) + +(def (changed-line-specs args file project) + (let* ([explicit (seq->list (hash-get* args "changed_lines" #f))] + [diff (hash-get* args "diff" "")] + [base-diff (base-ref-diff args file project)]) + (append explicit + (if (> (string-length diff) 0) (diff-changed-line-specs diff) '()) + (if (> (string-length base-diff) 0) (diff-changed-line-specs base-diff) '())))) + (def (collect-security-findings files rules threshold max-findings) (let loop ([rest files] [acc '()] [scanned 0]) (cond @@ -1034,6 +1253,11 @@ (def project (hash-get* args "project_path" #f)) (def threshold (hash-get* args "severity_threshold" "low")) (def max-findings (hash-get* args "max_findings" 25)) + (def changed-filter? + (or (hash-get* args "changed_only" #f) + (hash-get* args "changed_lines" #f) + (hash-get* args "diff" #f) + (hash-get* args "base_ref" #f))) (def rules (load-json-file (data-path "security-rules.sexp") '())) (def extra (hash-get* args "rules_path" #f)) (when extra (set! rules (append rules (load-json-file extra '())))) @@ -1042,25 +1266,56 @@ [(null? rules) (text-result "No security rules loaded." #t)] [else (let* ([files (if file (list file) (scan-files project))] - [collected (collect-security-findings files rules threshold max-findings)] - [findings (hash-ref collected "findings")] - [scanned (hash-ref collected "scanned")] - [truncated (hash-ref collected "truncated")]) - (if (null? findings) - (text-result (string-append "Security scan: no findings in " (number->string scanned) - " scanned file(s).")) - (text-result (string-append "Security scan found " - (if truncated "at least " "") - (number->string (length findings)) - " finding(s) in " (number->string scanned) - " scanned file(s)" - (if truncated - (string-append " (stopped at max_findings=" - (number->string max-findings) - "; raise max_findings to continue)") - "") - ":\n\n" - (string-join findings "\n")))))])) + [specs (if changed-filter? (changed-line-specs args file project) '())]) + (if (and changed-filter? (null? specs)) + (text-result "Security scan changed-line filter requested, but no changed lines were provided. Pass changed_lines, diff, or base_ref." #t) + (let* ([collect-limit (if changed-filter? (max max-findings 1000) max-findings)] + [collected (collect-security-findings files rules threshold collect-limit)] + [all-findings (hash-ref collected "findings")] + [changed-findings (if changed-filter? + (filter (lambda (finding) + (finding-on-changed-line? specs finding)) + all-findings) + all-findings)] + [findings (take changed-findings (min max-findings (length changed-findings)))] + [changed-truncated (> (length changed-findings) max-findings)] + [total-before-filter (length all-findings)] + [outside-filter (- total-before-filter (length changed-findings))] + [scanned (hash-ref collected "scanned")] + [truncated (hash-ref collected "truncated")]) + (if (null? findings) + (text-result + (if changed-filter? + (string-append "Security scan: no changed-line findings in " + (number->string scanned) + " scanned file(s). Total findings before filter: " + (number->string total-before-filter) + "; outside changed lines: " + (number->string outside-filter) + (if truncated " (total count capped by internal changed-line scan limit)." "")) + (string-append "Security scan: no findings in " (number->string scanned) + " scanned file(s)."))) + (text-result + (string-append "Security scan found " + (if (or truncated changed-truncated) "at least " "") + (number->string (length findings)) + (if changed-filter? " changed-line" "") + " finding(s) in " (number->string scanned) + " scanned file(s)" + (if changed-filter? + (string-append " (" + (number->string total-before-filter) + " total before filter; " + (number->string outside-filter) + " outside changed lines)") + "") + (if (or truncated changed-truncated) + (string-append " (stopped at max_findings=" + (number->string max-findings) + "; raise max_findings to continue)") + "") + ":\n\n" + (string-join findings "\n")))))))])) (def (tool-run-tests args) (def file (hash-get* args "file_path" #f)) @@ -3462,6 +3717,88 @@ (def blocking-symbol-patterns '("sleep" "read" "write" "connect" "accept" "recv" "send" "waitpid" "poll" "select")) +(def variadic-libc-min-fixed-arity + '(("printf" . 1) + ("sprintf" . 2) + ("snprintf" . 3) + ("fprintf" . 2) + ("dprintf" . 2) + ("scanf" . 1) + ("sscanf" . 2) + ("fscanf" . 2) + ("fcntl" . 2) + ("open" . 2) + ("openat" . 3) + ("ioctl" . 2) + ("prctl" . 1) + ("syscall" . 1) + ("execl" . 2) + ("execlp" . 2) + ("execle" . 2))) + +(def (quoted-symbol-present? line sym) + (string-contains line (string-append "\"" sym "\""))) + +(def (variadic-symbol-hit line) + (let loop ([rest variadic-libc-min-fixed-arity]) + (cond + [(null? rest) #f] + [(quoted-symbol-present? line (caar rest)) (car rest)] + [else (loop (cdr rest))]))) + +(def (count-arity-token token) + (if (= (string-length (string-trim token)) 0) + 0 + (length (filter (lambda (part) (> (string-length part) 0)) + (string-split (string-trim token) #\space))))) + +(def (foreign-procedure-arity line sym) + (let* ([sym-pos (string-contains line (string-append "\"" sym "\""))] + [after (and sym-pos (+ sym-pos (string-length sym) 2))]) + (and after + (let loop ([i after]) + (cond + [(>= i (string-length line)) #f] + [(char=? (string-ref line i) #\() + (let ([end (string-index (substring line (+ i 1) (string-length line)) #\))]) + (and end + (count-arity-token + (substring line (+ i 1) (+ i 1 end)))))] + [else (loop (+ i 1))]))))) + +(def (scan-variadic-ffi-file file) + (let ([findings '()]) + (let loop ([lines (string-split (guard (e [else ""]) (read-file-string file)) #\newline)] + [line-no 1]) + (unless (null? lines) + (let* ([line (car lines)] + [hit (and (string-contains line "foreign-procedure") + (variadic-symbol-hit line))]) + (when hit + (let* ([sym (car hit)] + [fixed (cdr hit)] + [arity (foreign-procedure-arity line sym)]) + (when (or (not arity) (> arity fixed)) + (set! findings + (cons (string-append "variadic-ffi " file ":" + (number->string line-no) + " [" sym "] declared arity " + (if arity (number->string arity) "unknown") + " exceeds fixed prefix " + (number->string fixed) + "; wrap in a fixed-signature C shim or use a non-variadic API.") + findings))))) + (loop (cdr lines) (+ line-no 1))))) + (reverse findings))) + +(def (tool-variadic-ffi-check args) + (let ([files (files-from-args args '(".ss" ".scm"))]) + (if (null? files) + (text-result "file_path or project_path is required." #t) + (format-findings + "Variadic FFI check" + (apply append (map scan-variadic-ffi-file files)))))) + (def (tool-blocking-ffi-check args) (let ([files (files-from-args args '(".ss" ".scm"))]) (if (null? files) @@ -3932,6 +4269,14 @@ "List all exported symbols from a Jerboa module." (schema (list (list "module_path" (property "string" "Module path"))) '("module_path")) tool-module-exports #t '()) + (register-tool "jerboa_module_exists" "Module Exists" + "Check whether a module path exists in configured Jerboa libdirs without importing it." + (schema (list (list "module_path" (property "string" "Module path")) + (list "project_path" (property "string" "Project path for local libdirs")) + (list "extra_libdirs" (property "array" "Additional Scheme libdirs")) + (list "jerboa_home" (property "string" "Jerboa home"))) + '("module_path")) + tool-module-exists #t '("module_exists")) (register-tool "jerboa_function_signature" "Function Signature" "Check procedure arity information for a Jerboa function." (schema (list (list "symbol" (property "string" "Symbol name")) @@ -3960,7 +4305,11 @@ (schema (list (list "file_path" (property "string" "Single file")) (list "project_path" (property "string" "Project path")) (list "severity_threshold" (property "string" "Minimum severity")) - (list "max_findings" (property "number" "Maximum findings to return"))) + (list "max_findings" (property "number" "Maximum findings to return")) + (list "changed_only" (property "boolean" "Only report findings on changed lines")) + (list "changed_lines" (property "array" "Changed line numbers, ranges, or {file,start,end} objects")) + (list "diff" (property "string" "Unified diff used to derive changed lines")) + (list "base_ref" (property "string" "Git base ref used to derive changed lines"))) '()) tool-security-scan #t '()) (register-tool "jerboa_run_tests" "Run Tests" @@ -4503,6 +4852,12 @@ (list "project_path" (property "string" "Project path"))) '()) tool-blocking-ffi-check #f '()) + (register-tool "jerboa_variadic_ffi_check" "Variadic FFI Check" + "Scan foreign-procedure declarations for known variadic libc symbols declared with fixed arity." + (schema (list (list "file_path" (property "string" "File path")) + (list "project_path" (property "string" "Project path"))) + '()) + tool-variadic-ffi-check #f '("variadic_ffi_check")) (register-tool "jerboa_static_lso_guard_audit" "Static LSO Guard Audit" "Scan for top-level load-shared-object and foreign-procedure calls." (schema (list (list "file_path" (property "string" "File path")) --- a/mcp/test/protocol-test.ss +++ b/mcp/test/protocol-test.ss @@ -83,10 +83,20 @@ (def doc-file (path-join "/tmp" "jerboa-mcp2-doc.md")) (def security-rules-file (path-join "/tmp" "jerboa-mcp2-rules.sexp")) (def ffi-file (path-join "/tmp" "jerboa-mcp2-ffi.ss")) +(def variadic-file (path-join "/tmp" "jerboa-mcp2-variadic-ffi.ss")) +(def chez-reader-file (path-join "/tmp" "jerboa-mcp2-chez-reader.ss")) (def c-file (path-join "/tmp" "jerboa-mcp2-pointer.c")) (def bisect-file (path-join "/tmp" "jerboa-mcp2-bisect.ss")) (write-file-string doc-file "Done mcp/server.ss\n") (write-file-string ffi-file "(load-shared-object \"libx\")\n(def c-read (foreign-procedure \"read\" () int))\n(set! x 1)\n(system \"ls\")\n#\\escape\n") +(write-file-string variadic-file "(import (jerboa prelude))\n(def c-fcntl (foreign-procedure \"fcntl\" (int int int) int))\n") +(write-file-string + chez-reader-file + (string-append "#!chezscheme\n(library (tmp colon-reader) (export " + (string #\: #\?) + ") (import (chezscheme)) (define (" + (string #\: #\?) + " x) x))\n")) (write-file-string c-file "int f(char *p) { return strlen(p); }\n") (write-file-string bisect-file "(import (jerboa prelude))\n(def x 1)\n(+ x 2)\n") @@ -439,9 +449,22 @@ (call-tool 95 "jerboa_verify_changes" (alist->hash-table (list (cons "file_path" bisect-file) - (cons "project_path" repo-root))))))) + (cons "project_path" repo-root)))) + (call-tool 96 "jerboa_module_exists" + (alist->hash-table + (list (cons "module_path" "(std sort)")))) + (call-tool 97 "jerboa_verify" + (alist->hash-table + (list (cons "file_path" chez-reader-file)))) + (call-tool 98 "jerboa_security_scan" + (alist->hash-table + (list (cons "file_path" ffi-file) + (cons "changed_lines" (list 4))))) + (call-tool 99 "jerboa_variadic_ffi_check" + (alist->hash-table + (list (cons "file_path" variadic-file))))))) -(check "expected 95 responses" (= (length responses) 95)) +(check "expected 99 responses" (= (length responses) 99)) (def init-result (result (car responses))) (check "initialize server name" @@ -456,6 +479,8 @@ (check "tools/list includes error_fix_lookup" (has-tool? tools "jerboa_error_fix_lookup")) (check "tools/list includes security audit" (has-tool? tools "jerboa_security_audit")) (check "tools/list includes benchmark" (has-tool? tools "jerboa_benchmark")) +(check "tools/list includes module_exists" (has-tool? tools "jerboa_module_exists")) +(check "tools/list includes variadic ffi check" (has-tool? tools "jerboa_variadic_ffi_check")) (check "eval returns 3" (string-contains (content-text (result (list-ref responses 2))) "3")) @@ -739,5 +764,17 @@ (check "verify changes runs" (string-contains (content-text (result (list-ref responses 94))) "Verify changes summary")) +(check "module exists reports true" + (string-contains (content-text (result (list-ref responses 95))) "exists: true")) + +(check "verify autodetects chez reader" + (string-contains (content-text (result (list-ref responses 96))) "No issues found")) + +(check "security scan filters changed lines" + (string-contains (content-text (result (list-ref responses 97))) "changed-line finding")) + +(check "variadic ffi check finds fcntl" + (string-contains (content-text (result (list-ref responses 98))) "fcntl")) + (display "protocol-test: PASS") (newline)