Commit 442de45335fac2c81af03c251d8e620e3551251f

Thomas de Grivel 2023-11-01T22:06:14

fix build on OpenBSD, add run! and run-as-root!

diff --git a/cl-unix-cybernetics.asd b/cl-unix-cybernetics.asd
index 35fde8f..38d4901 100644
--- a/cl-unix-cybernetics.asd
+++ b/cl-unix-cybernetics.asd
@@ -52,6 +52,7 @@
 	     (:file "properties" :depends-on ("defs"))
 	     (:file "resource"   :depends-on ("defs" "probe"))
 	     (:file "resource-container" :depends-on ("defs"))
+             (:file "run" :depends-on ("defs" "host"))
 	     (:file "spec"       :depends-on ("defs" "resource"))
              (:file "syntaxes")))
    (:module "unix" :depends-on ("package" "shell" "core")
diff --git a/core/host.lisp b/core/host.lisp
index 46af344..b4e7675 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -13,10 +13,6 @@
 
 (in-package :cl-unix-cybernetics)
 
-(defun run (&rest command)
-  "Run a command at the current host. COMMAND is assembled using STR."
-  (apply #'host-run (current-host) command))
-
 (defun strip-last-newline (string)
   (when (stringp string)
     (let* ((len (length string))
diff --git a/core/run.lisp b/core/run.lisp
new file mode 100644
index 0000000..cfbc804
--- /dev/null
+++ b/core/run.lisp
@@ -0,0 +1,56 @@
+;; cl-unix-cybernetics
+;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
+;;
+;; Permission is hereby granted to use this software granted
+;; the above copyright notice and this permission paragraph
+;; are included in all copies and substantial portions of this
+;; software.
+;;
+;; THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF
+;; PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE
+;; AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
+;; THIS SOFTWARE.
+
+(in-package :cl-unix-cybernetics)
+
+(defun run (&rest command)
+  "Run a command at the current host. COMMAND is assembled using STR."
+  (apply #'host-run (current-host) command))
+
+(defun run! (&rest command)
+  "Run a command at the current host. COMMAND is assembled using STR.
+An error is raised if the command did not complete successfully."
+  (multiple-value-bind (out ret err) (apply #'run command)
+    (if (zerop ret)
+        (values out ret err)
+        (error "The command ~S failed with error code ~D.
+Output : ~S
+Error output : ~S"
+               (str command) ret out err))))
+
+;;  Run as root
+
+(defgeneric run-as-root-command (host os))
+
+(defmethod run-as-root-command ((host t) (os os-unix))
+  "sudo ")
+
+(defun run-as-root (&rest command)
+  "Run a command at the current host as the root user (dangerous).
+COMMAND is assembled using STR."
+  (let* ((host (current-host))
+         (prefix (unless (equal "root" (get-probed host :user))
+                   (run-as-root-command host (get-probed host :os)))))
+    (apply #'run prefix command)))
+
+(defun run-as-root! (&rest command)
+  "Run a command at the current host as the root user (dangerous).
+COMMAND is assembled using STR.
+An error is raised if the command did not complete successfully."
+  (multiple-value-bind (out ret err) (apply #'run-as-root command)
+    (if (zerop ret)
+        (values out ret err)
+        (error "The root command (dangerous) ~S failed with error code ~D.
+Output : ~S
+Error output : ~S"
+               (str command) ret out err))))
diff --git a/package.lisp b/package.lisp
index 31d6d9d..904ecce 100644
--- a/package.lisp
+++ b/package.lisp
@@ -120,7 +120,9 @@
    #:host-run
    #:localhost
    #:run
+   #:run!
    #:run-as-root
+   #:run-as-root!
    #:run-as-root-command
    #:ssh-host
    #:with-connected-host
diff --git a/unix/operations.lisp b/unix/operations.lisp
index 02c997b..bffab3a 100644
--- a/unix/operations.lisp
+++ b/unix/operations.lisp
@@ -28,19 +28,6 @@
 (defun echo (&rest parts)
   (run (echo_ parts)))
 
-;;  Run as root
-
-(defgeneric run-as-root-command (host os))
-
-(defmethod run-as-root-command ((host t) (os os-unix))
-  "sudo ")
-
-(defun run-as-root (&rest command)
-  (let* ((host (current-host))
-         (prefix (unless (equal "root" (get-probed host :user))
-                   (run-as-root-command host (get-probed host :os)))))
-    (apply #'run prefix command)))
-
 ;;  Host operations
 
 (defmethod op-hostname ((host host) (os os-unix) &key hostname)
diff --git a/unix/probes.lisp b/unix/probes.lisp
index 5825cb0..95b254f 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -119,9 +119,9 @@
         (push `(defmethod ,name ((file file) (os os-unix))
                  (let* ((id (resource-id file))
                         (,var (,iterator ,vars
-                                         (run ,cmd (sh-quote id)))
-                          (when ,match-p
-                            (return sum))))
+                                         (run ,cmd (sh-quote id))
+                                         (when ,match-p
+                                           (return sum)))))
                    (properties* ,var)))
               *cksum-defs*)
         (push `(defgeneric ,name (file os)) *cksum-defs*)))
diff --git a/unix/syntaxes.lisp b/unix/syntaxes.lisp
index 3cfd0ed..2ef963b 100644
--- a/unix/syntaxes.lisp
+++ b/unix/syntaxes.lisp
@@ -38,7 +38,7 @@
 			 (#'chronicity:parse time)
 			 name
                          target)
-  #~|^([-a-zA-Z]{10})\s+([0-9]+)\s+(\S+)\s+(\S+)\s+([0-9]+)\s+(\S+\s+\S+ \S+ \S+)\s+(.+?)(?: -> (.*))?$|
+  #~|^([^\s]+)\s+([0-9]+)\s+(\S+)\s+(\S+)\s+([0-9]+)\s+(\S+\s+\S+ \S+ \S+)\s+(.+?)(?: -> (.*))?$|
   "Syntax for `ls -lT` output. See ls(1)."
   (values name mode links owner group size time target))