From c8599d995ec8653976a9ab9c9197f246fedecc05 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 1 Sep 2019 17:19:48 +0200 Subject: Don't use "tmp" and copy instead of move to improve permission handling 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" --- henrietta-cache.scm | 36 +++++++++++++++++++++++------------- 1 file 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 -- cgit v1.2.3