diff options
| -rw-r--r-- | src/combinator.lisp | 66 | ||||
| -rw-r--r-- | src/deployment.lisp | 6 | ||||
| -rw-r--r-- | src/host.lisp | 2 | ||||
| -rw-r--r-- | src/package.lisp | 14 | ||||
| -rw-r--r-- | src/property.lisp | 24 | ||||
| -rw-r--r-- | src/property/container.lisp | 8 | ||||
| -rw-r--r-- | src/property/disk.lisp | 6 | ||||
| -rw-r--r-- | src/property/installer.lisp | 6 | ||||
| -rw-r--r-- | src/property/libvirt.lisp | 6 | ||||
| -rw-r--r-- | src/property/lxc.lisp | 6 | ||||
| -rw-r--r-- | src/property/package.lisp | 10 | ||||
| -rw-r--r-- | src/property/periodic.lisp | 4 | ||||
| -rw-r--r-- | src/property/postfix.lisp | 4 | ||||
| -rw-r--r-- | src/property/service.lisp | 9 |
14 files changed, 86 insertions, 85 deletions
diff --git a/src/combinator.lisp b/src/combinator.lisp index 9a92362..b6d9811 100644 --- a/src/combinator.lisp +++ b/src/combinator.lisp @@ -26,7 +26,7 @@ Usage notes: - If you need to read individual arguments to propapps passed as arguments to - NAME, call PROPAPPARGS to access them. For passing a whole list of args on + NAME, call PROPAPP-ARGS to access them. For passing a whole list of args on to a property subroutine, just take the cdr of the propapp. For an example showing both techniques at work, see POSTFIX:MAPPED-FILE." @@ -53,16 +53,16 @@ Usage notes: (:retprop :type ,type :desc (lambda (&rest args) (declare (ignore args)) - (propappdesc (choose-propapp))) + (propapp-desc (choose-propapp))) :hostattrs (lambda (&rest args) (declare (ignore args)) - (propappattrs (choose-propapp))) + (propapp-attrs (choose-propapp))) :apply (lambda (&rest args) (declare (ignore args)) - (propappapply (choose-propapp))) + (apply-propapp (choose-propapp))) :unapply (lambda (&rest args) (declare (ignore args)) - (propappunapply (choose-propapp)))))) + (unapply-propapp (choose-propapp)))))) (setf (get ',name 'inline-combinator) t))) ;; There can be multiple SKIP-* restarts with the same name established at @@ -99,7 +99,7 @@ Usage notes: (define-function-property-combinator eseqprops (&rest propapps) (:retprop :type (combine-propapp-types propapps) - :hostattrs (lambda () (mapc #'propappattrs propapps)) + :hostattrs (lambda () (mapc #'propapp-attrs propapps)) :apply (lambda () (apply-and-print propapps)) :unapply (lambda () (apply-and-print propapps t)))) @@ -107,7 +107,7 @@ Usage notes: "Like ESEQPROPS, but if CONDITION is signalled, handle it simply by skipping remaining elements of PROPAPPS. CONDITION must subtype FAILED-CHANGE." (:retprop :type (combine-propapp-types propapps) - :hostattrs (lambda () (mapc #'propappattrs propapps)) + :hostattrs (lambda () (mapc #'propapp-attrs propapps)) :apply (lambda () (with-skip-failed-changes (:condition condition :restart 'skip-sequence) @@ -119,7 +119,7 @@ remaining elements of PROPAPPS. CONDITION must subtype FAILED-CHANGE." (define-function-property-combinator seqprops (&rest propapps) (:retprop :type (combine-propapp-types propapps) - :hostattrs (lambda () (mapc #'propappattrs propapps)) + :hostattrs (lambda () (mapc #'propapp-attrs propapps)) :apply (lambda () (with-skip-failed-changes () (apply-and-print propapps))) @@ -135,7 +135,7 @@ apply the elements of REQUIREMENTS in reverse order." (define-function-property-combinator silent-seqprops (&rest propapps) (:retprop :type (combine-propapp-types propapps) - :hostattrs (lambda () (mapc #'propappattrs propapps)) + :hostattrs (lambda () (mapc #'propapp-attrs propapps)) :apply (lambda () (with-skip-failed-changes () (apply-and-print propapps nil t))) @@ -177,7 +177,7 @@ apply the elements of REQUIREMENTS in reverse order." (princ buffer)) (when announce (informat t "~&~@[~A :: ~]~@[~A ... ~]~A~%" - (get-hostname) (propappdesc propapp) status)) + (get-hostname) (propapp-desc propapp) status)) ;; Ensure POST-APPLY called exactly once for each propapp. (setq propapp nil))) @@ -186,10 +186,10 @@ apply the elements of REQUIREMENTS in reverse order." (pareport (s) (format s "Skip (~{~S~^ ~})" - (cons (car propapp) (propappargs propapp)))) + (cons (car propapp) (propapp-args propapp)))) (seqreport (s) (format s "Skip remainder of sequence containing (~{~S~^ ~})" - (cons (car propapp) (propappargs propapp))))) + (cons (car propapp) (propapp-args propapp))))) (unwind-protect ;; Establish restarts to be invoked by WITH-SKIP-FAILED-CHANGES ;; or possibly interactively by the user. There are two of each @@ -199,11 +199,11 @@ apply the elements of REQUIREMENTS in reverse order." (with-output-to-string (*standard-output* buffer) (with-indented-inform (if unapply - (propappunapply propapp) - (propappapply propapp)))) + (unapply-propapp propapp) + (apply-propapp propapp)))) (if unapply - (propappunapply propapp) - (propappapply propapp))) + (unapply-propapp propapp) + (apply-propapp propapp))) (accumulate it) (post-apply (if (eql it :no-change) "ok" "done"))) ;; Standard restarts for skipping over sequence entries. @@ -256,17 +256,17 @@ property instead of applying it." :args args))) (define-function-property-combinator desc (desc propapp) - (:retprop :type (propapptype propapp) + (:retprop :type (propapp-type propapp) :desc (lambda () desc) :hostattrs (lambda (&rest args) (declare (ignore args)) - (propappattrs propapp)) + (propapp-attrs propapp)) :apply (lambda (&rest args) (declare (ignore args)) - (propappapply propapp)) + (apply-propapp propapp)) :unapply (lambda (&rest args) (declare (ignore args)) - (propappunapply propapp)))) + (unapply-propapp propapp)))) (defmacro on-change (propapp &body on-change) "If applying or unapplying PROPAPP makes a change, also apply each of the @@ -290,15 +290,15 @@ in order." :desc (get prop 'desc) :hostattrs (lambda (&rest args) (apply #'propattrs prop args) - (propappattrs on-change)) + (propapp-attrs on-change)) :apply (lambda (&rest args) (aprog1 (apply #'propapply prop args) (unless (eql it :no-change) - (propappapply on-change)))) + (apply-propapp on-change)))) :unapply (lambda (&rest args) (aprog1 (apply #'propunapply prop args) (when (and unapply (not (eql it :no-change))) - (propappapply on-change)))) + (apply-propapp on-change)))) :args (cdr propapp)))) (defmacro as (user &body properties) @@ -323,18 +323,18 @@ FLAGFILE exists, PROPAPPS are assumed to all be already applied." ,(if (cdr propapps) `(eseqprops ,@propapps) (car propapps)))) (define-function-property-combinator with-flagfile* (flagfile propapp) - (:retprop :type (propapptype propapp) + (:retprop :type (propapp-type propapp) :desc (get (car propapp) 'desc) :hostattrs (get (car propapp) 'hostattrs) :check (lambda-ignoring-args (remote-exists-p flagfile)) :apply (lambda-ignoring-args - (prog1 (propappapply propapp) + (prog1 (apply-propapp propapp) (mrun "mkdir" "-p" (pathname-directory-pathname flagfile)) (mrun "touch" flagfile))) :unapply (lambda-ignoring-args - (prog1 (propappunapply propapp) + (prog1 (unapply-propapp propapp) (mrun "rm" "-f" flagfile))) :args (cdr propapp))) @@ -358,13 +358,13 @@ an :UNAPPLY subroutine for a property which works by calling other properties." (if unapply (:retprop :type (combine-propapp-types apply (cdr unapply)) :hostattrs (lambda-ignoring-args - (propappattrs apply-propapp) + (propapp-attrs apply-propapp) ;; as in definition of UNAPPLIED combinator (with-preserve-hostattrs - (propappattrs unapply-propapp))) - :apply (lambda-ignoring-args (propappapply apply-propapp)) + (propapp-attrs unapply-propapp))) + :apply (lambda-ignoring-args (apply-propapp apply-propapp)) :unapply (lambda-ignoring-args - (propappapply unapply-propapp))) + (apply-propapp unapply-propapp))) apply-propapp))) (defmacro with-homedir ((&key user dir) &body propapps) @@ -391,9 +391,9 @@ DIR or the home directory of USER." (unwind-protect (funcall f propapp) (setf (getenv "HOME") orig))) (funcall f propapp))))))) - (:retprop :type (propapptype propapp) + (:retprop :type (propapp-type propapp) :desc (get (car propapp) 'desc) :hostattrs (get (car propapp) 'hostattrs) - :apply (lambda-ignoring-args (change #'propappapply)) - :unapply (lambda-ignoring-args (change #'propappunapply)) + :apply (lambda-ignoring-args (change #'apply-propapp)) + :unapply (lambda-ignoring-args (change #'unapply-propapp)) :args (cdr propapp)))) diff --git a/src/deployment.lisp b/src/deployment.lisp index df1d243..b28fc69 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -42,13 +42,13 @@ preprocessed." (labels ((apply-*host*-propspec () (let ((propapp (eval-propspec (host-propspec *host*)))) - (assert-connection-supports (propapptype propapp)) + (assert-connection-supports (propapp-type propapp)) (if collect-at-end (let (*at-end-functions*) - (let ((result (propappapply propapp))) + (let ((result (apply-propapp propapp))) (dolist (function *at-end-functions* result) (funcall function result)))) - (propappapply propapp)))) + (apply-propapp propapp)))) (connect (connections) (destructuring-bind ((type . args) . remaining) connections ;; implementations of ESTABLISH-CONNECTION which call diff --git a/src/host.lisp b/src/host.lisp index 6a638e6..0f4106f 100644 --- a/src/host.lisp +++ b/src/host.lisp @@ -96,7 +96,7 @@ values higher up the call stack.")) :hostattrs (copy-list (hostattrs host)) :propspec (preprocess-propspec (host-propspec host)))) (*preprocessing-host* host)) - (propappattrs (eval-propspec (host-propspec *host*))) + (propapp-attrs (eval-propspec (host-propspec *host*))) *host*)) (defun make-host diff --git a/src/package.lisp b/src/package.lisp index 71f5384..953732a 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -192,13 +192,13 @@ ;; property.lisp #:combine-propapp-types - #:propapptype - #:propappargs - #:propappdesc - #:propappattrs - #:propappcheck - #:propappapply - #:propappunapply + #:propapp-type + #:propapp-args + #:propapp-desc + #:propapp-attrs + #:check-propapp + #:apply-propapp + #:unapply-propapp #:ignoring-hostattrs #:defprop #:defpropspec diff --git a/src/property.lisp b/src/property.lisp index 80c6618..10d9cf2 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -58,24 +58,24 @@ (defun proppp (prop) (get prop 'preprocess (lambda (&rest args) args))) -(defun propapptype (propapp) +(defun propapp-type (propapp) (if propapp (get (car propapp) 'ptype) :posix)) -(defun propappargs (propapp) +(defun propapp-args (propapp) (if (and (listp (cadr propapp)) (member :orig-args (cadr propapp))) (getf (cadr propapp) :orig-args) (cdr propapp))) (defun combine-propapp-types (&rest lists) - (if (member :lisp (mapcan (curry #'mapcar #'propapptype) lists)) + (if (member :lisp (mapcan (curry #'mapcar #'propapp-type) lists)) :lisp :posix)) (defun propdesc (prop &rest args) (apply (get prop 'desc (lambda-ignoring-args)) args)) -(defun propappdesc (propapp) +(defun propapp-desc (propapp) (when propapp (apply #'propdesc propapp))) @@ -85,14 +85,14 @@ (defun propattrs (prop &rest args) (apply (get prop 'hostattrs (lambda-ignoring-args)) args)) -(defun propappattrs (propapp) +(defun propapp-attrs (propapp) (when propapp (apply #'propattrs propapp))) (defun propcheck (prop &rest args) (apply (get prop 'check (lambda-ignoring-args)) args)) -(defun propappcheck (propapp) +(defun check-propapp (propapp) (if propapp (apply #'propcheck propapp) t)) (defmacro with-some-errors-are-failed-change (&body forms) @@ -106,7 +106,7 @@ :no-change (apply (get prop 'papply (constantly :no-change)) args)))) -(defun propappapply (propapp) +(defun apply-propapp (propapp) (if propapp (apply #'propapply propapp) :no-change)) @@ -130,7 +130,7 @@ (failed-change "Attempt to unapply property with :APPLY subroutine but no :UNAPPLY subroutine.")))))) -(defun propappunapply (propapp) +(defun unapply-propapp (propapp) (if propapp (apply #'propunapply propapp) :no-change)) @@ -410,11 +410,11 @@ You can usually use DEFPROPLIST instead of DEFPROPSPEC, which see." (setf (getf slots :apply) '(lambda (plist) (let ((propapp (eval-propspec (getf plist :propspec)))) - (assert-connection-supports (propapptype propapp)) - (propappapply propapp)))) + (assert-connection-supports (propapp-type propapp)) + (apply-propapp propapp)))) (setf (getf slots :unapply) '(lambda (plist) - (propappunapply (eval-propspec (getf plist :propspec))))) + (unapply-propapp (eval-propspec (getf plist :propspec))))) (loop while (and (listp (car forms)) (keywordp (caar forms))) do (setf (getf slots (caar forms)) `(lambda (plist) @@ -438,7 +438,7 @@ You can usually use DEFPROPLIST instead of DEFPROPSPEC, which see." (getf plist :orig-args) ,@forms)))))) (setf (getf plist :propspec) propspec) - (propappattrs (eval-propspec propspec)))))) + (propapp-attrs (eval-propspec propspec)))))) (defmacro defproplist (name type lambda &body properties) "Like DEFPROPSPEC, but define the function which yields the propspec using the diff --git a/src/property/container.lisp b/src/property/container.lisp index 454cd75..b23d3df 100644 --- a/src/property/container.lisp +++ b/src/property/container.lisp @@ -57,11 +57,11 @@ container type." always (member factor host-contained))) ,form :no-change)))) - (:retprop :type (propapptype propapp) + (:retprop :type (propapp-type propapp) :hostattrs (lambda-ignoring-args - (propappattrs propapp)) + (propapp-attrs propapp)) :apply (lambda-ignoring-args - (check-contained (propappapply propapp))) + (check-contained (apply-propapp propapp))) :unapply (lambda-ignoring-args - (check-contained (propappunapply propapp))) + (check-contained (unapply-propapp propapp))) :args (cdr propapp)))) diff --git a/src/property/disk.lisp b/src/property/disk.lisp index fd0df1b..52a9047 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -750,17 +750,17 @@ must not be modified." (define-function-property-combinator with-these-open-volumes* (volumes propapp &key (mount-below nil mount-below-supplied-p)) (:retprop - :type (propapptype propapp) + :type (propapp-type propapp) :hostattrs (lambda-ignoring-args (require-volumes-data volumes) - (propappattrs propapp)) + (propapp-attrs propapp)) :apply (lambda-ignoring-args (with-connattrs (:opened-volumes (apply #'open-volumes-and-contents `(,volumes ,@(and mount-below-supplied-p `(:mount-below ,mount-below))))) - (unwind-protect (propappapply propapp) + (unwind-protect (apply-propapp 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 60c17d7..bad2255 100644 --- a/src/property/installer.lisp +++ b/src/property/installer.lisp @@ -57,7 +57,7 @@ BOOTLOADER-TYPE to VOLUME.")) %install-bootloaders (running-on-target &rest propapps) (:retprop :type :lisp - :hostattrs (lambda () (mapc #'propappattrs propapps)) + :hostattrs (lambda () (mapc #'propapp-attrs propapps)) :apply (lambda () (mapc #'consfigure @@ -160,10 +160,10 @@ using a combinator like ON-CHANGE, or applied manually with DEPLOY-THESE." ;;; the definition of SERVICES:WITHOUT-STARTING-SERVICES to *AT-END-FUNCTIONS* ;;; 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 +;;; %CONSFIGURE's call to APPLY-PROPAPP; 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 +;;; was a normal return from APPLY-PROPAPP, whereas the cleanup forms from ;;; SERVICES:WITHOUT-STARTING-SERVICES would always be evaluated. (defprop %root-filesystems-flipped :lisp (new-os old-os) diff --git a/src/property/libvirt.lisp b/src/property/libvirt.lisp index fff40d1..8ce80e1 100644 --- a/src/property/libvirt.lisp +++ b/src/property/libvirt.lisp @@ -120,13 +120,13 @@ already running, for a VM which is not always booted, e.g. on a laptop." (macrolet ((check-started (form) `(if (host-domain-started-p host) ,form :no-change))) - (:retprop :type (propapptype propapp) + (:retprop :type (propapp-type propapp) :desc (get (car propapp) 'desc) :hostattrs (get (car propapp) 'hostattrs) :apply (lambda-ignoring-args - (check-started (propappapply propapp))) + (check-started (apply-propapp propapp))) :unapply (lambda-ignoring-args - (check-started (propappunapply propapp))) + (check-started (unapply-propapp propapp))) :args (cdr propapp)))) ;; Another possible approach would be to convert DISK:VOLUME values to --disk diff --git a/src/property/lxc.lisp b/src/property/lxc.lisp index 02575ae..36fbd95 100644 --- a/src/property/lxc.lisp +++ b/src/property/lxc.lisp @@ -56,13 +56,13 @@ and owned by OWNER, defaulting to the current user, is already started." when-user-container-running* (host owner propapp) (macrolet ((check-running (form) `(if (user-container-running-p host owner) ,form :no-change))) - (:retprop :type (propapptype propapp) + (:retprop :type (propapp-type propapp) :desc (get (car propapp) 'desc) :hostattrs (get (car propapp) 'hostattrs) :apply (lambda-ignoring-args - (check-running (propappapply propapp))) + (check-running (apply-propapp propapp))) :unapply (lambda-ignoring-args - (check-running (propappunapply propapp))) + (check-running (unapply-propapp propapp))) :args (cdr propapp)))) (defproplist user-containers-autostart :posix (user) diff --git a/src/property/package.lisp b/src/property/package.lisp index 4548056..c4bb24c 100644 --- a/src/property/package.lisp +++ b/src/property/package.lisp @@ -38,11 +38,11 @@ Implementations should not fail just because we are not root, or otherwise privileged, if the package is already installed.")) (defmethod %installed ((package-manager (eql :apt)) packages) - ;; Call PROPAPPAPPLY directly because we want the :CHECK subroutine run, but - ;; it does not make sense to run the :HOSTATTRS subroutine because *HOST* - ;; does not necessarily correspond to the host we're attempting to install - ;; packages on. - (propappapply `(apt:installed ,@packages))) + ;; Call APPLY-PROPAPP directly because we want the :CHECK subroutine run, + ;; but it does not make sense to run the :HOSTATTRS subroutine because + ;; *HOST* does not necessarily correspond to the host we're attempting to + ;; install packages on. + (apply-propapp `(apt:installed ,@packages))) (define-simple-error package-manager-not-found (aborted-change)) diff --git a/src/property/periodic.lisp b/src/property/periodic.lisp index 4a75182..6dfd707 100644 --- a/src/property/periodic.lisp +++ b/src/property/periodic.lisp @@ -45,7 +45,7 @@ user." (merge-pathnames "at-most/" (get-connattr :consfigurator-cache))))) (destructuring-bind (psym . args) propapp - (:retprop :type (propapptype propapp) + (:retprop :type (propapp-type propapp) :desc (lambda-ignoring-args desc) :hostattrs (get psym 'hostattrs) :check @@ -63,7 +63,7 @@ user." (:yearly (< now (+ #.(ceiling (* 365.25 24 60 60)) mtime))))))) :apply (lambda-ignoring-args - (prog1 (propappapply propapp) + (prog1 (apply-propapp propapp) (file:containing-directory-exists flagfile) (mrun "touch" flagfile))) :args args)))) diff --git a/src/property/postfix.lisp b/src/property/postfix.lisp index 82a2ae2..75e25ec 100644 --- a/src/property/postfix.lisp +++ b/src/property/postfix.lisp @@ -37,10 +37,10 @@ (reloaded)))) (define-function-property-combinator mapped-file - (propapp &optional (file (car (propappargs propapp)))) + (propapp &optional (file (car (propapp-args propapp)))) "Apply PROPAPP, and if it makes a change, run postmap(1) on FILE, which defaults to the first argument to PROPAPP." - (:retprop :type (propapptype propapp) + (:retprop :type (propapp-type propapp) :desc (get (car propapp) 'desc) :check (get (car propapp) 'check) :hostattrs (get (car propapp) 'hostattrs) diff --git a/src/property/service.lisp b/src/property/service.lisp index ad920c9..6650244 100644 --- a/src/property/service.lisp +++ b/src/property/service.lisp @@ -84,8 +84,9 @@ properties." disable starting services by the package manager." (let ((propapp (if (cdr propapps) (apply #'eseqprops propapps) (car propapps)))) (:retprop :type :lisp - :hostattrs - (lambda () (propappattrs propapp) (os:required 'os:debianlike)) + :hostattrs (lambda () + (propapp-attrs propapp) + (os:required 'os:debianlike)) :apply (lambda (&aux (already-exists (file-exists-p +policyrcd+))) (with-remote-temporary-file (temp :directory "/usr/sbin") @@ -98,7 +99,7 @@ disable starting services by the package manager." ;; check that it's actually been a second. (loop do (sleep 1) until (> (get-universal-time) before)) (unwind-protect (with-connattrs (:no-services t) - (propappapply propapp)) + (apply-propapp propapp)) (if already-exists ;; Check whether some property we applied set the ;; contents of /usr/sbin/policy-rc.d, in which case @@ -107,4 +108,4 @@ disable starting services by the package manager." (rename-file temp +policyrcd+)) (when (file-exists-p +policyrcd+) (delete-file +policyrcd+))))))) - :unapply (lambda () (propappunapply propapp))))) + :unapply (lambda () (unapply-propapp propapp))))) |