diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-02-27 13:35:23 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-02-27 13:39:57 -0700 |
commit | 04a74f001710244b31ee23b028d18693be76378c (patch) | |
tree | 8e061b5eea3e06039ee05e7bb6d375b397425717 | |
parent | bd26505bfe86e2aed90c2782e5441960b8ef858c (diff) | |
download | consfigurator-04a74f001710244b31ee23b028d18693be76378c.tar.gz |
add :CHROOT-FORK connection type
Thanks to Mark Wooding for help with handling the streams, dealing with the
debugger in the child, and the FORMAT rune for the child status.
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | consfigurator.asd | 1 | ||||
-rw-r--r-- | doc/connections.rst | 28 | ||||
-rw-r--r-- | src/connection.lisp | 3 | ||||
-rw-r--r-- | src/connection/chroot/fork.lisp | 71 | ||||
-rw-r--r-- | src/package.lisp | 4 |
5 files changed, 106 insertions, 1 deletions
diff --git a/consfigurator.asd b/consfigurator.asd index f651cc9..de0ecaf 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -23,6 +23,7 @@ (:file "src/connection/ssh") (:file "src/connection/sudo") (:file "src/connection/debian-sbcl") + (:file "src/connection/chroot/fork") (:file "src/property/cmd") (:file "src/property/file") (:file "src/data/asdf") diff --git a/doc/connections.rst b/doc/connections.rst index b3e5e1d..88674c9 100644 --- a/doc/connections.rst +++ b/doc/connections.rst @@ -8,4 +8,30 @@ The code which establishes connections (i.e., implementations of the ``ESTABLISH-CONNECTION`` generic) is like code in ``:posix`` properties -- it should restrict its I/O to ``RUN``, ``RUNLINES``, ``READFILE`` and ``WRITEFILE``, functions which access the currently active connection. This -is in order to permit the arbitrary nesting of connections. +is in order to permit the arbitrary nesting of connections. If establishing a +connection really does require more I/O, such as in the case of +``:CHROOT.FORK`` connections, code can call ``LISP-CONNECTION-P``, and either +signal an error, or fall back to another connection type. + +Notes on particular connection types +------------------------------------ + +``:CHROOT.FORK`` +~~~~~~~~~~~~~~~~ + +Since forking is typically only possible when it is not the case that multiple +threads are running, it is better to avoid using this connection type as the +first hop, i.e., directly out of the root Lisp (this is not much of a +restriction, since typically the root Lisp is running under a uid which cannot +use the ``chroot(2)`` system call anyway). More generally, you should avoid +using this connection type within a Lisp image which might try to execute +other deployments in parallel. Typical usage would be something like:: + + (deploy (:sudo :debian-sbcl (:chroot.fork :into "...")) ...) + +In some situations you might want to have a connection chain which effectively +uses a connection type like ``:DEBIAN-SBCL`` twice in a row, so that the first +Lisp image can execute deployments in parallel while the second forks into the +chroot (typically by having a ``DEPLOYS`` property with connection type +``:DEBIAN-SBCL`` as one of the properties applied by a deployment whose +connection chain itself ends with ``:DEBIAN-SBCL``). diff --git a/src/connection.lisp b/src/connection.lisp index 3a09bac..4e0863f 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -61,6 +61,9 @@ For an example of usage, see the :SUDO connection type.")) (defclass posix-connection (connection) ()) +(defun lisp-connection-p () + (subtypep (type-of *connection*) 'lisp-connection)) + ;;; generic functions to operate on subclasses of CONNECTION (defgeneric connection-run (connection cmd input) diff --git a/src/connection/chroot/fork.lisp b/src/connection/chroot/fork.lisp new file mode 100644 index 0000000..48b46d1 --- /dev/null +++ b/src/connection/chroot/fork.lisp @@ -0,0 +1,71 @@ +;;; Consfigurator -- Lisp declarative configuration management system + +;;; Copyright (C) 2021 Sean Whitton <spwhitton@spwhitton.name> + +;;; This file is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3, or (at your option) +;;; any later version. + +;;; This file is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. + +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(in-package :consfigurator.connection.chroot.fork) +#+sbcl (require "sb-posix") + +;; use only implementation-specific fork and waitpid calls to avoid thread +;; woes. chroot(2), however, should be okay. + +(defun fork () + #+sbcl (sb-posix:fork)) + +(defun waitpid (pid options) + ;; normalise any other implementations such that we always return + ;; (values PID EXIT-STATUS), as SB-POSIX:WAITPID does + #+sbcl (sb-posix:waitpid pid options)) + +(defun chroot (path) + #+sbcl (sb-posix:chroot path) + #-(or sbcl) (foreign-funcall "chroot" :string path :int)) + +(defmethod establish-connection ((type (eql :chroot.fork)) remaining &key into) + (unless (lisp-connection-p) + (error "Forking into a chroot requires a Lisp-type connection")) + #-(or sbcl) (error "Don't know how to safely fork() in this Lisp") + (mapc #'force-output + (list *standard-output* *error-output* *debug-io* *terminal-io*)) + (let ((child (fork))) + (case child + ;; note that SB-POSIX:FORK can only return >=0 + (-1 + (error "fork() failed")) + (0 + (handler-case + (progn + (mapc #'clear-input + (list *standard-input* *debug-io* *terminal-io*)) + (unless (zerop (chroot into)) + (error "chroot(2) failed; are you root?")) + ;; note that we can't just + ;; (return-from establish-connection (establish-connection :local) + ;; because we need to kill off the child afterwards, rather than + ;; returning to the child's REPL or whatever else + ;; TODO public interface to DEPLOY* or similar needed here + (consfigurator::deploy* (or remaining :local) consfigurator::*host*) + (uiop:quit 0)) + (serious-condition (c) + (format *error-output* ":CHROOT.FORK child failed: ~A~%" c) + (uiop:quit 2)))) + (t + (multiple-value-bind (_ status) (waitpid child 0) + (declare (ignore _)) + (unless (zerop status) + ;; TODO instead of parsing the status ourselves here, maybe we can + ;; call the various C macros for parsing the status in wait(2) + (error ":CHROOT.FORK child failed, status #x~(~4,'0X~)" status))) + nil)))) diff --git a/src/package.lisp b/src/package.lisp index d3bd27f..f4fcbce 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -62,6 +62,7 @@ #:connection #:lisp-connection #:posix-connection + #:lisp-connection-p #:connection-run #:connection-readfile #:connection-writefile @@ -151,6 +152,9 @@ (defpackage :consfigurator.connection.debian-sbcl (:use #:cl #:consfigurator)) +(defpackage :consfigurator.connection.chroot.fork + (:use #:cl #:consfigurator #:cffi)) + (defpackage :consfigurator.property.cmd (:use #:cl #:consfigurator) (:export #:single)) |