From 4e0a4c107e4a2ee708e6e7a9f3edf189fe858f14 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 11 Mar 2022 15:27:00 -0700 Subject: replace ESCAPE-SH-TOKEN and ESCAPE-SH-COMMAND with new SH-ESCAPE Signed-off-by: Sean Whitton --- src/connection.lisp | 22 +++++++++++----------- src/connection/chroot.lisp | 3 +-- src/connection/linux-namespace.lisp | 2 +- src/connection/shell-wrap.lisp | 4 ++-- src/connection/ssh.lisp | 2 +- src/connection/su.lisp | 3 +-- src/connection/sudo.lisp | 4 ++-- src/data.lisp | 12 +++++------- src/data/pgp.lisp | 3 +-- src/package.lisp | 3 +-- src/property/cmd.lisp | 2 +- src/property/cron.lisp | 7 +++---- src/property/file.lisp | 3 +-- src/property/installer.lisp | 2 +- src/property/libvirt.lisp | 2 +- src/util.lisp | 12 +++++------- 16 files changed, 38 insertions(+), 48 deletions(-) (limited to 'src') 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." -- cgit v1.2.3