diff options
-rw-r--r-- | src/connection.lisp | 6 | ||||
-rw-r--r-- | src/package.lisp | 1 | ||||
-rw-r--r-- | src/property.lisp | 8 |
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 |