From 1393bb0305bb80dfd5ebe57268b55e7d0dfa8567 Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Tue, 8 Jun 2021 13:25:21 -0700
Subject: FILE:DIRECTORY-DOES-NOT-EXIST: simplify not deleting non-dirs

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
---
 src/package.lisp       |  1 +
 src/property/file.lisp | 15 +++++++++------
 src/util.lisp          |  5 +++++
 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)))
-- 
cgit v1.2.3