[PATCH consfigurator 2/3] add assert-euid-root

[David Bremner]

This allows property writers to print a helpful message when not
running applying (or unapplying) as root. Failures from lack of
privilege can otherwise be hard to diagnose.

Signed-off-by: David Bremner <david at tethera.net>
---
 src/package.lisp  |  1 +
 src/property.lisp | 15 +++++++++++++++
 2 files changed, 16 insertions(+)

diff --git a/src/package.lisp b/src/package.lisp
index 400c9bb..d70ef4a 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -96,6 +96,7 @@
 	   #:get-hostname
 	   #:require-data
 	   #:failed-change
+           #:assert-euid-root
 	   #:call-with-os
 
 	   ;; propspec.lisp
diff --git a/src/property.lisp b/src/property.lisp
index bd1acf0..009998c 100644
--- a/src/property.lisp
+++ b/src/property.lisp
@@ -16,6 +16,7 @@
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 (in-package :consfigurator)
+(named-readtables:in-readtable :interpol-syntax)
 
 ;;;; Properties
 
@@ -272,3 +273,17 @@ Called by property subroutines."
 
 (defun call-with-os (f &rest args)
   (apply (ensure-function f) (get-hostattrs-car :os) args))
+
+(defun assert-euid-root ()
+  "assert that the user doing the deploying has uid 0 (root)"
+  (if-let (uid (slot-value *connection* 'remote-uid))
+    (unless (zerop uid)
+      (error 'failed-change :text "property requires root to apply"))
+    (multiple-value-bind (out err exit)
+        (run :may-fail "id" "-u")
+      (unless (zerop exit)
+        (error 'failed-change :text #?"failed to run `id' on remote system: ${err}"))
+      (let ((new-uid (parse-integer out)))
+        (unless (zerop new-uid)
+          (error 'failed-change :text "property requires root to apply"))
+        (setf (slot-value *connection* 'remote-uid) new-uid)))))
-- 
2.30.1