add and export GET-USER

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

3 files changed, 14 insertions, 1 deletions

diff --git a/src/connection.lisp b/src/connection.lisp
index 9dc40a9..b20b107 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -79,7 +79,11 @@ For an example of usage, see the :SUDO connection type."))
    (remote-uid
     :initform nil
     :documentation
-    "Effective user-id of the remote (deploying) user")))
+    "Effective user-id of the remote (deploying) user")
+   (remote-user
+    :initform nil
+    :documentation
+    "The name of the remote user.")))
 
 (defun reset-remote-home ()
   "Clear the cache of the remote user's home directory.
diff --git a/src/package.lisp b/src/package.lisp
index e4dd608..986a311 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -129,6 +129,7 @@
            #:require-data
            #:failed-change
            #:assert-euid-root
+           #:get-user
            #:assert-connection-supports
            #:call-with-os
            #:with-change-if-changes-file
diff --git a/src/property.lisp b/src/property.lisp
index 4403eb7..263200f 100644
--- a/src/property.lisp
+++ b/src/property.lisp
@@ -464,6 +464,14 @@ apply or unapply properties.")
           (failed-change "Property requires root to apply"))
         (setf (slot-value *connection* 'remote-uid) new-uid)))))
 
+(defun get-user ()
+  "Get the remote username."
+  (or (slot-value *connection* 'remote-user)
+      (setf (slot-value *connection* 'remote-user)
+            (multiple-value-bind (match groups)
+                (re:scan-to-strings "^uid=[0-9]+\\(([^)]+)" (mrun "id"))
+              (and match (elt groups 0))))))
+
 (defun assert-connection-supports (type)
   (unless (or (eq type :posix) (lisp-connection-p))
     (failed-change