From 8837b71e02d93787de60d454a493a8801a6427a5 Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Sat, 18 Sep 2021 15:22:36 -0700
Subject: basic systemctl(1) properties: add USER argument for --user

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
---
 src/package.lisp          |  3 ++-
 src/property/systemd.lisp | 44 +++++++++++++++++++++++++-------------------
 src/util.lisp             | 24 ++++++++++++++++++++++++
 3 files changed, 51 insertions(+), 20 deletions(-)

(limited to 'src')

diff --git a/src/package.lisp b/src/package.lisp
index d325afe..647dd5a 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -98,6 +98,7 @@
            #:memstring=
            #:define-simple-error
            #:plist-to-cmd-args
+           #:systemd--user
 	   #:with-local-temporary-directory
            #:pathname-file
            #:directory-contents
@@ -822,7 +823,7 @@
            #:https-vhost))
 
 (defpackage :consfigurator.property.systemd
-  (:use #:cl #:consfigurator)
+  (:use #:cl #:consfigurator #:anaphora)
   (:export #:started
            #:stopped
            #:enabled
diff --git a/src/property/systemd.lisp b/src/property/systemd.lisp
index a83f206..408be53 100644
--- a/src/property/systemd.lisp
+++ b/src/property/systemd.lisp
@@ -18,38 +18,44 @@
 (in-package :consfigurator.property.systemd)
 (named-readtables:in-readtable :consfigurator)
 
-(defprop started :posix (service)
+(defun systemctl (fn user &rest args &aux (args (cons "systemctl" args)))
+  (apply fn (if user (apply #'systemd--user args) args)))
+
+(defprop started :posix (service &optional user)
   (:desc #?"systemd service ${service} started")
-  (:check (zerop (mrun :for-exit "systemctl" "is-active" service)))
-  (:apply (mrun "systemctl" "start" service)))
+  (:check (zerop (systemctl #'mrun user :for-exit "is-active" service)))
+  (:apply (systemctl #'mrun user "start" service)))
 
-(defprop stopped :posix (service)
+(defprop stopped :posix (service &optional user)
   (:desc #?"systemd service ${service} stopped")
-  (:check (plusp (mrun :for-exit "systemctl" "is-active" service)))
-  (:apply (mrun "systemctl" "stop" service)))
+  (:check (plusp (systemctl #'mrun user :for-exit "is-active" service)))
+  (:apply (systemctl #'mrun user "stop" service)))
 
-(defprop enabled :posix (service)
+(defprop enabled :posix (service &optional user)
   (:desc #?"systemd service ${service} enabled")
-  (:check (zerop (mrun :for-exit "systemctl" "is-enabled" service)))
-  (:apply (mrun "systemctl" "enable" service)))
+  (:check (zerop (systemctl #'mrun user :for-exit "is-enabled" service)))
+  (:apply (systemctl #'mrun user "enable" service)))
 
-(defprop disabled :posix (service)
+(defprop disabled :posix (service &optional user)
   (:desc #?"systemd service ${service} disabled")
   (:check
-   (let ((status (stripln (run :may-fail "systemctl" "is-enabled" service))))
+   (let ((status
+           (stripln
+            (systemctl #'run user :may-fail "is-enabled" service))))
      (or (string-prefix-p "linked" status)
          (string-prefix-p "masked" status)
          (memstring=
-          status
-          '("static" "disabled" "generated" "transient" "indirect")))))
-  (:apply (mrun "systemctl" "disable" service)))
+          status '("static" "disabled" "generated" "transient" "indirect")))))
+  (:apply (systemctl #'mrun user "disable" service)))
 
-(defprop masked :posix (service)
+(defprop masked :posix (service &optional user)
   (:desc #?"systemd service ${service} masked")
-  (:check (string-prefix-p "masked"
-                           (run :may-fail "systemctl" "is-enabled" service)))
-  (:apply (mrun "systemctl" "mask" service))
-  (:unapply (mrun "systemctl" "unmask" service)))
+  (:check
+   (string-prefix-p
+    "masked"
+    (systemctl #'run user :may-fail "is-enabled" service)))
+  (:apply (systemctl #'mrun user "mask" service))
+  (:unapply (systemctl #'mrun user "unmask" service)))
 
 (defprop lingering-enabled :posix (user)
   (:desc #?"User lingering enable for ${user}")
diff --git a/src/util.lisp b/src/util.lisp
index cb3eace..1bed222 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -171,6 +171,30 @@ supported."
   (doplist (k v plist args)
            (push (strcat "--" (string-downcase (symbol-name k)) "=" v) args)))
 
+(defun systemd--user (&rest args)
+  "Where ARGS are args to RUN or MRUN for an invocation of a systemd command
+which can take \"--user\", insert the \"--user\" parameter, and modify or
+insert an :ENV parameter so that the call is more likely to succeed."
+  (loop with xrd = (format nil "/run/user/~D" (get-connattr :remote-uid))
+        with dsba = (format nil "unix:path=~A/bus" xrd)
+        with arg-done and env-done while args
+        as next = (pop args) collect next into accum
+        if (and (not arg-done) (stringp next))
+          collect "--user" into accum and do (setq arg-done t)
+        if (eql :env next)
+          collect (aprog1 (copy-list (pop args))
+                    (setf (getf it :XDG_RUNTIME_DIR) xrd
+                          (getf it :DBUS_SESSION_BUS_ADDRESS) dsba
+                          env-done t))
+            into accum
+        if (eql :input next)
+          collect (pop args)
+        finally (return (if env-done
+                            accum
+                            (list* :env `(:XDG_RUNTIME_DIR ,xrd
+                                          :DBUS_SESSION_BUS_ADDRESS ,dsba)
+                                   accum)))))
+
 (defmacro with-local-temporary-directory ((dir) &body forms)
   "Execute FORMS with a local temporary directory's pathname in DIR.
 Currently assumes GNU mktemp(1).
-- 
cgit v1.2.3