Implement command line quoting

This commit is contained in:
Lassi Kortela 2020-03-19 08:24:33 +02:00
parent b1d5956567
commit b06fbba540
3 changed files with 134 additions and 0 deletions

command-line-test.scm Normal file
View File

@ -0,0 +1,56 @@
(import (scheme base) (command-line) (srfi 64))
(test-begin "command-line")
(define (esc-char char)
(case char
((#\B) #\\)
((#\Q) #\")
(else char)))
(define (esc s) (string-map esc-char s))
(define examples
(posix "")
(windows ""))
((args "foo")
(posix "foo")
(windows "foo"))
((args "-+foo/bar@baz.qux")
(posix "-+foo/bar@baz.qux")
(windows "-+foo/bar@baz.qux"))
((args "foo" "hello world" "bar")
(posix "foo Qhello worldQ bar")
(windows "foo Qhello worldQ bar"))
((args "foo" "helloBworld" "bar")
(posix "foo QhelloBBworldQ bar")
(windows "foo QhelloBworldQ bar"))
((args "argument1" "argument 2" "BsomeBpath withBspaces")
(posix "argument1 Qargument 2Q QBBsomeBBpath withBBspacesQ")
(windows "argument1 Qargument 2Q QBsomeBpath withBspacesQ"))
((args "argument1" "she said, Qyou had me at helloQ" "BsomeBpath withBspaces")
"argument1 Qshe said, BQyou had me at helloBQQ QBBsomeBBpath withBBspacesQ")
"argument1 Qshe said, BQyou had me at helloBQQ QBsomeBpath withBspacesQ"))
((args "argument1" "argumentQ2" "argument3" "argument4")
(posix "argument1 QargumentBQ2Q argument3 argument4")
(windows "argument1 QargumentBQ2Q argument3 argument4"))
((args "foo" "helloBworld" "bar")
(posix "foo QhelloBBworldQ bar")
(windows "foo QhelloBworldQ bar"))
((args "BsomeBdirectory withBspacesB")
(posix "QBBsomeBBdirectory withBBspacesBBQ")
(windows "QBsomeBdirectory withBspacesBBQ"))))
(lambda (example)
(let ((args (map esc (cdr (assoc 'args example))))
(posix (esc (cadr (assoc 'posix example))))
(windows (esc (cadr (assoc 'windows example)))))
(test-equal "posix" posix (join-posix-command-line args))
(test-equal "windows" windows (join-windows-command-line args))))

command-line.scm Normal file
View File

@ -0,0 +1,73 @@
(define (with-input-from-string string proc)
(open-input-string string)
(lambda (port)
(parameterize ((current-input-port port))
(define (with-output-to-string proc)
(lambda (port)
(parameterize ((current-output-port port))
(proc) (get-output-string port)))))
(define (safe-without-quotes? arg)
(define (safe-char? char)
(case char
((#\_ #\- #\+ #\/ #\@ #\.) #t)
(else (or (char<=? #\0 char #\9)
(char<=? #\A char #\Z)
(char<=? #\a char #\z)))))
(and (not (= 0 (string-length arg)))
(with-input-from-string arg
(lambda ()
(let loop ()
(let ((char (read-char)))
(or (eof-object? char) (and (safe-char? char) (loop)))))))))
(define (join-command-line double-quote args)
(if (null? args) ""
(lambda ()
(let loop ((args args))
(let ((arg (car args)))
(if (safe-without-quotes? arg)
(write-string arg)
(begin (write-char #\")
(with-input-from-string arg double-quote)
(write-char #\")))
(unless (null? (cdr args))
(write-char #\space)
(loop (cdr args)))))))))
(define (double-quote-posix)
(let loop ()
(let ((char (read-char)))
(unless (eof-object? char)
(case char ((#\\ #\" #\` #\$ #\newline) (write-char #\\)))
(write-char char)
(define (double-quote-windows)
(define (write-backslashes n) (write-string (make-string n #\\)))
(let loop ((backslashes 0))
(let ((char (read-char)))
(cond ((eqv? #\\ char)
(loop (+ backslashes 1)))
((eof-object? char)
(write-backslashes (* 2 backslashes)))
((char=? #\" char)
(write-backslashes (+ 1 (* 2 backslashes)))
(write-char char)
(loop 0))
(write-backslashes backslashes)
(write-char char)
(loop 0))))))
(define (join-posix-command-line args)
(join-command-line double-quote-posix args))
(define (join-windows-command-line args)
(join-command-line double-quote-windows args))

command-line.sld Normal file
View File

@ -0,0 +1,5 @@
(define-library (command-line)
(export join-posix-command-line
(import (scheme base))
(include "command-line.scm"))