[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 8ad4c4e..4098e49 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -92,6 +92,7 @@
 	   #:get-hostname
 	   #:require-data
 	   #:failed-change
+           #:assert-euid-root
 
 	   ;; propspec.lisp
 	   #:in-consfig
diff --git a/src/property.lisp b/src/property.lisp
index 0820810..a338586 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
 
@@ -210,3 +211,17 @@ Called by property subroutines."
   ((text :initarg :text :reader failed-change-text))
   (:report (lambda (condition stream)
 	     (format stream "~A" (failed-change-text condition)))))
+
+(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