diff options
| -rw-r--r-- | src/combinator.lisp | 9 | ||||
| -rw-r--r-- | src/connection.lisp | 3 | ||||
| -rw-r--r-- | src/connection/chroot.lisp | 2 | ||||
| -rw-r--r-- | src/deployment.lisp | 2 | ||||
| -rw-r--r-- | src/package.lisp | 2 | ||||
| -rw-r--r-- | src/property/disk.lisp | 2 | ||||
| -rw-r--r-- | src/property/installer.lisp | 14 | ||||
| -rw-r--r-- | src/property/service.lisp | 7 | ||||
| -rw-r--r-- | src/util.lisp | 27 |
9 files changed, 19 insertions, 49 deletions
diff --git a/src/combinator.lisp b/src/combinator.lisp index a4274ee..cf73cce 100644 --- a/src/combinator.lisp +++ b/src/combinator.lisp @@ -173,11 +173,10 @@ apply the elements of REQUIREMENTS in reverse order." ;; the user or a combinator invokes a SKIP-PROPERTY restart ;; established further down the property call stack. (result 'failed-change)) - (unwind-protect-in-parent - (with-skip-property propapp - (setq result (if announce - (announce-propapp-apply propapp) - (propapp-apply propapp)))) + (unwind-protect (with-skip-property propapp + (setq result (if announce + (announce-propapp-apply propapp) + (propapp-apply propapp)))) (when (and (plusp (length buffer)) (or (> *consfigurator-debug-level* 1) (not (eql result :no-change)))) diff --git a/src/connection.lisp b/src/connection.lisp index 6ceb837..c2b235d 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -264,8 +264,7 @@ which will be cleaned up when BODY is finished." `(let ((,file (mktemp ,@(and directory-supplied-p `(:directory ,directory)) :connection ,connection))) - (unwind-protect-in-parent - (progn ,@body) + (unwind-protect (progn ,@body) (connection-run ,connection (format nil "rm -f ~A" (escape-sh-token ,file)) nil))))) diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp index 836124f..b934252 100644 --- a/src/connection/chroot.lisp +++ b/src/connection/chroot.lisp @@ -127,7 +127,7 @@ should be the mount point, without the chroot's root prefixed.") (ensure-pathname (stripln (subseq datadir-inside 1)) :defaults into* :ensure-absolute t :ensure-directory t)) - (unwind-protect-in-parent (continue-connection connection remaining) + (unwind-protect (continue-connection connection remaining) (connection-teardown connection))))) (defmethod post-fork ((connection chroot.fork-connection)) diff --git a/src/deployment.lisp b/src/deployment.lisp index 147bfa6..fe56a7a 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -57,7 +57,7 @@ preprocessed." (multiple-value-bind (*connection* return) (apply #'establish-connection type remaining args) (if *connection* - (unwind-protect-in-parent + (unwind-protect (if remaining (connect remaining) (apply-*host*-propspec)) (connection-teardown *connection*)) return))))) diff --git a/src/package.lisp b/src/package.lisp index 5d2166b..668b9e1 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -115,8 +115,6 @@ #:string->filename #:filename->string - #:unwind-protect-in-parent - #:cancel-unwind-protect-in-parent-cleanup #:with-backtrace-and-exit-code #:return-exit #:posix-login-environment diff --git a/src/property/disk.lisp b/src/property/disk.lisp index dea18f8..3fa97ee 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -759,7 +759,7 @@ must not be modified." (apply #'open-volumes-and-contents `(,volumes ,@(and mount-below-supplied-p `(:mount-below ,mount-below))))) - (unwind-protect-in-parent (propappapply propapp) + (unwind-protect (propappapply propapp) (mrun "sync") (mapc #'close-volume (get-connattr :opened-volumes))))) :args (cdr propapp))) diff --git a/src/property/installer.lisp b/src/property/installer.lisp index 0196438..f5a3806 100644 --- a/src/property/installer.lisp +++ b/src/property/installer.lisp @@ -158,13 +158,13 @@ using a combinator like ON-CHANGE, or applied manually with DEPLOY-THESE." ;;; Another option would be a new SERVICES:WITHOUT-STARTING-SERVICES-UNTIL-END ;;; which would disable starting services and push the cleanup forms inside ;;; the definition of SERVICES:WITHOUT-STARTING-SERVICES to *AT-END-FUNCTIONS* -;;; in a closure. We'd also want %CONSFIGURE to use UNWIND-PROTECT-IN-PARENT -;;; to ensure that the AT-END functions get run even when there's a nonlocal -;;; exit from %CONSFIGURE's call to PROPAPPAPPLY; perhaps we could pass a -;;; second argument to the AT-END functions indicating whether there was a -;;; non-local transfer of control. REBOOT:REBOOTED-AT-END might only reboot -;;; when there was a normal return from PROPAPPAPPLY, whereas the cleanup -;;; forms from SERVICES:WITHOUT-STARTING-SERVICES would always be evaluated. +;;; in a closure. We'd also want %CONSFIGURE to use UNWIND-PROTECT to ensure +;;; that the AT-END functions get run even when there's a nonlocal exit from +;;; %CONSFIGURE's call to PROPAPPAPPLY; perhaps we could pass a second +;;; argument to the AT-END functions indicating whether there was a non-local +;;; transfer of control. REBOOT:REBOOTED-AT-END might only reboot when there +;;; was a normal return from PROPAPPAPPLY, whereas the cleanup forms from +;;; SERVICES:WITHOUT-STARTING-SERVICES would always be evaluated. (defprop %root-filesystems-flipped :lisp (new-os old-os) (:hostattrs (os:required 'os:linux)) diff --git a/src/property/service.lisp b/src/property/service.lisp index 247cb2d..bf6900c 100644 --- a/src/property/service.lisp +++ b/src/property/service.lisp @@ -88,10 +88,9 @@ 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-in-parent - (with-preserve-hostattrs - (push-hostattrs :no-services t) - (propappapply propapp)) + (unwind-protect (with-preserve-hostattrs + (push-hostattrs :no-services t) + (propappapply propapp)) (if already-exists ;; Check whether some property we applied set the ;; contents of /usr/sbin/policy-rc.d, in which case diff --git a/src/util.lisp b/src/util.lisp index 5524188..2e48bce 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -507,31 +507,6 @@ previous output." ;;;; Forking utilities -(define-condition in-child-process () ()) - -(defmacro unwind-protect-in-parent (protected &body cleanup) - "Like UNWIND-PROTECT, but with a mechanism to cancel the execution of CLEANUP -in child processes resulting from calls to fork(2) during the execution of -PROTECTED. This means that CLEANUP won't get executed on both sides of the -fork, but only in the parent. - -For this to work, after fork(2), the child process must call -CANCEL-UNWIND-PROTECT-IN-PARENT-CLEANUP, which will affect all enclosing uses -of this macro." - (with-gensyms (cancelled) - `(let (,cancelled) - (unwind-protect - (handler-bind ((in-child-process (lambda (c) - (declare (ignore c)) - (setq ,cancelled t)))) - ,protected) - (unless ,cancelled ,@cleanup))))) - -(defun cancel-unwind-protect-in-parent-cleanup () - "Cancel the CLEANUP forms in all enclosing uses of UNWIND-PROTECT-IN-PARENT. -Should be called soon after fork(2) in child processes." - (signal 'in-child-process)) - ;;; Use only implementation-specific fork, waitpid etc. calls to avoid thread ;;; woes. Things like chroot(2) and setuid(2), however, should be okay. @@ -653,7 +628,7 @@ Does not currently establish a PAM session." `(let* ((,before (and (file-exists-p ,file) (read-file-string ,file))) (,data (and ,before (plusp (length ,before)) (safe-read-from-string ,before)))) - (unwind-protect-in-parent (progn ,@forms) + (unwind-protect (progn ,@forms) (with-open-file (stream ,file :direction :output :if-exists :supersede) (with-standard-io-syntax |