convert CONNECTION slots to connattrs & fix finding homedirs

HOME does not take into account /etc/passwd inside the chroot, even when
starting a login shell with, e.g., "chroot /chroot sh -lc 'echo $HOME'" -- we
would need something which emulates login(1), like su(1), but the -c argument
to su(1) is not portable.  getent(1) is not POSIX.  So use tilde expansion.

Additionally, avoid having UPLOAD-ALL-PREREQUISITE-DATA store values for the
remote UID, remote homedir etc. from *before* the chroot/setuid operation.

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

4 files changed, 61 insertions, 41 deletions

diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp
index bfbaab5..2d8b242 100644
--- a/src/connection/chroot.lisp
+++ b/src/connection/chroot.lisp
@@ -94,6 +94,14 @@ should be the mount point, without the chroot's root prefixed.")
                       copy)
           else collect volume)))
 
+(defmethod propagate-connattr
+    ((type (eql :remote-uid)) connattr (connection chroot-connection))
+  connattr)
+
+(defmethod propagate-connattr
+    ((type (eql :remote-gid)) connattr (connection chroot-connection))
+  connattr)
+
 
 ;;;; :CHROOT.FORK
 
@@ -109,27 +117,34 @@ should be the mount point, without the chroot's root prefixed.")
     (error "~&Forking into a chroot requires a Lisp image running as root"))
   (informat 1 "~&Forking into chroot at ~A" into)
   (let* ((into* (ensure-directory-pathname into))
-         (datadir-inside
-           (stripln
-            (mrun
-             (format
-              nil
-              "chroot ~A echo ${XDG_CACHE_HOME:-$HOME/.cache}/consfigurator/data/"
-              (escape-sh-token (unix-namestring into))))))
-         (datadir (ensure-pathname
-                   (subseq datadir-inside 1)
-                   :defaults into* :ensure-absolute t :ensure-directory t)))
-    (let ((connection (make-instance 'chroot.fork-connection
-                                     :into into :datadir datadir)))
+         (connection (make-instance 'shell-chroot-connection :into into*)))
+    ;; This has the side effect of populating the CONSFIGURATOR::ID and
+    ;; :REMOTE-HOME connattrs correctly, so that they don't get bogus values
+    ;; when this connection object is used in UPLOAD-ALL-PREREQUISITE-DATA.
+    (multiple-value-bind (datadir-inside exit)
+        (connection-run
+         connection
+         (format nil "echo ${XDG_CACHE_HOME:-~A/.cache}/consfigurator/data/"
+                 (connection-connattr connection :remote-home))
+         nil)
+      (unless (zerop exit)
+        (error "Failed to determine datadir inside chroot."))
+      (setq connection (change-class connection 'chroot.fork-connection))
+      (setf (slot-value connection 'datadir)
+            (ensure-pathname
+             (subseq datadir-inside 1)
+             :defaults into* :ensure-absolute t :ensure-directory t))
       (unwind-protect-in-parent (continue-connection connection remaining)
         (connection-teardown connection)))))
 
 (defmethod post-fork ((connection chroot.fork-connection))
   (unless (zerop (chroot (slot-value connection 'into)))
     (error "chroot(2) failed!"))
-  ;; chdir, else our current working directory is a pointer to something
-  ;; outside the chroot
-  (uiop:chdir "/"))
+  (let ((home (connection-connattr connection :remote-home)))
+    (setf (uiop:getenv "HOME") (unix-namestring home))
+    ;; chdir, else our current working directory is a pointer to something
+    ;; outside the chroot
+    (uiop:chdir home)))
 
 
 ;;;; :CHROOT.SHELL
diff --git a/src/connection/setuid.lisp b/src/connection/setuid.lisp
index 51685f2..72d1ca8 100644
--- a/src/connection/setuid.lisp
+++ b/src/connection/setuid.lisp
@@ -26,39 +26,46 @@
   #+sbcl      (sb-posix:setgid gid)
   #-(or sbcl) (foreign-funcall "setgid" :unsigned-int uid :int))
 
-(defclass setuid-connection (rehome-connection fork-connection)
-  ((uid :type :integer :initarg :uid)
-   (gid :type :integer :initarg :gid)
-   (home :type :string :initarg :home)))
+(defclass setuid-connection (rehome-connection fork-connection) ())
 
 (defmethod establish-connection ((type (eql :setuid)) remaining &key to)
   (unless (and (lisp-connection-p) (zerop (foreign-funcall "geteuid" :int)))
     (error "~&SETUIDing requires a Lisp image running as root"))
   (informat 1 "~&SETUIDing to ~A" to)
-  (re:register-groups-bind ((#'parse-integer uid gid))
-      (#?/uid=([0-9]+).+gid=([0-9]+)/ (mrun "id" to))
-    (let ((home (user:passwd-entry 5 uid))
-          (datadir
-            (ensure-directory-pathname
-             (stripln
-              (mrun
-               "su" to "-c"
-               "echo ${XDG_CACHE_HOME:-$HOME/.cache}/consfigurator/data/")))))
-      (continue-connection
-       (make-instance
-        'setuid-connection :uid uid :gid gid :datadir datadir :home home)
-       remaining))))
+  (multiple-value-bind (match groups)
+      (re:scan-to-strings #?/uid=([0-9]+).+gid=([0-9]+)/ (run "id" to))
+    (unless match
+      (error "Could not determine UID and GID of ~A" to))
+    (let* ((uid (parse-integer (elt groups 0)))
+           (gid (parse-integer (elt groups 1)))
+           (home
+             ;; tilde expansion is POSIX
+             (ensure-directory-pathname (stripln (run (strcat "echo ~" to)))))
+           (datadir
+             (ensure-directory-pathname
+              (stripln
+               (mrun
+                "su" to "-c"
+                "echo ${XDG_CACHE_HOME:-$HOME/.cache}/consfigurator/data/")))))
+      (continue-connection (make-instance 'setuid-connection
+                                          :datadir datadir
+                                          :connattrs `(:remote-uid ,uid
+                                                       :remote-gid ,gid
+                                                       :remote-home ,home))
+                           remaining))))
 
 (defmethod post-fork ((connection setuid-connection))
   ;; TODO Set up the new environment more systematically.  Perhaps look at how
   ;; runuser(1) uses PAM to do this.
-  (with-slots (uid gid home datadir) connection
+  (let ((uid (connection-connattr connection :remote-uid))
+        (gid (connection-connattr connection :remote-gid))
+        (home (connection-connattr connection :remote-home)))
     (run-program (list "chown" "-R"
                        (format nil "~A:~A" uid gid)
-                       (unix-namestring datadir)))
+                       (unix-namestring (slot-value connection 'datadir))))
     (unless (zerop (setgid gid))
       (error "setgid(2) failed!"))
     (unless (zerop (setuid uid))
       (error "setuid(2) failed!"))
-    (setf (getenv "HOME") home)
+    (setf (getenv "HOME") (unix-namestring home))
     (uiop:chdir home)))
diff --git a/src/connection/ssh.lisp b/src/connection/ssh.lisp
index eb132f3..38fd2ae 100644
--- a/src/connection/ssh.lisp
+++ b/src/connection/ssh.lisp
@@ -32,6 +32,7 @@
   ((hostname
     :initarg :hostname
     :documentation "Hostname to SSH to.")
+   ;; This is deliberately distinct from the :REMOTE-USER connattr.
    (user
     :initarg :user
     :documentation "User to log in as."))
diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp
index 5ff326d..7896761 100644
--- a/src/connection/sudo.lisp
+++ b/src/connection/sudo.lisp
@@ -43,7 +43,7 @@
   (declare (ignore remaining))
   (informat 1 "~&Establishing sudo connection to ~A" user)
   (make-instance 'sudo-connection
-                 :user user
+                 :connattrs `(:remote-user ,user)
                  ;; we'll send the password followed by ^M, then the real
                  ;; stdin.  use CODE-CHAR in this way so that we can be sure
                  ;; ASCII ^M is what will get emitted.
@@ -53,10 +53,7 @@
                                          (string (code-char 13)))))))
 
 (defclass sudo-connection (shell-wrap-connection)
-  ((user
-    :initarg :user)
-   (password
-    :initarg :password)))
+  ((password :initarg :password)))
 
 (defmethod get-sudo-password ((connection sudo-connection))
   (let ((value (slot-value connection 'password)))
@@ -66,7 +63,7 @@
   ;; wrap in sh -c so that it is more likely we are either asked for a
   ;; password for all our commands or not asked for one for any
   (format nil "sudo -HkS --prompt=\"\" --user=~A sh -c ~A"
-	  (slot-value connection 'user) (escape-sh-token cmd)))
+	  (connection-connattr connection :remote-user) (escape-sh-token cmd)))
 
 (defmethod connection-run ((c sudo-connection) cmd (input null))
   (call-next-method c cmd (get-sudo-password c)))