diff options
| -rw-r--r-- | consfigurator.asd | 1 | ||||
| -rw-r--r-- | doc/introduction.rst | 4 | ||||
| -rw-r--r-- | src/combinator.lisp | 5 | ||||
| -rw-r--r-- | src/connection/as.lisp | 36 | ||||
| -rw-r--r-- | src/deployment.lisp | 25 | ||||
| -rw-r--r-- | src/package.lisp | 7 |
6 files changed, 72 insertions, 6 deletions
diff --git a/consfigurator.asd b/consfigurator.asd index 1ef0483..5cf18cc 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -40,6 +40,7 @@ (:file "src/connection/chroot/fork") (:file "src/connection/chroot/shell") (:file "src/connection/setuid") + (:file "src/connection/as") (:file "src/data/asdf") (:file "src/data/pgp") (:file "src/data/git-snapshot") diff --git a/doc/introduction.rst b/doc/introduction.rst index f724401..a99fb69 100644 --- a/doc/introduction.rst +++ b/doc/introduction.rst @@ -56,6 +56,10 @@ Try it out / quick start (apt:service-installed-running "apache2") + ;; Apply some properties as a non-root user. + (as "spwhitton" + (gnupg:public-key-imported "8DC2 487E 51AB DD90 B5C4 753F 0F56 D055 3B6D 411B")) + (file:has-content "/etc/foo" #?{Here is my file content. You can use ${my-substitution} thanks to CL-INTERPOL. diff --git a/src/combinator.lisp b/src/combinator.lisp index c6e89e7..23c8575 100644 --- a/src/combinator.lisp +++ b/src/combinator.lisp @@ -130,3 +130,8 @@ ON-CHANGE in order." (dolist (propapp (reverse propapps)) (propappunapply propapp)))) :args (cdr propapp))) + +(defmacro as (user &body properties) + "Apply PROPERTIES as USER by reconnecting to the host with the :AS connection +type." + `(deploys-these. `((:as :to ,,user)) :parent ,@properties)) diff --git a/src/connection/as.lisp b/src/connection/as.lisp new file mode 100644 index 0000000..b5a9f69 --- /dev/null +++ b/src/connection/as.lisp @@ -0,0 +1,36 @@ +;;; 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.as) +(named-readtables:in-readtable :consfigurator) + +;; currently we only check whether we're root, but, for example, on Linux, we +;; might have a CAP_* which lets us setuid as non-root +(defun can-setuid () + (zerop (foreign-funcall "geteuid" :int))) + +(defmethod establish-connection ((type (eql :as)) remaining &key to) + "Establish a :SETUID or :SUDO connection to another user account, depending +on whether it is possible to establish a :SETUID connection. + +This connection type does not support sudo with a password -- it is designed +to be used as root." + (if (and (lisp-connection-p) + (can-setuid) + (can-probably-fork)) + (establish-connection :setuid remaining :to to) + (establish-connection :sudo remaining :user to))) diff --git a/src/deployment.lisp b/src/deployment.lisp index 42c6137..34393c2 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -188,17 +188,30 @@ Also useful to set up VMs, chroots, disk images etc. on localhost." (defprop deploys-these :posix (connections host &optional properties) "Like DEPLOYS, except apply to HOST each of the properties specified by PROPERTIES, and not the host's usual properties, unless they also appear in -PROPERTIES, like DEPLOY-THESE." +PROPERTIES, like DEPLOY-THESE. + +As a special case, if HOST is :PARENT, use the host to which this property is +being applied. This is useful to apply properties to the host with a +different connection type; for example, by switching to another user account +with the :AS connection type. Note that any new hostattrs set by PROPERTIES +will not affect the rest of the deployment, except requests for items of +prerequisite data to be supplied." (:preprocess (list (preprocess-connections connections) - (preprocess-host - (%replace-propspec-into-host (shallow-copy-host host) properties)))) + (list :host host) + properties)) (:hostattrs - (declare (ignore connections properties)) - (%propagate-hostattrs host)) + (declare (ignore connections)) + (setf (getf host :host) + (preprocess-host + (if (eql :parent (getf host :host)) + (make-host :hostattrs (copy-list (hostattrs *host*)) + :propspec properties) + (shallow-copy-host (getf host :host))))) + (%propagate-hostattrs (getf host :host))) (:apply (declare (ignore properties)) - (%consfigure connections host))) + (%consfigure connections (getf host :host)))) (defun preprocess-connections (connections) (loop for connection in (ensure-cons connections) diff --git a/src/package.lisp b/src/package.lisp index 69136fc..0f33b7d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -137,6 +137,7 @@ #:silent-seqprops #:unapply #:on-change + #:as ;; host.lisp #:host @@ -282,6 +283,12 @@ (:export #:with-fork-connection #:can-probably-fork)) +(defpackage :consfigurator.connection.as + (:use #:cl + #:consfigurator + #:consfigurator.connection.fork + #:cffi)) + (defpackage :consfigurator.connection.ssh (:use #:cl #:consfigurator |