From 210a2d70570792f8fac53960557232de910bff37 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 5 Sep 2021 15:38:46 -0700 Subject: add dep on Anaphora and use APROG1, ALET & AAND in various places Signed-off-by: Sean Whitton --- consfigurator.asd | 3 ++- debian/changelog | 7 +++++++ debian/control | 2 ++ src/connection.lisp | 4 ++-- src/connection/chroot.lisp | 7 +++---- src/connection/ssh.lisp | 5 ++--- src/connection/sudo.lisp | 9 ++++----- src/data.lisp | 7 +++---- src/package.lisp | 21 ++++++++++++++++----- src/property.lisp | 30 ++++++++++++++---------------- src/property/crypttab.lisp | 5 ++--- src/property/disk.lisp | 7 +++---- src/property/firewalld.lisp | 13 ++++++------- src/property/fstab.lisp | 6 ++---- src/propspec.lisp | 5 ++--- 15 files changed, 70 insertions(+), 61 deletions(-) diff --git a/consfigurator.asd b/consfigurator.asd index 6edb70e..b3977c0 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -4,7 +4,8 @@ :author "Sean Whitton " :licence "GPL-3+" :serial t - :depends-on (#:alexandria + :depends-on (#:anaphora + #:alexandria #:babel #:babel-streams #:cl-ppcre diff --git a/debian/changelog b/debian/changelog index 8e2153b..eb35a0f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +consfigurator (0.11.0-1) UNRELEASED; urgency=medium + + * New upstream release. + * Add dep and build-dep on cl-anaphora. + + -- Sean Whitton Sat, 04 Sep 2021 15:42:01 -0700 + consfigurator (0.10.0-1) unstable; urgency=medium * New upstream release. diff --git a/debian/control b/debian/control index 6ce608b..3a20237 100644 --- a/debian/control +++ b/debian/control @@ -4,6 +4,7 @@ Priority: optional Maintainer: Sean Whitton Build-Depends: cl-alexandria, + cl-anaphora, cl-babel, cl-cffi, cl-heredoc, @@ -30,6 +31,7 @@ Package: cl-consfigurator Architecture: all Depends: cl-alexandria, + cl-anaphora, cl-babel, cl-cffi, cl-heredoc, diff --git a/src/connection.lisp b/src/connection.lisp index efd86ad..0e80fff 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -526,8 +526,8 @@ subclass to the :HOSTATTRS subroutine of properties calling this." (defun empty-remote-directory (directory) "Recursively delete the contents of DIRECTORY, but not DIRECTORY itself." - (let ((d (escape-sh-token (drop-trailing-slash (unix-namestring directory))))) - (mrun (format nil "rm -rf -- ~A/* ~A/.[!.]* ~A/..?*" d d d)))) + (alet (escape-sh-token (drop-trailing-slash (unix-namestring directory))) + (mrun (format nil "rm -rf -- ~A/* ~A/.[!.]* ~A/..?*" it it it)))) (defun remote-exists-p (&rest paths) "Does each of PATHS exists? diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp index 8b144cb..70a603d 100644 --- a/src/connection/chroot.lisp +++ b/src/connection/chroot.lisp @@ -81,10 +81,9 @@ should be the mount point, without the chroot's root prefixed.") when (and (subtypep (type-of volume) 'disk:filesystem) (slot-boundp volume 'disk:mount-point) (subpathp (disk:mount-point volume) into)) - collect (let ((copy (disk:copy-volume-and-contents volume))) - (setf (disk:mount-point copy) - (in-chroot-pathname (disk:mount-point copy) into)) - copy) + collect (aprog1 (disk:copy-volume-and-contents volume) + (setf (disk:mount-point it) + (in-chroot-pathname (disk:mount-point it) into))) else collect volume))) (defmethod propagate-connattr diff --git a/src/connection/ssh.lisp b/src/connection/ssh.lisp index 38fd2ae..f4d30cc 100644 --- a/src/connection/ssh.lisp +++ b/src/connection/ssh.lisp @@ -24,9 +24,8 @@ user) (declare (ignore remaining)) (informat 1 "~&Establishing SSH connection to ~A" hop) - (let ((connection (make-instance 'ssh-connection :hostname hop :user user))) - (mrun "ssh" (ssh-host connection) ":") - connection)) + (aprog1 (make-instance 'ssh-connection :hostname hop :user user) + (mrun "ssh" (ssh-host it) ":"))) (defclass ssh-connection (shell-wrap-connection) ((hostname diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp index 4c817f8..da50673 100644 --- a/src/connection/sudo.lisp +++ b/src/connection/sudo.lisp @@ -62,14 +62,13 @@ 'sudo-connection :connattrs `(:remote-user ,user) :password-file (and password - (let ((file (mktemp))) + (aprog1 (mktemp) ;; We'll send the password followed by ^M, then the ;; real stdin. Use CODE-CHAR in this way so that we ;; can be sure ASCII ^M is what will get emitted. - (writefile file (strcat (passphrase password) - (string (code-char 13))) - :mode #o600) - file)))) + (writefile it (strcat (passphrase password) + (string (code-char 13))) + :mode #o600))))) (defmethod connection-teardown :after ((connection sudo-connection)) (when-let ((file (slot-value connection 'password-file))) diff --git a/src/data.lisp b/src/data.lisp index fa814f0..d87e648 100644 --- a/src/data.lisp +++ b/src/data.lisp @@ -201,10 +201,9 @@ This function is called by property :APPLY and :UNAPPLY subroutines." (informat 3 "~&Obtaining ~S | ~S from a data source" iden1 iden2) (values (lambda () - (let ((from-source-data (funcall (cdr from-source)))) - (when (subtypep (type-of from-source-data) 'string-data) - (setf (gethash idenpair *string-data*) from-source-data)) - from-source-data)) + (aprog1 (funcall (cdr from-source)) + (when (subtypep (type-of it) 'string-data) + (setf (gethash idenpair *string-data*) it)))) from-source-version)) ((and local-cached (or (not from-source) (version>= local-cached-version diff --git a/src/package.lisp b/src/package.lisp index 7b526ea..31288d2 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,7 +1,7 @@ (in-package :cl-user) (defpackage :consfigurator - (:use #:cl #:alexandria #:cffi) + (:use #:cl #:anaphora #:alexandria #:cffi) (:local-nicknames (#:re #:cl-ppcre)) (:shadowing-import-from #:uiop #:strcat @@ -470,7 +470,7 @@ #:os-bootstrapped.)) (defpackage :consfigurator.property.disk - (:use #:cl #:alexandria #:consfigurator) + (:use #:cl #:anaphora #:alexandria #:consfigurator) (:local-nicknames (#:re #:cl-ppcre) (#:chroot #:consfigurator.property.chroot) (#:cmd #:consfigurator.property.cmd) @@ -534,7 +534,11 @@ #:volumes)) (defpackage :consfigurator.property.fstab - (:use #:cl #:alexandria #:consfigurator #:consfigurator.property.disk) + (:use #:cl + #:anaphora + #:alexandria + #:consfigurator + #:consfigurator.property.disk) (:local-nicknames (#:os #:consfigurator.property.os) (#:file #:consfigurator.property.file)) (:export #:volume->entry @@ -543,7 +547,11 @@ #:entries-for-opened-volumes)) (defpackage :consfigurator.property.crypttab - (:use #:cl #:alexandria #:consfigurator #:consfigurator.property.disk) + (:use #:cl + #:anaphora + #:alexandria + #:consfigurator + #:consfigurator.property.disk) (:local-nicknames (#:re #:cl-ppcre) (#:os #:consfigurator.property.os) (#:file #:consfigurator.property.file)) @@ -779,7 +787,7 @@ #:masked)) (defpackage :consfigurator.property.firewalld - (:use #:cl #:alexandria #:consfigurator) + (:use #:cl #:anaphora #:alexandria #:consfigurator) (:local-nicknames (#:cmd #:consfigurator.property.cmd) (#:file #:consfigurator.property.file) (#:apt #:consfigurator.property.apt) @@ -841,12 +849,14 @@ (defpackage :consfigurator.connection.ssh (:use #:cl #:consfigurator + #:anaphora #:alexandria #:consfigurator.connection.shell-wrap)) (defpackage :consfigurator.connection.sudo (:use #:cl #:consfigurator + #:anaphora #:alexandria #:consfigurator.connection.shell-wrap)) @@ -857,6 +867,7 @@ (defpackage :consfigurator.connection.chroot (:use #:cl + #:anaphora #:alexandria #:consfigurator #:consfigurator.connection.fork diff --git a/src/property.lisp b/src/property.lisp index cf4fbb1..e846c46 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -105,10 +105,9 @@ (defun propapply (prop &rest args) (with-some-errors-are-failed-change - (let ((check (get prop 'check))) - (if (and check (apply check args)) - :no-change - (apply (get prop 'papply (constantly :no-change)) args))))) + (if (aand (get prop 'check) (apply it args)) + :no-change + (apply (get prop 'papply (constantly :no-change)) args)))) (defun propappapply (propapp) (if propapp @@ -452,18 +451,17 @@ You will usually be able to use DEFPROPLIST instead of DEFPROPSPEC. However, sometimes you will need to fall back on DEFPROPSPEC. For example, an unevaluated property application specification cannot express passing values other than constant values and propapps to property combinators." - (let ((propspec - (loop for remaining on properties - for car = (car remaining) - if (or (stringp car) - (and (listp car) - (member (car car) - '(:desc :check :hostattrs declare)))) - collect car into begin - else - return (nreverse - (cons `(props eseqprops ,@remaining) begin))))) - `(defpropspec ,name ,type ,lambda ,@propspec))) + (alet (loop for remaining on properties + for car = (car remaining) + if (or (stringp car) + (and (listp car) + (member (car car) + '(:desc :check :hostattrs declare)))) + collect car into begin + else + return (nreverse + (cons `(props eseqprops ,@remaining) begin))) + `(defpropspec ,name ,type ,lambda ,@it))) ;;;; hostattrs in property subroutines diff --git a/src/property/crypttab.lisp b/src/property/crypttab.lisp index a24ac26..28bcaf7 100644 --- a/src/property/crypttab.lisp +++ b/src/property/crypttab.lisp @@ -70,9 +70,8 @@ except that if the second field of the existing entry is not \"none\" and the corresponding member of ENTRIES is \"none\" or \"PLACEHOLDER\", use the existing field value." (:desc - (let ((devices - (loop for entry in entries collect (car (split-string entry))))) - (format nil "crypttab entr~@P for ~{~A~^, ~}" (length devices) devices))) + (alet (loop for entry in entries collect (car (split-string entry))) + (format nil "crypttab entr~@P for ~{~A~^, ~}" (length it) it))) (:apply (file:update-unix-table #P"/etc/crypttab" 1 0 entries))) (defprop entries-for-opened-volumes :posix () diff --git a/src/property/disk.lisp b/src/property/disk.lisp index 3fa97ee..04393ce 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -925,10 +925,9 @@ filesystems will be incrementally updated when other properties change." if (and physical-disk-p (not found) (slot-boundp volume 'volume-contents)) do (setq found t) - and collect (let ((copy (copy-volume-and-contents volume))) - (change-class copy 'raw-disk-image) - (setf (image-file copy) image-pathname) - copy) + and collect (aprog1 (copy-volume-and-contents volume) + (change-class it 'raw-disk-image) + (setf (image-file it) image-pathname)) else unless physical-disk-p collect volume finally diff --git a/src/property/firewalld.lisp b/src/property/firewalld.lisp index a39b22c..f4d7a25 100644 --- a/src/property/firewalld.lisp +++ b/src/property/firewalld.lisp @@ -37,13 +37,12 @@ (flet ((run () (let ((output (mrun "firewall-cmd" args))) (and warning (search warning output) :no-change)))) - (let ((result (if file - (with-change-if-changes-file - ((merge-pathnames file #P"/etc/firewalld/")) (run)) - (run)))) - (unless (eql result :no-change) - (mrun "firewall-cmd" "--reload")) - result)))) + (aprog1 (if file + (with-change-if-changes-file + ((merge-pathnames file #P"/etc/firewalld/")) (run)) + (run)) + (unless (eql it :no-change) + (mrun "firewall-cmd" "--reload")))))) ;;;; Setting contents of XML configuration files diff --git a/src/property/fstab.lisp b/src/property/fstab.lisp index a4eaf98..5a8feef 100644 --- a/src/property/fstab.lisp +++ b/src/property/fstab.lisp @@ -85,10 +85,8 @@ member of ENTRIES is \"none\", or \"PLACEHOLDER\", use the existing field value. This makes it easy to update mount options without having to specify the partition or filesystem UUID in your consfig." - (:desc - (let ((mount-points (mapcar (compose #'cadr #'words) entries))) - (format nil "fstab entr~@P for ~{~A~^, ~}" - (length mount-points) mount-points))) + (:desc (alet (mapcar (compose #'cadr #'words) entries) + (format nil "fstab entr~@P for ~{~A~^, ~}" (length it) it))) (:apply (file:update-unix-table #P"/etc/fstab" 0 1 entries))) (defprop entries-for-volumes :posix (&optional volumes) diff --git a/src/propspec.lisp b/src/propspec.lisp index e1607af..1fa6744 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -76,9 +76,8 @@ manual." (lambda (form env &aux (c (and (listp form) (car form)))) (declare (ignore env)) (cond ((and c (isprop c)) - (let ((gensym (gensym))) - (push (cons gensym form) replaced-propapps) - gensym)) + (aprog1 (gensym) + (push (cons it form) replaced-propapps))) ;; We also look for any symbols without function or ;; property definitions occurring in function call ;; positions. These could potentially be properties -- cgit v1.2.3