Add run-process/exec for shell-injection-safe process execution (V6)
ober
90bfdc4f625dddeaa79945e857332b78cee751e8
--- a/lib/std/misc/process.sls +++ b/lib/std/misc/process.sls @@ -5,6 +5,7 @@ (export run-process run-process/batch + run-process/exec filter-with-process ;; Process ports (Gambit-compatible subprocess I/O) @@ -53,6 +54,38 @@ cmd))) (system full-cmd))) + (define (run-process/exec args . rest) + ;; Run a process WITHOUT shell interpolation. + ;; args: list of strings (command and arguments) + ;; Each argument is individually shell-quoted to prevent injection. + ;; No shell metacharacters are interpreted. + ;; Keywords: directory: path, stdin-data: string + (unless (and (list? args) (pair? args) (for-all string? args)) + (error 'run-process/exec "args must be a non-empty list of strings" args)) + (let* ([dir (extract-keyword rest 'directory: #f)] + [stdin-data (extract-keyword rest 'stdin-data: #f)] + ;; Each argument is individually quoted — no shell expansion + [cmd (string-join (map strict-shell-quote args) " ")] + [full-cmd (if dir + (string-append "cd " (strict-shell-quote dir) " && " cmd) + cmd)]) + (let-values ([(to-stdin from-stdout from-stderr pid) + (open-process-ports full-cmd 'line (native-transcoder))]) + (when stdin-data + (display stdin-data to-stdin) + (flush-output-port to-stdin)) + (close-port to-stdin) + (let ([output (read-all from-stdout)]) + (close-port from-stdout) + (close-port from-stderr) + output)))) + + (define (strict-shell-quote s) + ;; Strictly quote a string for shell: wrap in single quotes, + ;; escape embedded single quotes. This prevents ALL shell + ;; metacharacter interpretation. + (string-append "'" (string-replace-all s "'" "'\"'\"'") "'")) + (define (build-command-string args) (if (string? args) args new file mode 100644 --- /dev/null +++ b/tests/test-process-exec.ss @@ -0,0 +1,59 @@ +#!chezscheme +;;; test-process-exec.ss -- Tests for run-process/exec (shell-injection-safe) + +(import (chezscheme) (std misc process)) + +(define pass-count 0) +(define fail-count 0) + +(define-syntax check + (syntax-rules (=>) + [(_ expr => expected) + (let ([result expr] [exp expected]) + (if (equal? result exp) + (set! pass-count (+ pass-count 1)) + (begin + (set! fail-count (+ fail-count 1)) + (display "FAIL: ") (write 'expr) + (display " => ") (write result) + (display " expected ") (write exp) (newline))))])) + +;; Basic execution +(check (run-process/exec '("echo" "hello")) => "hello\n") + +;; Shell metacharacters NOT interpreted +(check (run-process/exec '("echo" "$(whoami)")) => "$(whoami)\n") +(check (run-process/exec '("echo" "`id`")) => "`id`\n") +(check (run-process/exec '("echo" "$HOME")) => "$HOME\n") +(check (run-process/exec '("echo" "a;b")) => "a;b\n") +(check (run-process/exec '("echo" "a|b")) => "a|b\n") +(check (run-process/exec '("echo" "a&&b")) => "a&&b\n") +(check (run-process/exec '("echo" "a>b")) => "a>b\n") + +;; Multiple arguments +(check (run-process/exec '("printf" "%s-%s\n" "x" "y")) => "x-y\n") + +;; Spaces in arguments preserved +(check (run-process/exec '("echo" "hello world")) => "hello world\n") + +;; Single quotes in arguments +(check (run-process/exec '("echo" "it's")) => "it's\n") + +;; Stdin data piping +(check (run-process/exec '("cat") 'stdin-data: "piped\n") => "piped\n") + +;; Rejects string args (must be list) +(check (guard (e [#t 'error]) (run-process/exec "echo hi")) => 'error) + +;; Rejects empty list +(check (guard (e [#t 'error]) (run-process/exec '())) => 'error) + +;; Rejects non-string elements +(check (guard (e [#t 'error]) (run-process/exec '("echo" 42))) => 'error) + +(display " process-exec: ") +(display pass-count) (display " passed") +(when (> fail-count 0) + (display ", ") (display fail-count) (display " failed")) +(newline) +(when (> fail-count 0) (exit 1))