aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-06-08 13:25:21 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-06-08 13:25:21 -0700
commit1393bb0305bb80dfd5ebe57268b55e7d0dfa8567 (patch)
treea8d650006181e0f4124475036fdad806d3904b77
parente76441b7186ebab16fa7214bad96b8999a94865e (diff)
downloadconsfigurator-1393bb0305bb80dfd5ebe57268b55e7d0dfa8567.tar.gz
FILE:DIRECTORY-DOES-NOT-EXIST: simplify not deleting non-dirs
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r--src/package.lisp1
-rw-r--r--src/property/file.lisp15
-rw-r--r--src/util.lisp5
3 files changed, 15 insertions, 6 deletions
diff --git a/src/package.lisp b/src/package.lisp
index daf1604..e9434be 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -76,6 +76,7 @@
#:plist-to-cmd-args
#:with-local-temporary-directory
#:pathname-file
+ #:ensure-trailing-slash
#:drop-trailing-slash
#:quote-nonselfeval
#:define-print-object-for-structlike
diff --git a/src/property/file.lisp b/src/property/file.lisp
index 214b69f..cde14d0 100644
--- a/src/property/file.lisp
+++ b/src/property/file.lisp
@@ -89,17 +89,20 @@ CONTENT can be a list of lines or a single string."
(:check (not (apply #'remote-exists-p paths)))
(:apply (mrun "rm" "-f" paths)))
-(defprop directory-does-not-exist :posix (&rest directories)
+(defprop directory-does-not-exist :posix
+ (&rest directories
+ ;; Ensure that there's a trailing slash at the end of each
+ ;; namestring, such that if a regular file of the same name as the
+ ;; directory exists, 'rm -rf' will not delete it.
+ &aux (directories
+ (mapcar (compose #'ensure-trailing-slash #'unix-namestring)
+ directories)))
"Recursively ensure that DIRECTORIES do not exist."
(:desc (if (cdr directories)
#?"@{directories} do not exist"
#?"${(car directories)} does not exist"))
(:check (not (apply #'remote-exists-p directories)))
- (:apply
- (if (test (format nil "~{( -e ~A -a ! -d ~:*~A )~^ -o ~}" directories))
- (failed-change "At least one of ~S exists and is not a directory."
- directories)
- (apply #'delete-remote-trees directories))))
+ (:apply (mrun "rm" "-rf" directories)))
(defprop data-uploaded :posix (iden1 iden2 destination)
(:hostattrs
diff --git a/src/util.lisp b/src/util.lisp
index 9dd417d..1dd2b44 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -167,6 +167,11 @@ one solution is to convert your property to a :LISP property."
(namestring
(enough-pathname pathname (pathname-directory-pathname pathname)))))
+(defun ensure-trailing-slash (namestring)
+ (if (string-suffix-p namestring "/")
+ namestring
+ (strcat namestring "/")))
+
(defun drop-trailing-slash (namestring)
(if (string-suffix-p namestring "/")
(subseq namestring 0 (1- (length namestring)))