Don't use "tmp" and copy instead of move to improve permission handling1.4

tmp causes warnings when linking on OpenBSD.  Group ownership switches
to the directory and warns when moving (on OpenBSD and possibly other
BSDs, too).

Thanks to "n0goOi3"

1 files changed, 23 insertions, 13 deletions

diff --git a/henrietta-cache.scm b/henrietta-cache.scm
index 1771f5b..9daa883 100644
--- a/henrietta-cache.scm
+++ b/henrietta-cache.scm
@@ -83,6 +83,23 @@ EOF
        (error (sprintf "Could not download ~A -- ~A"
                        uri (get-condition-property e 'exn 'message))))))
 
+;; this moves via copy delete as it produces more consistent results
+;; (i.e. like new file) in particular bsd group ownership is more natural
+(define (move-to-cache tmp-dir cache-dir)
+  (create-directory cache-dir)
+  (for-each
+    (lambda (file)
+      (let
+        ((tmp-file (make-pathname tmp-dir file))
+          (cache-file (make-pathname cache-dir file)))
+        (if (directory-exists? tmp-file)
+          (move-to-cache tmp-file cache-file)
+          (begin
+            (copy-file tmp-file cache-file)
+            (delete-file tmp-file) ))))
+    (directory tmp-dir) )
+  (delete-directory tmp-dir #t) )	;nb: don't like recursive but top level has hidden contents and don't want those
+
 (define (download-files-from-list base-uri files cache-dir)
   (let ((tmp-dir (create-temporary-directory))
         (add-to-uri
@@ -114,13 +131,9 @@ EOF
                                "listed in meta-file/files-list (full URI: ~A) -- ~A")
                        file (uri->string (add-to-uri file))
                        (get-condition-property e 'exn 'message))))))
-       files)
+        files)
       (create-directory cache-dir #t)
-      (let* ((cmd (sprintf "mv ~A/* ~A" (qs tmp-dir) (qs cache-dir)))
-             (status (system cmd)))
-        (unless (zero? status)
-          (error "Got an error executing command" cmd))
-        (system (sprintf "rm -rf ~A" (qs tmp-dir)))))))
+      (move-to-cache tmp-dir cache-dir) )))
 
 ;; Make-cmd is a lambda which accepts the temporary file- and dirname
 ;; and returns a suitable command to execute using SYSTEM
@@ -154,13 +167,10 @@ EOF
                                   ("pax_global_header" dir)
                                   (dir))
                               (make-pathname tmp-dir dir))
-                             (else tmp-dir)))
-             (cmd (sprintf "mv ~A/* ~A" (qs contents-dir) (qs cache-dir)))
-             (status (system cmd)))
-        (unless (zero? status)
-          (error "Got an error executing command" cmd))
-        (delete-file tmp-file)
-        (system (sprintf "rm -rf ~A" (qs tmp-dir)))))))
+                             (else tmp-dir))))
+        (move-to-cache contents-dir cache-dir)
+        (delete-directory tmp-dir #t)	; sloppy; don't know which dir selected
+        (delete-file tmp-file) ))))
 
 (define (download-release distribution-file-type uri cache-dir)
   (case distribution-file-type