Commit 995fdea78ab1403ccd1562a49abef6ccae4555c8

Thomas de Grivel 2015-07-23T19:38:19

Change RUN, SHELL-RUN and HOST-RUN to use STR call convention.

diff --git a/core/defs.lisp b/core/defs.lisp
index 0b13ba5..92e319b 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -181,7 +181,7 @@
 (defgeneric (setf host-shell) (shell host))
 
 (defgeneric host-os (host))
-(defgeneric host-run (host command &rest format-args))
+(defgeneric host-run (host &rest command))
 
 (define-resource-class ssh-host (host))
 
diff --git a/core/host.lisp b/core/host.lisp
index 1a0bc9d..e6607ca 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -18,12 +18,13 @@
 
 (in-package :adams)
 
-(defun run (command &rest format-args)
+(defun run (&rest command)
+  "Run a command at the current host. COMMAND is assembled using STR."
   (if (and (boundp '*host*)
            (symbol-value '*host*))
-      (apply #'host-run *host* command format-args)
+      (apply #'host-run *host* command)
       (with-shell (shell)
-        (apply #'shell-run shell command format-args))))
+        (apply #'shell-run shell command))))
 
 ;;  localhost
 
@@ -79,11 +80,11 @@
                 (localhost)
                 (resource 'ssh-host host)))))
 
-(defmethod host-run ((host host) (command string) &rest format-args)
+(defmethod host-run ((host host) &rest command)
   (let ((shell (host-shell host)))
     (when (shell-closed-p shell)
       (setq shell (host-connect host)))
-    (apply #'shell-run shell command format-args)))
+    (apply #'shell-run shell command)))
 
 (defmacro with-connected-host ((var hostname) &body body)
   (let ((g!host (gensym "HOST-")))
@@ -91,9 +92,9 @@
        (unwind-protect (let ((,var ,g!host)) ,@body)
          (host-disconnect ,g!host)))))
 
-(defmethod host-run ((hostname string) command &rest format-args)
+(defmethod host-run ((hostname string) &rest command)
   (with-connected-host (host hostname)
-    (apply #'host-run host command format-args)))
+    (apply #'host-run host command)))
 
 ;;  With host
 
diff --git a/shell/shell.lisp b/shell/shell.lisp
index 8245745..09dd3da 100644
--- a/shell/shell.lisp
+++ b/shell/shell.lisp
@@ -173,8 +173,8 @@ Error: ~S"
        (unwind-protect (let ((,shell ,g!shell)) ,@body)
 	 (shell-close ,g!shell)))))
 
-(defun shell-run (shell command &rest format-args)
-  (let ((cmd (apply 'format nil command format-args)))
+(defun shell-run (shell &rest command)
+  (let ((cmd (str command)))
     (multiple-value-bind (status out err) (shell-run-command cmd shell)
       (when *shell-signal-errors*
 	(assert (= 0 status) ()
diff --git a/unix/commands.lisp b/unix/commands.lisp
index c6f4350..7ae490f 100644
--- a/unix/commands.lisp
+++ b/unix/commands.lisp
@@ -26,14 +26,32 @@
 	     (re-bind re (os-name node-name os-release os-version machine) uname-a)))
       (try-re #~"^(\S+) (\S+) (\S+) (.+) (\S+)$"))))
 
+(defun grep_ (pattern &rest files)
+  (join-str " " "grep" (sh-quote pattern) (mapcar #'sh-quote files)))
+
 (defun grep (pattern &rest files)
-  (run "grep ~A~{ ~A~}" (sh-quote pattern) (mapcar #'sh-quote files)))
+  (run (apply #'grep_ pattern files)))
+
+(defun egrep_ (pattern &rest files)
+  (join-str " " "egrep" (sh-quote pattern) (mapcar #'sh-quote files)))
 
 (defun egrep (pattern &rest files)
-  (run "egrep ~A~{ ~A~}" (sh-quote pattern) (mapcar #'sh-quote files)))
+  (run (apply #'egrep_ pattern files)))
+
+(defun stat_ (options &rest files)
+  (join-str " " "stat" options (mapcar #'sh-quote files)))
 
 (defun stat (options &rest files)
-  (run "stat ~A~{ ~A~}" options (mapcar #'sh-quote files)))
+  (run (apply #'stat_ options files)))
+
+(defun ls_ (options &rest files)
+  (join-str " " "ls" options (mapcar #'sh-quote files)))
 
 (defun ls (options &rest files)
-  (run "ls ~A~{ ~A~}" options (mapcar #'sh-quote files)))
+  (run (apply #'ls_ options files)))
+
+(defun sudo_ (options &rest command)
+  (join-str " " "sudo" options command))
+
+(defun sudo (options &rest command)
+  (run (apply #'sudo_ options command)))
diff --git a/unix/probes.lisp b/unix/probes.lisp
index b4369e9..cb3f85d 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -98,7 +98,7 @@
               (for vars = (if legacy
                               '(sum size name)
                               '(algo name sum)))
-              (for cmd = (str "cksum -a " algorithm " ~A"))
+              (for cmd = (str "cksum -a " algorithm " "))
               (for match-p = (if legacy
                                  `(string= id name)
                                  `(and (string= ,algorithm algo)
@@ -118,7 +118,7 @@
   (let* ((size (get-probed file :size))
          (content (when size
                     (if (< size *probe-file-content-size-limit*)
-                        (run "cat ~A" (sh-quote (resource-id file)))
+                        (run "cat " (sh-quote (resource-id file)))
                         :file-too-large))))
     (properties* content)))
 
@@ -128,7 +128,7 @@
   (let ((content (remove-if (lambda (f)
                               (or (string= "." f)
                                   (string= ".." f)))
-                            (run "ls -1a ~A" (resource-id dir)))))
+                            (run "ls -1a " (resource-id dir)))))
     (properties* content)))
 
 ;;  Mounts
@@ -137,7 +137,7 @@
   (let ((id (resource-id m)))
     (multiple-value-bind (dev mp fstype options)
         (iter (mount<8> (dev mp fstype options)
-                        in (run "mount | grep ~A"
+                        in (run "mount | grep "
                                 (sh-quote (str id " "))))
               (when (or (string= id dev)
                         (string= id mp))
@@ -151,8 +151,9 @@
   (let ((id (resource-id m)))
     (multiple-value-bind (dev mp fstype options freq passno)
         (iter (fstab<5> (dev mp fstype options freq passno)
-                        in (run "grep ~A /etc/fstab"
-                                (sh-quote (str id " "))))
+                        in (run "grep "
+                                (sh-quote (str id " "))
+                                " /etc/fstab"))
               (when (or (string= id dev)
                         (string= id mp))
                 (return (values dev mp fstype options freq passno))))
@@ -171,7 +172,7 @@
 (defmethod probe-ps-auxww ((process process) (os os-unix))
   (let ((id (resource-id process)))
     (multiple-value-bind #1=(user pid cpu mem vsz rss tt state start time cmd)
-        (iter (ps<1>-u #1# in (run "ps auxww | grep ~A" (sh-quote id)))
+        (iter (ps<1>-u #1# in (run "ps auxww | grep " (sh-quote id)))
               (print #.(cons 'list '#1#))
               (when (typecase id
                       (integer (= id pid))