diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-04-30 16:53:02 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-04-30 17:56:41 -0700 |
commit | 691c81810e647ef7d780f4f3546ee8856f777b07 (patch) | |
tree | 221a5e43193e6ddaae5fdd86b85ea8373486db10 /src | |
parent | e8df647b13c130cc038eef76acf02caabe346b7e (diff) | |
download | consfigurator-691c81810e647ef7d780f4f3546ee8856f777b07.tar.gz |
chroot connections: set up bind mounts and virtual filesystems
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src')
-rw-r--r-- | src/connection/chroot.lisp | 52 | ||||
-rw-r--r-- | src/connection/fork.lisp | 1 | ||||
-rw-r--r-- | src/deployment.lisp | 5 | ||||
-rw-r--r-- | src/package.lisp | 1 |
4 files changed, 51 insertions, 8 deletions
diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp index 9867e30..802d3ce 100644 --- a/src/connection/chroot.lisp +++ b/src/connection/chroot.lisp @@ -36,7 +36,50 @@ ;;;; Chroot connections superclass (defclass chroot-connection () - ((into :type :string :initarg :into))) + ((into :type :string :initarg :into) + (chroot-mounts :type list :initform nil :accessor chroot-mounts))) + +(defgeneric chroot-mount (connection &rest mount-args) + (:documentation + "Temporarily mount something into the chroot. The last element of MOUNT-ARGS +should be the mount point, without the chroot's root prefixed.") + (:method ((connection chroot-connection) &rest mount-args) + (let ((dest (chroot-pathname (lastcar mount-args) + (slot-value connection 'into)))) + ;; We only mount when the target is not already a mount point, so we + ;; don't shadow anything that the user has already set up. + (when (plusp (mrun :for-exit "mountpoint" "-q" dest)) + (setq mount-args (copy-list mount-args)) + (setf (lastcar mount-args) dest) + (apply #'mrun "mount" mount-args) + (push dest (chroot-mounts connection)))))) + +(defmethod connection-teardown :before ((connection chroot-connection)) + (dolist (mount (chroot-mounts connection)) + (mrun "umount" mount))) + +(defparameter *standard-chroot-mounts* '( +("-t" "proc" "-o" "nosuid,noexec,nodev" "proc" "/proc") +("-t" "sysfs" "-o" "nosuid,noexec,nodev,ro" "sys" "/sys") +("-t" "devtmpfs" "-o" "mode=0755,nosuid" "udev" "/dev") +("-t" "devpts" "-o" "mode=0620,gid=5,nosuid,noexec" "devpts" "/dev/pts") +("-t" "tmpfs" "-o" "mode=1777,nosuid,nodev" "shm" "/dev/shm") +("-t" "tmpfs" "-o" "mode=1777,strictatime,nodev,nosuid" "tmp" "/tmp") +("--bind" "/run" "/run"))) + +(defmethod initialize-instance :after ((connection chroot-connection) &key) + (when (string= "Linux" (stripln (run "uname"))) + (with-slots (into) connection + ;; Ensure the chroot itself is a mountpoint so that findmnt(1) works + ;; correctly within the chroot. + (unless (zerop (mrun :for-exit "mountpoint" "-q" into)) + (chroot-mount connection "--bind" into "/")) + ;; Now set up the usual bind mounts. Help here from arch-chroot(8). + (dolist (mount *standard-chroot-mounts*) + (apply #'chroot-mount connection mount)) + (when (remote-exists-p "/sys/firmware/efi/efivars") + (chroot-mount connection "-t" "efivarfs" "-o" "nosuid,noexec,nodev" + "efivarfs" "/sys/firmware/efi/efivars"))))) ;;;; :CHROOT.FORK @@ -61,9 +104,10 @@ (datadir (ensure-pathname (subseq datadir-inside 1) :defaults into* :ensure-absolute t :ensure-directory t))) - (continue-connection - (make-instance 'chroot.fork-connection :into into :datadir datadir) - remaining))) + (let ((connection (make-instance 'chroot.fork-connection + :into into :datadir datadir))) + (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))) diff --git a/src/connection/fork.lisp b/src/connection/fork.lisp index 3fe63aa..0bc139c 100644 --- a/src/connection/fork.lisp +++ b/src/connection/fork.lisp @@ -57,7 +57,6 @@ for example, such that we don't see it." #-(or sbcl) (error "Don't know how to safely fork() in this Lisp") (upload-all-prerequisite-data :connection connection :upload-string-data nil) - ;; TODO bind mounts (with-remote-temporary-file (output) (mapc #'force-output (list *standard-output* *error-output* *debug-io* *terminal-io*)) diff --git a/src/deployment.lisp b/src/deployment.lisp index 7d1af93..104a810 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -38,9 +38,8 @@ preprocessed." (multiple-value-bind (*connection* return) (apply #'establish-connection type remaining args) (if *connection* - (prog1 (if remaining - (connect remaining) - (apply-*host*-propspec)) + (unwind-protect-in-parent + (if remaining (connect remaining) (apply-*host*-propspec)) (connection-teardown *connection*)) return))))) (let ((*host* (preprocess-host host))) diff --git a/src/package.lisp b/src/package.lisp index 6f1f0a7..104b13d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -501,6 +501,7 @@ (defpackage :consfigurator.connection.chroot (:use #:cl + #:alexandria #:consfigurator #:consfigurator.connection.fork #:consfigurator.connection.rehome |