replace ESCAPE-SH-TOKEN and ESCAPE-SH-COMMAND with new SH-ESCAPE

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

16 files changed, 38 insertions, 48 deletions

diff --git a/src/connection.lisp b/src/connection.lisp
index d5d1618..a6c9fdc 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -121,7 +121,7 @@ time savings add up."))
 
 (defmethod connection-readfile-and-remove ((connection connection) path)
   (prog1 (connection-readfile connection path)
-    (connection-run connection (strcat "rm " (escape-sh-token path)) nil)))
+    (connection-run connection (strcat "rm " (sh-escape path)) nil)))
 
 ;; only functional difference between WRITEFILE and UPLOAD is what args they
 ;; take: a string vs. a path.  for a given connection type, they may have same
@@ -296,7 +296,7 @@ which will be cleaned up when BODY is finished."
                           :connection ,connection)))
        (unwind-protect (progn ,@body)
          (connection-run ,connection
-                         (format nil "rm -f ~A" (escape-sh-token ,file))
+                         (format nil "rm -f ~A" (sh-escape ,file))
                          nil)))))
 
 (defun mkstemp-cmd (&optional template
@@ -394,12 +394,12 @@ the working directory of the Lisp process using UIOP:WITH-CURRENT-DIRECTORY."
                          (ensure-list arg))))
            while args
            finally (nreversef cmd))
-     (setq cmd (if (cdr cmd) (escape-sh-command cmd) (car cmd)))
+     (setq cmd (if (cdr cmd) (sh-escape cmd) (car cmd)))
      (loop while env
            for k = (string-upcase (symbol-name (pop env)))
            for v = (pop env)
            if v
-             collect (format nil "export ~A=~A" k (escape-sh-token v))
+             collect (format nil "export ~A=~A" k (sh-escape v))
                into accum
            else
              collect (format nil "unset -v ~A" k) into accum
@@ -422,10 +422,10 @@ the working directory of the Lisp process using UIOP:WITH-CURRENT-DIRECTORY."
      ;; simplicity, particularly to avoid having to check whether the connattr
      ;; is set yet, because setting it requires working CONNECTION-RUN.
      (setq cmd (format nil "export HOME=~A; cd ~A; ~A"
-                       (escape-sh-token (drop-trailing-slash
-                                         (unix-namestring
-                                          (get-connattr :remote-home))))
-                       (escape-sh-token (unix-namestring (pwd)))
+                       (sh-escape (drop-trailing-slash
+                                   (unix-namestring
+                                    (get-connattr :remote-home))))
+                       (sh-escape (pwd))
                        cmd))
      ,@forms))
 
@@ -472,7 +472,7 @@ case return only the exit code."
                (when stdout
                  (connection-run
                   *connection*
-                  (format nil "rm -f ~A" (escape-sh-token stdout))
+                  (format nil "rm -f ~A" (sh-escape stdout))
                   nil)))))
         (informat 4 "~&RUN ~A"
                   (if (> *consfigurator-debug-level* 4) wrapped cmd))
@@ -537,7 +537,7 @@ subclass to the :HOSTATTRS subroutine of properties calling this."
 
 (defun empty-remote-directory (directory)
   "Recursively delete the contents of DIRECTORY, but not DIRECTORY itself."
-  (alet (escape-sh-token (drop-trailing-slash (unix-namestring directory)))
+  (alet (sh-escape (drop-trailing-slash (unix-namestring directory)))
     (mrun (format nil "rm -rf -- ~A/* ~A/.[!.]* ~A/..?*" it it it))))
 
 (defun remote-exists-p (&rest paths)
@@ -649,7 +649,7 @@ specification of POSIX ls(1))."
                 (uid (elt groups 3))
                 (gid (elt groups 4)))
             (connection-writefile *connection* namestring content mode)
-            (let ((namestring (escape-sh-token namestring)))
+            (let ((namestring (sh-escape namestring)))
               (unless mode-supplied-p
                 ;; assume that if we can write it we can chmod it
                 (mrun #?"chmod u=${umode},g=${gmode},o=${omode} ${namestring}"))
diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp
index aeae134..aae0ad5 100644
--- a/src/connection/chroot.lisp
+++ b/src/connection/chroot.lisp
@@ -145,8 +145,7 @@ should be the mount point, without the chroot's root prefixed.")
 
 (defmethod connection-shell-wrap ((connection shell-chroot-connection) cmd)
   (format nil "chroot ~A sh -c ~A"
-          (escape-sh-token (unix-namestring (slot-value connection 'into)))
-          (escape-sh-token cmd)))
+          (sh-escape (slot-value connection 'into)) (sh-escape cmd)))
 
 (defmethod connection-teardown :before ((connection shell-chroot-connection))
   (dolist (mount (chroot-mounts connection))
diff --git a/src/connection/linux-namespace.lisp b/src/connection/linux-namespace.lisp
index 498cad9..a6f2e0a 100644
--- a/src/connection/linux-namespace.lisp
+++ b/src/connection/linux-namespace.lisp
@@ -84,7 +84,7 @@
     (format
      nil
      "nsenter ~@[-S ~D ~]~@[-G ~D ~]-at ~D env -i ~{~A~^ ~} sh -c ~A"
-     uid gid pid (mapcar #'escape-sh-token env) (escape-sh-token cmd))))
+     uid gid pid (mapcar #'sh-escape env) (sh-escape cmd))))
 
 (defmethod establish-connection
     ((type (eql :nsenter)) remaining &key name pid uid gid)
diff --git a/src/connection/shell-wrap.lisp b/src/connection/shell-wrap.lisp
index 49cfd83..2867e20 100644
--- a/src/connection/shell-wrap.lisp
+++ b/src/connection/shell-wrap.lisp
@@ -28,7 +28,7 @@
 
 (defun %readfile (c path &optional delete)
   (multiple-value-bind (out exit)
-      (let* ((path (escape-sh-token path))
+      (let* ((path (sh-escape path))
              (base #?"test -r ${path} && cat ${path}")
              (cmd (if delete (strcat base #?" && rm ${path}") base)))
         (connection-run c cmd nil))
@@ -57,7 +57,7 @@ mv \"$tmpf\" ~A"
            (mkstemp-cmd
             (merge-pathnames "tmp.XXXXXX" (pathname-directory-pathname path)))
            mode
-           (escape-sh-token (unix-namestring path)))))
+           (sh-escape path))))
     (multiple-value-bind (out exit) (connection-run conn cmd content)
       (unless (zerop exit)
         (error "Failed to write ~A: ~A" path out)))))
diff --git a/src/connection/ssh.lisp b/src/connection/ssh.lisp
index f4d30cc..1154578 100644
--- a/src/connection/ssh.lisp
+++ b/src/connection/ssh.lisp
@@ -46,4 +46,4 @@
   ;; wrap in 'sh -c' in case the login shell is not POSIX
   (format nil "ssh ~A ~A"
           (ssh-host connection)
-          (escape-sh-token (format nil "sh -c ~A" (escape-sh-token cmd)))))
+          (sh-escape (format nil "sh -c ~A" (sh-escape cmd)))))
diff --git a/src/connection/su.lisp b/src/connection/su.lisp
index 785302f..bd6657f 100644
--- a/src/connection/su.lisp
+++ b/src/connection/su.lisp
@@ -32,5 +32,4 @@
 ;; argument to su(1) on, e.g., FreeBSD.  So this should be fairly portable.
 (defmethod connection-shell-wrap ((connection su-connection) cmd)
   (format nil "su ~A -c ~A"
-          (escape-sh-token (slot-value connection 'user))
-          (escape-sh-token cmd)))
+          (sh-escape (slot-value connection 'user)) (sh-escape cmd)))
diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp
index da50673..486c8eb 100644
--- a/src/connection/sudo.lisp
+++ b/src/connection/sudo.lisp
@@ -79,7 +79,7 @@
          (user (connection-connattr connection :remote-user))
          (prefix (if file
                      (format nil "cat ~A - | sudo -HkS --prompt=\"\""
-                             (escape-sh-token file))
+                             (sh-escape file))
                      "sudo -Hkn")))
     ;; Wrap in sh -c so that it is more likely we are either asked for a
     ;; password for all our commands or not asked for one for any.
@@ -94,4 +94,4 @@
     (mrun :may-fail :input input
           (format nil
                   "~A ~:[~;--preserve-env=SSH_AUTH_SOCK ~]--user=~A sh -c ~A"
-                  prefix (string= user "root") user (escape-sh-token cmd)))))
+                  prefix (string= user "root") user (sh-escape cmd)))))
diff --git a/src/data.lisp b/src/data.lisp
index 1b74338..307d0c1 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -307,8 +307,7 @@ implementation."))
                    (let ((destfile (strcat destfile ".gz")))
                      (with-temporary-file (:pathname tmp)
                        (run-program
-                        (strcat "gzip -c " (escape-sh-token source))
-                        :output tmp)
+                        (strcat "gzip -c " (sh-escape source)) :output tmp)
                        (upload tmp destfile)
                        (mrun "gunzip" destfile)))
                    (upload source destfile)))))))))
@@ -370,11 +369,10 @@ CONTINUE-DEPLOY* or CONTINUE-DEPLOY*-PROGRAM."
           else do (error 'missing-data :iden1 iden1 :iden2 iden2))))
 
 (defun try-get-file-mime-type (file)
-  (handler-case (stripln (run-program
-                          (escape-sh-command (list "file" "-E"
-                                                   "--mime-type" "--brief"
-                                                   (unix-namestring file)))
-                          :output :string))
+  (handler-case (stripln
+                 (run-program
+                  (sh-escape `("file" "-E" "--mime-type" "--brief" ,file))
+                  :output :string))
     (subprocess-error () nil)))
 
 (defun sort-prerequisite-data-cache (cache)
diff --git a/src/data/pgp.lisp b/src/data/pgp.lisp
index 90e046b..ef258d3 100644
--- a/src/data/pgp.lisp
+++ b/src/data/pgp.lisp
@@ -54,8 +54,7 @@
   (handler-case
       (safe-read-from-string
        (run-program
-        (escape-sh-command (list "gpg" "--decrypt" (unix-namestring location)))
-        :output :string))
+        (sh-escape (list "gpg" "--decrypt" location)) :output :string))
     (subprocess-error (error)
       (missing-data-source "While attempt to decrypt, gpg exited with ~A"
 			   (uiop:subprocess-error-code error)))))
diff --git a/src/package.lisp b/src/package.lisp
index 82d237b..676ea3b 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -117,8 +117,7 @@
            #:define-print-object-for-structlike
            #:chroot-pathname
            #:in-chroot-pathname
-           #:escape-sh-token
-           #:escape-sh-command
+           #:sh-escape
            #:defpackage-consfig
            #:lambda-ignoring-args
            #:parse-cidr
diff --git a/src/property/cmd.lisp b/src/property/cmd.lisp
index 1f46b60..bc9fd80 100644
--- a/src/property/cmd.lisp
+++ b/src/property/cmd.lisp
@@ -31,7 +31,7 @@ Keyword argument :ENV is a plist of environment variables to be set when
 running the command, using env(1)."
   (:desc (loop for arg in args
                if (stringp arg)
-                 collect (escape-sh-token arg) into accum
+                 collect (sh-escape arg) into accum
                else collect (prin1-to-string arg) into accum
                finally (return (format nil "~{~A~^ ~}" accum))))
   (:apply (apply #'mrun args)))
diff --git a/src/property/cron.lisp b/src/property/cron.lisp
index 3a1343a..959f190 100644
--- a/src/property/cron.lisp
+++ b/src/property/cron.lisp
@@ -41,7 +41,7 @@ The output of the cronjob will be mailed only if the job exits nonzero."
          (job (merge-pathnames (string->filename desc) dir))
          (script (merge-pathnames (strcat (string->filename desc) "_cronjob")
                                   #P"/usr/local/bin/"))
-         (script* (escape-sh-token (unix-namestring script))))
+         (script* (sh-escape script)))
     `(with-unapply
       (apt:service-installed-running "cron")
       (apt:installed "moreutils")
@@ -67,8 +67,7 @@ The output of the cronjob will be mailed only if the job exits nonzero."
            ;; Use flock(1) to ensure that only one instance of the job is ever
            ;; running, no matter how long one run of the job takes.
            ,(format nil "flock -n ~A sh -c ~A"
-                    (escape-sh-token (unix-namestring job))
-                    (escape-sh-token shell-command)))
+                    (sh-escape job) (sh-escape shell-command)))
         :mode #o755)
        :unapply (file:does-not-exist ,job ,script))))
 
@@ -76,7 +75,7 @@ The output of the cronjob will be mailed only if the job exits nonzero."
   "Like CRON:SYSTEM-JOB, but run the command niced and ioniced."
   (:desc #?"Cronned ${desc}, niced and ioniced")
   (system-job desc when user (format nil "nice ionice -c 3 sh -c ~A"
-                                     (escape-sh-token shell-command))))
+                                     (sh-escape shell-command))))
 
 (defproplist runs-consfigurator :lisp (when)
   "Re-execute the most recent deployment that included an application of this
diff --git a/src/property/file.lisp b/src/property/file.lisp
index 26ce4a1..d9ca42a 100644
--- a/src/property/file.lisp
+++ b/src/property/file.lisp
@@ -430,8 +430,7 @@ commented out; the first commented or uncommented line for each key will be
 uncommented and used to set the value, if it exists."
   (:desc (format nil "~A has ~{~A=~S~^, ~}" file pairs))
   (:apply (simple-conf-update file (loop for (k v) on pairs by #'cddr
-                                         collect k
-                                         collect (escape-sh-token v))
+                                         collect k collect (sh-escape v))
                               ;; include quoting as part of the value so we
                               ;; don't end up substituting double quotation
                               ;; marks for single, or similar
diff --git a/src/property/installer.lisp b/src/property/installer.lisp
index 5a120f9..64d76e1 100644
--- a/src/property/installer.lisp
+++ b/src/property/installer.lisp
@@ -191,7 +191,7 @@ using a combinator like ON-CHANGE, or applied manually with DEPLOY-THESE."
                           if (pathnamep arg)
                             collect (unix-namestring arg)
                           else collect arg)
-                (foreign-funcall "system" :string (escape-sh-command it) :int)))
+                (foreign-funcall "system" :string (sh-escape it) :int)))
             (preservedp (pathname)
               (member pathname preserved-directories :test #'pathname-equal)))
        (mount:assert-devtmpfs-udev-/dev)
diff --git a/src/property/libvirt.lisp b/src/property/libvirt.lisp
index 967d76c..fff40d1 100644
--- a/src/property/libvirt.lisp
+++ b/src/property/libvirt.lisp
@@ -87,7 +87,7 @@ subcommand of virsh(1) to convert the running domain into a transient domain."
        nil
        "virt-install --print-xml -n ~A~:[~; --os-variant=~:*~A~]~{ ~A~} >~S"
        (get-hostname host) (os-variant host)
-       (mapcar #'escape-sh-token arguments) file))
+       (mapcar #'sh-escape arguments) file))
      (mrun "virsh" "define" file)))
   (:unapply
    (declare (ignore arguments))
diff --git a/src/util.lisp b/src/util.lisp
index 3238b79..18c1d46 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -265,13 +265,11 @@ one-dimensional collections of values."
   (ensure-pathname (enough-pathname pathname chroot)
                    :ensure-absolute t :defaults #P"/"))
 
-(defun escape-sh-token (token &optional s)
-  "Like UIOP:ESCAPE-SH-TOKEN, but also escape the empty string."
-  (if (string= token "") (format s "\"\"") (uiop:escape-sh-token token s)))
-
-(defun escape-sh-command (command &optional s)
-  "Like UIOP:ESCAPE-SH-COMMAND, but also escape the empty string."
-  (uiop:escape-command command s 'escape-sh-token))
+(defun sh-escape (token-or-cmd &optional s)
+  (cond ((listp token-or-cmd) (uiop:escape-command token-or-cmd s 'sh-escape))
+        ((pathnamep token-or-cmd) (sh-escape (unix-namestring token-or-cmd) s))
+        ((string= token-or-cmd "") (format s "\"\""))
+        (t (uiop:escape-sh-token token-or-cmd s))))
 
 (defun parse-username-from-id (output)
   "Where OUTPUT is the output of the id(1) command, extract the username."