expr: run group-match sed via direct argv exec (no shell)

ober

81e2ef2b1e53e42aef31b49e80f365b51deaf494

diff --git a/lib/jerboa-coreutils/expr.sls b/lib/jerboa-coreutils/expr.sls
index ca433f5..c4353aa 100644
--- a/lib/jerboa-coreutils/expr.sls
+++ b/lib/jerboa-coreutils/expr.sls
@@ -9,8 +9,9 @@
       getenv path-extension path-absolute? thread? make-mutex
       mutex? mutex-name)
     (only (std sugar) with-catch)
-    (only (std format) eprintf format) (jerboa-coreutils common)
-    (jerboa-coreutils common version)
+    (only (std format) eprintf format)
+    (only (std os aproc) aproc-run/status*)
+    (jerboa-coreutils common) (jerboa-coreutils common version)
     (jerboa-coreutils common security) (jerboa core)
     (jerboa runtime))
   (def (expr-error msg) (eprintf "expr: ~a\n" msg) (exit 2))
@@ -173,44 +174,48 @@
                             pattern
                             (string-append "^" pattern))]
               [has-group (string-contains-substr? pattern "\\(")])
-         (with-catch
-           (lambda (e) "0")
-           (lambda ()
-             (let ([cmd (string-append "printf '%s' " (shell-quote str) " | grep -oP "
-                          (shell-quote (bre->pcre anchored))
-                          " 2>/dev/null | head -1")])
-               (let-values ([(to-stdin from-stdout from-stderr pid)
-                             (open-process-ports
-                               cmd
-                               (buffer-mode block)
-                               (native-transcoder))])
-                 (close-port to-stdin)
-                 (let ([result (get-line from-stdout)])
-                   (close-port from-stdout)
-                   (close-port from-stderr)
-                   (if (or (not result) (eof-object? result))
-                       "0"
-                       (if has-group
-                           (do-match-with-group str anchored)
+         (if has-group
+             (do-match-with-group str anchored)
+             (with-catch
+               (lambda (e) "0")
+               (lambda ()
+                 (let ([cmd (string-append "printf '%s' " (shell-quote str)
+                              " | grep -oP "
+                              (shell-quote (bre->pcre anchored))
+                              " 2>/dev/null | head -1")])
+                   (let-values ([(to-stdin from-stdout from-stderr pid)
+                                 (open-process-ports
+                                   cmd
+                                   (buffer-mode block)
+                                   (native-transcoder))])
+                     (close-port to-stdin)
+                     (let ([result (get-line from-stdout)])
+                       (close-port from-stdout)
+                       (close-port from-stderr)
+                       (if (or (not result) (eof-object? result))
+                           "0"
                            (number->string (string-length result)))))))))))
   (def (do-match-with-group str pattern)
        (with-catch
          (lambda (e) "0")
          (lambda ()
-           (let ([cmd (string-append "printf '%s' " (shell-quote str) " | sed -n 's/"
-                        pattern "/\\1/p' 2>/dev/null")])
-             (let-values ([(to-stdin from-stdout from-stderr pid)
-                           (open-process-ports
-                             cmd
-                             (buffer-mode block)
-                             (native-transcoder))])
-               (close-port to-stdin)
-               (let ([result (get-line from-stdout)])
-                 (close-port from-stdout)
-                 (close-port from-stderr)
-                 (if (or (not result) (eof-object? result))
-                     ""
-                     result)))))))
+           (let-values ([(out err code)
+                         (aproc-run/status*
+                           (list
+                             "sed"
+                             "-n"
+                             (string-append "s/" pattern "/\\1/p"))
+                           'stdin: str 'stdout: 'capture 'stderr:
+                           'capture)])
+             (if (or (not out) (eof-object? out) (string=? out ""))
+                 ""
+                 (string-first-line out))))))
+  (def (string-first-line s)
+       (let loop ([i 0])
+         (cond
+           [(>= i (string-length s)) s]
+           [(eqv? (string-ref s i) #\newline) (substring s 0 i)]
+           [else (loop (+ i 1))])))
   (def (bre->pcre pattern)
        (let loop ([i 0] [acc '()])
          (if (>= i (string-length pattern))
diff --git a/src/jerboa-coreutils/expr.ss b/src/jerboa-coreutils/expr.ss
index 166fb1b..40a9b91 100644
--- a/src/jerboa-coreutils/expr.ss
+++ b/src/jerboa-coreutils/expr.ss
@@ -4,6 +4,7 @@
 
 (import (only-in :std/sugar with-catch)
         (only-in :std/format eprintf format)
+        (only-in :std/os/aproc aproc-run/status*)
         :jerboa-coreutils/common
         :jerboa-coreutils/common/version
         :jerboa-coreutils/common/security)
@@ -211,43 +212,48 @@
                      (string-append "^" pattern)))
          ;; Check if pattern has \( \) groups
          (has-group (string-contains-substr? pattern "\\(")))
-    (with-catch
-      (lambda (e) "0")
-      (lambda ()
-        ;; Use grep -o or sed to do BRE matching
-        (let ((cmd (string-append
-                     "printf '%s' " (shell-quote str)
-                     " | grep -oP " (shell-quote (bre->pcre anchored))
-                     " 2>/dev/null | head -1")))
-          (let-values (((to-stdin from-stdout from-stderr pid)
-                        (open-process-ports cmd (buffer-mode block) (native-transcoder))))
-            (close-port to-stdin)
-            (let ((result (get-line from-stdout)))
-              (close-port from-stdout)
-              (close-port from-stderr)
-              (if (or (not result) (eof-object? result))
-                "0"
-                (if has-group
-                  ;; Try to extract group match via sed
-                  (do-match-with-group str anchored)
+    (if has-group
+      ;; Group extraction runs sed directly (argv exec, no shell), so a
+      ;; hostile pattern is data to sed and never parsed by /bin/sh.
+      (do-match-with-group str anchored)
+      (with-catch
+        (lambda (e) "0")
+        (lambda ()
+          ;; Use grep -o to do BRE matching for the match-length case
+          (let ((cmd (string-append
+                       "printf '%s' " (shell-quote str)
+                       " | grep -oP " (shell-quote (bre->pcre anchored))
+                       " 2>/dev/null | head -1")))
+            (let-values (((to-stdin from-stdout from-stderr pid)
+                          (open-process-ports cmd (buffer-mode block) (native-transcoder))))
+              (close-port to-stdin)
+              (let ((result (get-line from-stdout)))
+                (close-port from-stdout)
+                (close-port from-stderr)
+                (if (or (not result) (eof-object? result))
+                  "0"
                   (number->string (string-length result)))))))))))
 
 (def (do-match-with-group str pattern)
   (with-catch
     (lambda (e) "0")
     (lambda ()
-      (let ((cmd (string-append
-                   "printf '%s' " (shell-quote str)
-                   " | sed -n 's/" pattern "/\\1/p' 2>/dev/null")))
-        (let-values (((to-stdin from-stdout from-stderr pid)
-                      (open-process-ports cmd (buffer-mode block) (native-transcoder))))
-          (close-port to-stdin)
-          (let ((result (get-line from-stdout)))
-            (close-port from-stdout)
-            (close-port from-stderr)
-            (if (or (not result) (eof-object? result))
-              ""
-              result)))))))
+      (let-values (((out err code)
+                    (aproc-run/status*
+                      (list "sed" "-n" (string-append "s/" pattern "/\\1/p"))
+                      'stdin: str
+                      'stdout: 'capture
+                      'stderr: 'capture)))
+        (if (or (not out) (eof-object? out) (string=? out ""))
+          ""
+          (string-first-line out))))))
+
+(def (string-first-line s)
+  (let loop ((i 0))
+    (cond
+      ((>= i (string-length s)) s)
+      ((eqv? (string-ref s i) #\newline) (substring s 0 i))
+      (else (loop (+ i 1))))))
 
 ;; Convert BRE to PCRE (simplified)
 (def (bre->pcre pattern)