diff options
| -rw-r--r-- | src/connection/chroot.lisp | 4 | ||||
| -rw-r--r-- | src/connection/setuid.lisp | 4 | ||||
| -rw-r--r-- | src/deployment.lisp | 6 | ||||
| -rw-r--r-- | src/package.lisp | 2 | ||||
| -rw-r--r-- | src/property/libvirt.lisp | 2 | ||||
| -rw-r--r-- | src/property/service.lisp | 18 |
6 files changed, 29 insertions, 7 deletions
diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp index 5c149e3..8f829d3 100644 --- a/src/connection/chroot.lisp +++ b/src/connection/chroot.lisp @@ -86,6 +86,10 @@ should be the mount point, without the chroot's root prefixed.") ((type (eql :remote-gid)) connattr (connection chroot-connection)) connattr) +(defmethod propagate-connattr + ((type (eql :no-services)) connattr (connection chroot-connection)) + connattr) + ;;;; :CHROOT.FORK diff --git a/src/connection/setuid.lisp b/src/connection/setuid.lisp index 2036146..59b9e67 100644 --- a/src/connection/setuid.lisp +++ b/src/connection/setuid.lisp @@ -65,3 +65,7 @@ user (connection-connattr connection :remote-home)) ;; We are privileged, so this sets the real, effective and saved IDs. (nix:setgid gid) (nix:initgroups user gid) (nix:setuid uid))) + +(defmethod propagate-connattr + ((type (eql :no-services)) connattr (connection setuid-connection)) + connattr) diff --git a/src/deployment.lisp b/src/deployment.lisp index 444972a..097bb9b 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -306,7 +306,11 @@ PROPERTIES, like DEPLOY-THESE." (defprop reconnects :posix (connections properties) "Connect back to the same host with CONNECTIONS and apply PROPERTIES. Mainly useful for using a connection type like :AS to apply properties as a -different user." +different user. + +Combinators that work by temporarily pushing hostattrs at :APPLY time will not +be able to affect PROPERTIES in an application of RECONNECTS they enclose. +Connection attributes, by contrast, are propagated as usual." (:desc (declare (ignore properties)) (format nil "~S reconnection" connections)) (:preprocess diff --git a/src/package.lisp b/src/package.lisp index 647dd5a..111be69 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -430,6 +430,7 @@ (:local-nicknames (#:os #:consfigurator.property.os) (#:file #:consfigurator.property.file)) (:export #:no-services + #:no-services-p #:running #:restarted #:reloaded @@ -719,6 +720,7 @@ (:use #:cl #:alexandria #:consfigurator) (:local-nicknames (#:os #:consfigurator.property.os) (#:cmd #:consfigurator.property.cmd) + (#:service #:consfigurator.property.service) (#:file #:consfigurator.property.file) (#:chroot #:consfigurator.property.chroot) (#:apt #:consfigurator.property.apt)) diff --git a/src/property/libvirt.lisp b/src/property/libvirt.lisp index 330bade..e7e5009 100644 --- a/src/property/libvirt.lisp +++ b/src/property/libvirt.lisp @@ -98,7 +98,7 @@ subcommand of virsh(1) to convert the running domain into a transient domain." (I.e., if HOST is a string, ensure the domain named HOST is started; if HOST is a HOST value, start the libvirt domain whose name is HOST's hostname.)" (:desc #?"libvirt domain ${(get-hostname host)} started") - (:check (host-domain-started-p host)) + (:check (or (service:no-services-p) (host-domain-started-p host))) (:apply (mrun "virsh" "start" (get-hostname host)))) (defprop destroyed :posix (host) diff --git a/src/property/service.lisp b/src/property/service.lisp index bf6900c..ad920c9 100644 --- a/src/property/service.lisp +++ b/src/property/service.lisp @@ -18,7 +18,11 @@ (in-package :consfigurator.property.service) (named-readtables:in-readtable :consfigurator) -;;;; Controlling services using service(1) +;;;; Controlling services using service(1), and the :NO-SERVICES hostattr and +;;;; connattr. A host has the :NO-SERVICES hostattr when it has static +;;;; configuration never to start services. The connattr is for when we +;;;; should not start any services because we're doing something like +;;;; chrooting in to the host's unbooted root filesystem. (define-constant +policyrcd+ #P"/usr/sbin/policy-rc.d" :test #'equal) @@ -48,8 +52,12 @@ not affect you." (os:etypecase (debianlike (%policy-rc.d)))) +(defun no-services-p () + "Returns true if no services should be started by the current deployment." + (or (get-hostattrs-car :no-service) (get-connattr :no-services))) + (defun service (service action) - (unless (get-hostattrs-car :no-services) + (unless (no-services-p) (run :may-fail "service" service action))) (defprop running :posix (service) @@ -72,7 +80,8 @@ properties." (:apply (service service "reload"))) (define-function-property-combinator without-starting-services (&rest propapps) - "Apply PROPAPPS with SERVICE:NO-SERVICES temporarily in effect." + "Apply PROPAPPS with the :NO-SERVICES connattr temporarily in effect. Also +disable starting services by the package manager." (let ((propapp (if (cdr propapps) (apply #'eseqprops propapps) (car propapps)))) (:retprop :type :lisp :hostattrs @@ -88,8 +97,7 @@ properties." ;; past. (SLEEP 1) is only approximately one second so ;; check that it's actually been a second. (loop do (sleep 1) until (> (get-universal-time) before)) - (unwind-protect (with-preserve-hostattrs - (push-hostattrs :no-services t) + (unwind-protect (with-connattrs (:no-services t) (propappapply propapp)) (if already-exists ;; Check whether some property we applied set the |