From 1e99ee6ff7f47db2052e226d7b071e31ff33b56c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 4 Aug 2021 17:09:47 -0700 Subject: add LXC properties, :LXC{,-UNPRIV-ATTACH} connections, WITH-HOMEDIR Signed-off-by: Sean Whitton --- src/connection/chroot.lisp | 4 +- src/connection/linux-namespace.lisp | 157 ++++++++++++++++++++++++++++-------- src/connection/shell-wrap.lisp | 3 +- 3 files changed, 130 insertions(+), 34 deletions(-) (limited to 'src/connection') diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp index 8f829d3..4c1db70 100644 --- a/src/connection/chroot.lisp +++ b/src/connection/chroot.lisp @@ -100,7 +100,9 @@ should be the mount point, without the chroot's root prefixed.") (unless (and (lisp-connection-p) (zerop (nix:geteuid))) (error "~&Forking into a chroot requires a Lisp image running as root")) (informat 1 "~&Forking into chroot at ~A" into) - (let* ((into (ensure-pathname into :want-absolute t :ensure-directory t)) + (let* ((into (ensure-pathname into + :defaults (uiop:getcwd) + :ensure-absolute t :ensure-directory t)) (connection (make-instance 'shell-chroot-connection :into into))) ;; Populate the CONSFIGURATOR::ID and :REMOTE-HOME connattrs correctly to ;; ensure they don't get bogus values when this connection object is used diff --git a/src/connection/linux-namespace.lisp b/src/connection/linux-namespace.lisp index 89b5daf..dc913e8 100644 --- a/src/connection/linux-namespace.lisp +++ b/src/connection/linux-namespace.lisp @@ -22,42 +22,36 @@ ;;; finaliser thread: we must be truly single-threaded in order to enter a ;;; different user namespace. If we can't use it then we fall back to a ;;; POSIX-type connection into the container. In the latter situation the -;;; user could follow the :SYSTEMD-MACHINED connection with a connection type -;;; which starts up a remote Lisp image within the container. This will be -;;; significantly slower, so if there is more than one container it will -;;; probably be worth arranging for the use of 'SETNS. +;;; user could follow the :SYSTEMD-MACHINED/:LXC/etc. connection with a +;;; connection type which starts up a remote Lisp image within the container. +;;; This will be significantly slower, so if there is more than one container +;;; it will probably be worth arranging for the use of 'SETNS. +;;; +;;; For containers which can be launched only by root, like systemd-nspawn, we +;;; use nsenter(1) for the POSIX-type connection into them. For containers +;;; owned by non-root, however, we use container-specific commands like +;;; lxc-unpriv-attach(1). This is because nsenter(1) with --all can fail with +;;; permission errors depending on which namespaces are had in common inside +;;; and outside of the container. For example, if the container has the same +;;; time namespace, nsenter(1) will fail to re-enter it because the non-root +;;; user lacks CAP_SYS_ADMIN for the user namespace owning that time +;;; namespace. 'SETNS handles this case by ignoring EPERM in the second pass. ;;; ;;; An alternative to calling setns(2) ourselves, in the Lisp-type connection ;;; case, might be to dump an image, write it to a temporary file within the ;;; container using WITH-REMOTE-TEMPORARY-FILE & nsenter(1), and then reinvoke -;;; the image, again using nsenter(1). This would be more portable with -;;; respect to Lisp implementations. However, it would run into the problems -;;; described in "Dumping and reinvoking Lisp" in pitfalls.rst. With the -;;; current approach, shared library dependencies need be available only -;;; outside the container, and then after entering the container they will -;;; still be usable. - -(defmethod establish-connection - ((type (eql :systemd-machined)) remaining &key name uid gid) - (establish-connection - #+sbcl (if (lisp-connection-p) 'setns :nsenter) #-sbcl :nsenter remaining - :pid (or (loop for line in (runlines "machinectl" "show" name) - when (string-prefix-p "Leader=" line) - return (subseq line 7)) - (error "Could not determine PID for machine ~A." name)) - :uid uid :gid gid)) - - -;;;; :NSENTER - -(defmethod establish-connection - ((type (eql :nsenter)) remaining &key pid uid gid) - (declare (ignore remaining)) - (informat 1 "~&Entering namespaces of PID ~D with nsenter(1)" pid) - (make-instance 'nsenter-connection :pid pid :uid uid :gid gid)) +;;; the image, again using nsenter(1), or using lxc-unpriv-attach(1), etc. +;;; This would be more portable with respect to Lisp implementations. +;;; However, it would run into the problems described in "Dumping and +;;; reinvoking Lisp" in pitfalls.rst. With the current approach, shared +;;; library dependencies need be available only outside the container, and +;;; then after entering the container they will still be usable. (defclass linux-namespace-connection () - ((pid :type integer :initarg :pid + ((name :type string :initarg :name + :documentation + "The name of the container as output by commands like lxc-ls(1).") + (pid :type integer :initarg :pid :initform (simple-program-error "Must supply namespace leader PID.") :documentation "A PID of a process which is already within all of the namespaces.") @@ -79,6 +73,9 @@ (when (plusp (length entry)) (push entry env)))))) + +;;;; :NSENTER + (defclass nsenter-connection (linux-namespace-connection shell-wrap-connection) ()) @@ -89,6 +86,101 @@ "nsenter ~@[-S ~D ~]~@[-G ~D ~]-at ~D env -i ~{~A~^ ~} sh -c ~A" uid gid pid (mapcar #'escape-sh-token env) (escape-sh-token cmd)))) +(defmethod establish-connection + ((type (eql :nsenter)) remaining &key name pid uid gid) + (declare (ignore remaining)) + (informat 1 "~&Entering namespaces of PID ~D with nsenter(1)" pid) + (make-instance 'nsenter-connection :name name :pid pid :uid uid :gid gid)) + +(defmethod establish-connection + ((type (eql :systemd-machined)) remaining &key name uid gid) + (let ((type #+sbcl (if (lisp-connection-p) 'setns :nsenter) #-sbcl :nsenter) + (pid (or (loop for line in (runlines "machinectl" "show" name) + when (string-prefix-p "Leader=" line) + return (subseq line 7)) + (error "Could not determine PID for container ~A." name)))) + (apply #'establish-connection type remaining + :name name :pid pid :uid uid :gid gid + (and (eql 'setns type) '(:posix-type nsenter-connection))))) + + +;;;; :LXC-UNPRIV-ATTACH + +(defclass lxc-unpriv-attach-connection + (linux-namespace-connection shell-wrap-connection) + ((owner :initarg :owner :initform nil) + (owner-uid :initarg :owner-uid :initform nil))) + +(defmethod initialize-instance :after + ((connection lxc-unpriv-attach-connection) &key) + (with-slots (owner owner-uid) connection + (when owner (setf owner-uid (user:passwd-entry 2 owner))))) + +(defmethod connection-shell-wrap + ((connection lxc-unpriv-attach-connection) cmd) + (with-slots (owner owner-uid name uid gid env) connection + ;; Here we reimplement lxc-unpriv-attach(1) in order to pass --quiet to + ;; systemd-run(1), else we get extra output on stderr. + (let ((args `("systemd-run" "--scope" "--quiet" "-p" "Delegate=yes" + "/usr/bin/lxc-attach" "-n" ,name "--clear-env" + ,@(loop for env in env collect "--set-var" collect env) + ,@(and uid `("-u" ,(write-to-string uid))) + ,@(and gid `("-g" ,(write-to-string gid))) + "--" "sh" "-c" ,cmd))) + (if (and owner (not (string= owner (get-connattr :remote-user)))) + (with-connattrs (:remote-uid owner-uid) + (list* "runuser" "-u" owner "--" (apply #'systemd--user args))) + (apply #'systemd--user args))))) + +(defmethod establish-connection + ((type (eql :lxc-unpriv-attach)) remaining &key owner name pid uid gid) + (declare (ignore remaining)) + (informat 1 "~&Entering namespaces of PID ~D with lxc-unpriv-attach(1)" pid) + (make-instance 'lxc-unpriv-attach-connection + :owner owner :name name :pid pid :uid uid :gid gid)) + +(defmethod establish-connection + ((type (eql :lxc)) remaining + &key owner (name (and (not remaining) (get-hostname))) uid gid) + "Attach to the LXC named NAME and owned by OWNER, defaulting to the current +user. Switch to UID and GID inside the LXC. + +When the previously established connection hop is a Lisp-type connection, this +connection type will dump and reinvoke Lisp. Thus, connections established +since the Lisp image was started up but before this one must not have rendered +the original ~/.cache/common-lisp/ unreadable, or the reinvoked image will +fail to start. For example, + + (:ssh :sbcl (:lxc :name \"foo\")) + +and + + ((:ssh :user \"root\") :sbcl (:lxc :owner \"user\" :name \"foo\")) + +will work but + + ((:ssh :user \"root\") :sbcl (:setuid :to \"user\") (:lxc :name \"foo\")) + +will not. See \"Dumping and reinvoking Lisp\" in the \"Pitfalls and +limitations\" section of the Consfigurator manual. + +When the current connection is a Lisp-type connection, this internally uses +setns(2) to enter the container. See \"Connections which use setns(2) to +enter containers\" in the Consfigurator manual for security implications." + (let ((type #+sbcl (if (lisp-connection-p) 'setns :lxc-unpriv-attach) + #-sbcl :lxc-unpriv-attach) + (pid (loop + for (lxc pid) + in (mapcar #'words (cdr (lxc:lxc-ls owner "-1fFNAME,PID"))) + when (string= lxc name) + return pid + finally + (error "Could not determine PID for container ~A." name)))) + (apply #'establish-connection type remaining + :owner owner :name name :pid pid :uid uid :gid gid + (and (eql 'setns type) + '(:posix-type lxc-unpriv-attach-connection))))) + ;;;; 'SETNS @@ -100,7 +192,8 @@ ;;; type like :SYSTEMD-MACHINED, we mirror these semantics in our 'SETNS. #+sbcl (defmethod establish-connection - ((type (eql 'setns)) remaining &key pid uid gid) + ((type (eql 'setns)) remaining + &rest args &key pid posix-type &allow-other-keys) "Use setns(2) to enter the Linux namespaces of process PID. Additionally, - If PID has a distinct user namespace and we have permission to setgroups(2) @@ -133,7 +226,7 @@ setgroups(2) in either the starting user namespace or the target user namespace, in each case either due to a lack of privilege or because setgroups(2) is denied in the namespace." (informat 1 "~&Reassociating to Linux namespaces of PID ~D" pid) - (alet (make-instance 'nsenter-connection :pid pid :uid uid :gid gid) + (alet (apply #'make-instance posix-type (remove-from-plist args :posix-type)) (upload-all-prerequisite-data it) (change-class it 'setns-connection) (continue-connection it remaining))) diff --git a/src/connection/shell-wrap.lisp b/src/connection/shell-wrap.lisp index bcc8fc8..49cfd83 100644 --- a/src/connection/shell-wrap.lisp +++ b/src/connection/shell-wrap.lisp @@ -23,7 +23,8 @@ (defgeneric connection-shell-wrap (connection cmd)) (defmethod connection-run ((c shell-wrap-connection) cmd input) - (mrun :may-fail :input input (connection-shell-wrap c cmd))) + (apply #'mrun :may-fail :input input + (ensure-cons (connection-shell-wrap c cmd)))) (defun %readfile (c path &optional delete) (multiple-value-bind (out exit) -- cgit v1.2.3