fix: skip oversize files and detect ML training data to stop false positives

ober

2b27b281857defeb62994deba43790d8b2cd0781

diff --git a/gitsafe/config.ss b/gitsafe/config.ss
index ec04de5..7ba5ce9 100644
--- a/gitsafe/config.ss
+++ b/gitsafe/config.ss
@@ -9,6 +9,8 @@
           gitsafe-config-exclude-globs
           gitsafe-config-allowlist-files
           gitsafe-config-allowlist-strings
+          gitsafe-config-max-file-size-mb
+          gitsafe-config-ml-data-detection
           default-config
           load-config
           config-excluded?
@@ -29,13 +31,15 @@
 
   ;; --- Config struct ---
   (defstruct gitsafe-config
-    (severity           ;; symbol: 'low | 'medium | 'high | 'critical
-     entropy-enabled    ;; boolean
-     disabled-patterns  ;; list of symbols (pattern IDs to skip)
-     custom-patterns    ;; list of alists from JSON
-     exclude-globs      ;; list of glob strings
-     allowlist-files    ;; list of file paths
-     allowlist-strings  ;; list of literal strings known safe
+    (severity            ;; symbol: 'low | 'medium | 'high | 'critical
+     entropy-enabled     ;; boolean
+     disabled-patterns   ;; list of symbols (pattern IDs to skip)
+     custom-patterns     ;; list of alists from JSON
+     exclude-globs       ;; list of glob strings
+     allowlist-files     ;; list of file paths
+     allowlist-strings   ;; list of literal strings known safe
+     max-file-size-mb    ;; integer: skip files larger than this (0 = no limit)
+     ml-data-detection   ;; boolean: drop entropy patterns on ML-data shapes
      ))
 
   ;; --- Default configuration ---
@@ -50,6 +54,8 @@
         "node_modules/**" "*.min.js" "*.min.css")
       '()       ;; allowlist-files
       '()       ;; allowlist-strings
+      10        ;; max-file-size-mb
+      #t        ;; ml-data-detection
       ))
 
   ;; --- Glob matching ---
@@ -147,10 +153,18 @@
                [al-strs  (if allowlist-obj
                            (json->string-list
                              (hash-ref allowlist-obj "patterns" (vector)))
-                           '())])
+                           '())]
+               [max-mb   (let ([v (hash-ref obj "max_file_size_mb" 10)])
+                           (cond
+                             [(and (integer? v) (>= v 0)) v]
+                             [(and (real? v) (>= v 0))    (exact (round v))]
+                             [else                        10]))]
+               [ml-detect (let ([v (hash-ref obj "detect_ml_data" #t)])
+                            (if (boolean? v) v #t))])
           (make-gitsafe-config
             severity entropy disabled custom
-            excludes al-files al-strs))
+            excludes al-files al-strs
+            max-mb ml-detect))
         (catch (e)
           (displayln "gitsafe: warning: could not parse .gitsafe.json, using defaults")
           (default-config)))))
diff --git a/gitsafe/git.ss b/gitsafe/git.ss
index 893fe94..1b9e1ba 100644
--- a/gitsafe/git.ss
+++ b/gitsafe/git.ss
@@ -3,9 +3,11 @@
   (export staged-files
           staged-diff
           staged-content
+          staged-blob-size
           push-commits
           changed-files-in-range
           range-diff
+          range-blob-size
           git-repo?
           git-root
           make-diff-hunk
@@ -130,8 +132,15 @@
   ;; --- Public API ---
 
   ;; Returns #t if inside a git repository.
+  ;; Uses run-process (which captures stdout) instead of run-process/batch
+  ;; (which inherits parent stdio) so `git rev-parse --git-dir` doesn't
+  ;; leak `.git` to gitsafe's own stdout — observed in the pre-push hook.
   (def (git-repo?)
-    (= 0 (git-exit '("git" "rev-parse" "--git-dir"))))
+    (try
+      (let ([out (run-process '("git" "rev-parse" "--git-dir"))])
+        (and (string? out)
+             (not (string-empty? (string-trim out)))))
+      (catch (e) #f)))
 
   ;; Returns the absolute path to the repo root.
   (def (git-root)
@@ -159,6 +168,15 @@
       (run-process (list "git" "show" (string-append ":" path)))
       (catch (e) "")))
 
+  ;; Returns the size of the staged blob in bytes, or #f if unknown.
+  ;; Uses `git cat-file -s :path` which reads only the blob header,
+  ;; so callers can short-circuit before reading megabytes into memory.
+  (def (staged-blob-size path)
+    (let ([out (git-output (list "git" "cat-file" "-s"
+                                 (string-append ":" path)))])
+      (and (not (string-empty? out))
+           (string->number (string-trim out)))))
+
   ;; Returns list of commit SHAs being pushed (from remote-ref..local-ref).
   (def (push-commits local-ref remote-ref)
     (let ([range (string-append remote-ref ".." local-ref)])
@@ -176,4 +194,11 @@
   (def (range-diff from-ref to-ref path)
     (git-output (list "git" "diff" "-U0" from-ref to-ref "--" path)))
 
+  ;; Returns the size of the blob at to-ref for a file, or #f if unknown.
+  (def (range-blob-size to-ref path)
+    (let ([out (git-output (list "git" "cat-file" "-s"
+                                 (string-append to-ref ":" path)))])
+      (and (not (string-empty? out))
+           (string->number (string-trim out)))))
+
 ) ;; end library
diff --git a/gitsafe/main-binary.ss b/gitsafe/main-binary.ss
index 8561f92..d1290bc 100644
--- a/gitsafe/main-binary.ss
+++ b/gitsafe/main-binary.ss
@@ -222,7 +222,9 @@ Options:
                         (gitsafe-config-custom-patterns c)
                         (gitsafe-config-exclude-globs c)
                         (gitsafe-config-allowlist-files c)
-                        (gitsafe-config-allowlist-strings c)))])
+                        (gitsafe-config-allowlist-strings c)
+                        (gitsafe-config-max-file-size-mb c)
+                        (gitsafe-config-ml-data-detection c)))])
   (match mode
     ["install"    (cmd-install)]
     ["uninstall"  (cmd-uninstall)]
diff --git a/gitsafe/main.ss b/gitsafe/main.ss
index edd26b0..35f5427 100644
--- a/gitsafe/main.ss
+++ b/gitsafe/main.ss
@@ -242,7 +242,9 @@ Options:
                         (gitsafe-config-custom-patterns c)
                         (gitsafe-config-exclude-globs c)
                         (gitsafe-config-allowlist-files c)
-                        (gitsafe-config-allowlist-strings c)))])
+                        (gitsafe-config-allowlist-strings c)
+                        (gitsafe-config-max-file-size-mb c)
+                        (gitsafe-config-ml-data-detection c)))])
   (match mode
     ["install"    (cmd-install)]
     ["uninstall"  (cmd-uninstall)]
diff --git a/gitsafe/scanner.ss b/gitsafe/scanner.ss
index 02bdad7..66341bf 100644
--- a/gitsafe/scanner.ss
+++ b/gitsafe/scanner.ss
@@ -16,7 +16,8 @@
           scan-staged
           scan-push-range
           scan-files
-          skip-file?)
+          skip-file?
+          ml-training-data-content?)
   (import (except (chezscheme)
                   make-hash-table hash-table?
                   sort sort!
@@ -32,6 +33,7 @@
           (std misc string)
           (std misc ports)
           (std os path)
+          (only (std os path-util) file-size)
           (gitsafe patterns)
           (gitsafe entropy)
           (gitsafe config)
@@ -115,6 +117,77 @@
                (config-excluded? config path))
            #t)))
 
+  ;; --- ML training-data shape detection ---
+  ;; Recognises the four common LoRA/SFT on-disk formats: OpenAI chat,
+  ;; Alpaca, completion corpora, DPO/preference pairs, and legacy OpenAI
+  ;; SFT (prompt/completion). These files are mined from public sources
+  ;; and routinely contain example hashes (SHA256 test vectors, etc.)
+  ;; that trip the high-entropy-hex heuristic with zero secret value.
+  ;;
+  ;; The regexes require { directly before the key, so a config file
+  ;; that merely mentions "messages" in prose won't match.
+  (def *ml-shape-patterns*
+    (list (re "\\{[^{}]{0,200}\"messages\"\\s*:\\s*\\[")
+          (re "\\{[^{}]{0,200}\"instruction\"\\s*:")
+          (re "\\{[^{}]{0,200}\"text\"\\s*:")
+          (re "\\{[^{}]{0,200}\"chosen\"\\s*:")
+          (re "\\{[^{}]{0,200}\"chosen_response\"\\s*:")
+          (re "\\{[^{}]{0,200}\"prompt\"\\s*:[^{}]{0,400}\"completion\"\\s*:")))
+
+  (def *ml-sniff-bytes* 16384)
+
+  (def (ml-data-extension? path)
+    (let ([ext (path-extension path)])
+      (or (string=? ext ".json")
+          (string=? ext ".jsonl")
+          (string=? ext ".ndjson"))))
+
+  ;; Returns #t when PATH is a JSON/JSONL file whose first ~16 KB contains
+  ;; a recognisable ML training-data record shape. Cheap: stops as soon as
+  ;; any shape regex matches the prefix.
+  (def (ml-training-data-content? path content)
+    (and (ml-data-extension? path)
+         (let* ([len    (string-length content)]
+                [prefix (if (> len *ml-sniff-bytes*)
+                          (substring content 0 *ml-sniff-bytes*)
+                          content)])
+           (and (any (lambda (p) (re-search p prefix))
+                     *ml-shape-patterns*)
+                #t))))
+
+  ;; Returns #t when the added lines in HUNKS for a JSON/JSONL file contain
+  ;; an ML training-data record shape. Used for staged-diff scanning paths
+  ;; where we don't reconstruct the full blob. Scans at most ~50 added
+  ;; lines before giving up — enough to catch the common shapes without
+  ;; running every regex against an entire 230k-line diff.
+  (def (ml-training-data-hunks? path hunks)
+    (and (ml-data-extension? path)
+         (let outer ([hs hunks] [budget 50])
+           (cond
+             [(null? hs) #f]
+             [(<= budget 0) #f]
+             [else
+              (let inner ([lines (diff-hunk-lines (car hs))] [b budget])
+                (cond
+                  [(null? lines) (outer (cdr hs) b)]
+                  [(<= b 0) #f]
+                  [(any (lambda (p) (re-search p (cdr (car lines))))
+                        *ml-shape-patterns*)
+                   #t]
+                  [else (inner (cdr lines) (- b 1))]))]))))
+
+  ;; --- Pattern selection: drop noisy entropy patterns ---
+  ;; Used when scanning a file identified as ML training data. We keep
+  ;; precise high-severity patterns (AWS, GitHub PAT, JWT, …) so a real
+  ;; credential pasted into a dataset still trips an alert.
+  (def *entropy-pattern-ids*
+    '(high-entropy-hex high-entropy-base64))
+
+  (def (drop-entropy-patterns patterns)
+    (filter (lambda (p)
+              (not (member (secret-pattern-id p) *entropy-pattern-ids*)))
+            patterns))
+
   ;; --- Compiled patterns ---
   (def *hunk-header-re*
     (re "^@@ -[0-9,]+ \\+([0-9]+)(?:,[0-9]+)? @@"))
@@ -268,39 +341,83 @@
                               (loop (cdr pats) (cons f results)))))))))))
           ))))))
 
-  ;; --- Scan full file content (string) ---
+  ;; --- Scan with explicit pattern list ---
+  (def (scan-content/patterns file content patterns config)
+    (let loop ([lines (string-split content #\newline)]
+               [line-no 1]
+               [results '()])
+      (if (null? lines)
+        (reverse results)
+        (let ([findings (scan-line file line-no (car lines) patterns config)])
+          (loop (cdr lines)
+                (+ line-no 1)
+                (append results findings))))))
+
+  ;; --- Scan full file content (string), honouring ML-data sniffing ---
   (def (scan-content file content config)
-    (let ([patterns (active-patterns config)])
-      (let loop ([lines (string-split content #\newline)]
-                 [line-no 1]
-                 [results '()])
-        (if (null? lines)
-          (reverse results)
-          (let ([findings (scan-line file line-no (car lines) patterns config)])
-            (loop (cdr lines)
-                  (+ line-no 1)
-                  (append results findings)))))))
+    (let ([base (active-patterns config)])
+      (scan-content/patterns
+        file content
+        (if (and (gitsafe-config-ml-data-detection config)
+                 (ml-training-data-content? file content))
+          (drop-entropy-patterns base)
+          base)
+        config)))
+
+  ;; --- Stderr warning helper ---
+  (def (warn-skipped-large path size-mb limit-mb)
+    (let ([p (current-error-port)])
+      (display "gitsafe: skipping " p)
+      (display path p)
+      (display " (" p)
+      (display size-mb p)
+      (display " MB > " p)
+      (display limit-mb p)
+      (display " MB limit; set max_file_size_mb in .gitsafe.json to scan)" p)
+      (newline p)))
+
+  ;; Returns #t when size in bytes exceeds the configured per-file cap.
+  ;; A configured cap of 0 means "no limit".
+  (def (over-size-limit? size-bytes config)
+    (let ([limit-mb (gitsafe-config-max-file-size-mb config)])
+      (and (> limit-mb 0)
+           size-bytes
+           (> size-bytes (* limit-mb 1024 1024)))))
+
+  (def (bytes->mb-rounded n)
+    ;; Round up to the next MB for the warning message.
+    (quotient (+ n (- (* 1024 1024) 1)) (* 1024 1024)))
 
   ;; --- Scan diff hunks (added lines only) ---
+  ;; Callers (scan-staged, scan-push-range) only ever pass hunks belonging
+  ;; to a single file, so we can sniff the first hunk for the path.
   (def (scan-diff-hunks hunks config)
-    (let ([patterns (active-patterns config)])
-      (apply append
-        (map (lambda (hunk)
-               (apply append
-                 (map (lambda (line-pair)
-                        (scan-line
-                          (diff-hunk-file hunk)
-                          (car line-pair)
-                          (cdr line-pair)
-                          patterns
-                          config))
-                      (diff-hunk-lines hunk))))
-             hunks))))
+    (if (null? hunks)
+      '()
+      (let* ([file     (diff-hunk-file (car hunks))]
+             [base     (active-patterns config)]
+             [patterns (if (and (gitsafe-config-ml-data-detection config)
+                                (ml-training-data-hunks? file hunks))
+                         (drop-entropy-patterns base)
+                         base)])
+        (apply append
+          (map (lambda (hunk)
+                 (apply append
+                   (map (lambda (line-pair)
+                          (scan-line
+                            (diff-hunk-file hunk)
+                            (car line-pair)
+                            (cdr line-pair)
+                            patterns
+                            config))
+                        (diff-hunk-lines hunk))))
+               hunks)))))
 
   ;; --- Top-level: scan staged changes (pre-commit mode) ---
   (def (scan-staged config)
     (let ([files (staged-files)]
-          [ignore-pats (load-ignorefile)])
+          [ignore-pats (load-ignorefile)]
+          [limit-mb (gitsafe-config-max-file-size-mb config)])
       ;; Phase 1: collect git data sequentially to avoid index lock contention
       ;; when many files are staged (parallel git processes fight over the lock).
       (let ([work-items
@@ -309,6 +426,14 @@
                  (cond
                    [(skip-file? path config) #f]
                    [(ignored-file? path ignore-pats) #f]
+                   [(let ([sz (staged-blob-size path)])
+                      (and (over-size-limit? sz config)
+                           (begin
+                             (warn-skipped-large path
+                               (bytes->mb-rounded sz)
+                               limit-mb)
+                             #t)))
+                    #f]
                    [else
                     (let ([hunks (staged-diff path)])
                       (if (null? hunks)
@@ -333,7 +458,8 @@
   ;; --- Top-level: scan push range ---
   (def (scan-push-range local-ref remote-ref config)
     (let ([commits (push-commits local-ref remote-ref)]
-          [ignore-pats (load-ignorefile)])
+          [ignore-pats (load-ignorefile)]
+          [limit-mb (gitsafe-config-max-file-size-mb config)])
       (if (null? commits)
         '()
         ;; Scan diff of the entire range
@@ -345,6 +471,14 @@
                      (cond
                        [(skip-file? path config) #f]
                        [(ignored-file? path ignore-pats) #f]
+                       [(let ([sz (range-blob-size local-ref path)])
+                          (and (over-size-limit? sz config)
+                               (begin
+                                 (warn-skipped-large path
+                                   (bytes->mb-rounded sz)
+                                   limit-mb)
+                                 #t)))
+                        #f]
                        [else
                         (let ([diff-text (range-diff remote-ref local-ref path)])
                           (if (string-empty? diff-text)
@@ -407,16 +541,31 @@
 
   ;; --- Top-level: scan specific files ---
   (def (scan-files paths config)
-    (let ([ignore-pats (load-ignorefile)])
-      (pmap-files
-        (lambda (path)
-          (cond
-            [(not (file-exists? path)) '()]
-            [(skip-file? path config) '()]
-            [(ignored-file? path ignore-pats) '()]
-            [else
-             (let ([content (read-file-string path)])
-               (scan-content path content config))]))
-        paths)))
+    (let ([ignore-pats (load-ignorefile)]
+          [limit-mb (gitsafe-config-max-file-size-mb config)])
+      ;; Phase 1: filter by size sequentially so warnings don't interleave
+      ;; with each other across pmap threads.
+      (let ([to-scan
+             (filter
+               (lambda (path)
+                 (cond
+                   [(not (file-exists? path)) #f]
+                   [(skip-file? path config) #f]
+                   [(ignored-file? path ignore-pats) #f]
+                   [(let ([sz (file-size path)])
+                      (and (over-size-limit? sz config)
+                           (begin
+                             (warn-skipped-large path
+                               (bytes->mb-rounded sz)
+                               limit-mb)
+                             #t)))
+                    #f]
+                   [else #t]))
+               paths)])
+        (pmap-files
+          (lambda (path)
+            (let ([content (read-file-string path)])
+              (scan-content path content config)))
+          to-scan))))
 
 ) ;; end library
diff --git a/test/test-gitsafe.ss b/test/test-gitsafe.ss
index 22e606f..6c4572d 100644
--- a/test/test-gitsafe.ss
+++ b/test/test-gitsafe.ss
@@ -225,7 +225,8 @@
 
     (test-case "allowlisted?: matches allowlist strings"
       (let ([c (make-gitsafe-config
-                 'medium #t '() '() '() '() '("EXAMPLE_KEY" "fake_secret"))])
+                 'medium #t '() '() '() '() '("EXAMPLE_KEY" "fake_secret")
+                 10 #t)])
         (check-equal? #t (allowlisted? "EXAMPLE_KEY_12345" c))
         (check-equal? #f (allowlisted? "sk-ant-realkey" c))))
 
@@ -357,7 +358,91 @@
   ))
 
 ;; ============================================================
+;; ML training-data detection
+;; ============================================================
+
+(def suite-ml-detect
+  (test-suite "ml-data-detection"
+
+    (test-case "openai chat (.jsonl): first record detected"
+      (check-equal? #t
+        (ml-training-data-content? "training_data_together.jsonl"
+          "{\"messages\":[{\"role\":\"user\",\"content\":\"hi\"}]}\n")))
+
+    (test-case "alpaca (.jsonl): instruction key detected"
+      (check-equal? #t
+        (ml-training-data-content? "data_alpaca.jsonl"
+          "{\"instruction\":\"...\",\"input\":\"\",\"output\":\"...\"}\n")))
+
+    (test-case "alpaca (.json): array-of-records detected via prefix"
+      (check-equal? #t
+        (ml-training-data-content? "data.json"
+          "[\n  {\"instruction\":\"hash a string\",\"input\":\"\",\"output\":\"b94d27\"}\n]")))
+
+    (test-case "completion corpus (.jsonl): text key detected"
+      (check-equal? #t
+        (ml-training-data-content? "cpt_corpus.jsonl"
+          "{\"text\":\";; FILE: foo.ss\\n;; hash = b94d27b9...\"}")))
+
+    (test-case "dpo pairs: chosen key detected"
+      (check-equal? #t
+        (ml-training-data-content? "dpo_pairs.jsonl"
+          "{\"chosen\":\"...\",\"rejected\":\"...\"}\n")))
+
+    (test-case "dpo pairs: chosen_response key detected"
+      (check-equal? #t
+        (ml-training-data-content? "preferences.jsonl"
+          "{\"system\":\"x\",\"chosen_response\":\"...\",\"rejected_response\":\"...\"}\n")))
+
+    (test-case "regular json config not flagged as ML data"
+      (check-equal? #f
+        (ml-training-data-content? "config.json"
+          "{\"api_key\":\"abc\",\"endpoint\":\"https://example.com\"}\n")))
+
+    (test-case "non-json extension is never ML data"
+      (check-equal? #f
+        (ml-training-data-content? "notes.txt"
+          "{\"messages\":[{\"role\":\"user\"}]}\n")))
+
+    (test-case "scan-content: hash example in ML jsonl is suppressed"
+      ;; The canonical SHA256 of "hello world" appears in this Alpaca-format
+      ;; record; without ML detection it would trip high-entropy-hex.
+      (let* ([c   (default-config)]
+             [content "{\"instruction\":\"hash hello world\",\"input\":\"\",\"output\":\"b94d27b9934d3e08a52e52d7da7dabfac484efe04294e576fbc9a08f\"}\n"]
+             [findings (scan-content "data.jsonl" content c)]
+             [entropy (filter (lambda (f)
+                                (member (finding-pattern-id f)
+                                        '(high-entropy-hex high-entropy-base64)))
+                              findings)])
+        (check-equal? '() entropy)))
+
+    (test-case "scan-content: real AKIA key in ML jsonl still fires"
+      ;; ML detection must NOT blanket-skip high-severity patterns.
+      (let* ([c   (default-config)]
+             [content "{\"instruction\":\"x\",\"output\":\"AKIAIOSFODNN7EXAMPLE\"}\n"]
+             [findings (scan-content "data.jsonl" content c)]
+             [aws (filter (lambda (f)
+                            (eq? (finding-pattern-id f) 'aws-access-key))
+                          findings)])
+        (check-predicate aws pair?)))
+
+    (test-case "ml-data-detection: disabled in config keeps entropy scan on"
+      (let* ([c   (make-gitsafe-config
+                    'medium #t '() '() '() '() '()
+                    10 #f)]  ;; ml-data-detection: #f
+             [content "{\"text\":\";; b94d27b9934d3e08a52e52d7da7dabfac484efe04294e576fbc9a08f...\"}"]
+             [findings (scan-content "corpus.jsonl" content c)]
+             [entropy (filter (lambda (f)
+                                (member (finding-pattern-id f)
+                                        '(high-entropy-hex high-entropy-base64)))
+                              findings)])
+        (check-predicate entropy pair?)))
+
+  ))
+
+;; ============================================================
 ;; Run all suites
 ;; ============================================================
 
-(run-tests! suite-entropy suite-patterns suite-config suite-allowlist suite-scanner)
+(run-tests! suite-entropy suite-patterns suite-config suite-allowlist
+            suite-scanner suite-ml-detect)