diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-05-29 11:38:17 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-05-29 23:16:49 +0200 |
commit | 73bddab54504c6380a896b7263ab6c3dd8558ef7 (patch) | |
tree | 147f3f87db583769af424704dd235468835b7681 | |
parent | e84e0369435add8e839fec78d4be7b2e71f6d4a8 (diff) | |
download | patches-73bddab54504c6380a896b7263ab6c3dd8558ef7.tar patches-73bddab54504c6380a896b7263ab6c3dd8558ef7.tar.gz |
publish: Factorize 'compress-nar'.
* guix/scripts/publish.scm (compress-nar): New procedure.
(bake-narinfo+nar): Use it.
-rw-r--r-- | guix/scripts/publish.scm | 54 |
1 files changed, 30 insertions, 24 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 2875904758..c55873db78 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -505,6 +505,35 @@ requested using POOL." (else (not-found request #:phrase ""))))) +(define (compress-nar cache item compression) + "Save in directory CACHE the nar for ITEM compressed with COMPRESSION." + (define nar + (nar-cache-file cache item #:compression compression)) + + (mkdir-p (dirname nar)) + (match (compression-type compression) + ('gzip + ;; Note: the file port gets closed along with the gzip port. + (call-with-gzip-output-port (open-output-file (string-append nar ".tmp")) + (lambda (port) + (write-file item port)) + #:level (compression-level compression) + #:buffer-size (* 128 1024)) + (rename-file (string-append nar ".tmp") nar)) + ('lzip + ;; Note: the file port gets closed along with the lzip port. + (call-with-lzip-output-port (open-output-file (string-append nar ".tmp")) + (lambda (port) + (write-file item port)) + #:level (compression-level compression)) + (rename-file (string-append nar ".tmp") nar)) + ('none + ;; Cache nars even when compression is disabled so that we can + ;; guarantee the TTL (see <https://bugs.gnu.org/28664>.) + (with-atomic-file-output nar + (lambda (port) + (write-file item port)))))) + (define* (bake-narinfo+nar cache item #:key ttl (compression %no-compression) (nar-path "/nar")) @@ -514,30 +543,7 @@ requested using POOL." #:compression compression)) (narinfo (narinfo-cache-file cache item #:compression compression))) - - (mkdir-p (dirname nar)) - (match (compression-type compression) - ('gzip - ;; Note: the file port gets closed along with the gzip port. - (call-with-gzip-output-port (open-output-file (string-append nar ".tmp")) - (lambda (port) - (write-file item port)) - #:level (compression-level compression) - #:buffer-size (* 128 1024)) - (rename-file (string-append nar ".tmp") nar)) - ('lzip - ;; Note: the file port gets closed along with the lzip port. - (call-with-lzip-output-port (open-output-file (string-append nar ".tmp")) - (lambda (port) - (write-file item port)) - #:level (compression-level compression)) - (rename-file (string-append nar ".tmp") nar)) - ('none - ;; Cache nars even when compression is disabled so that we can - ;; guarantee the TTL (see <https://bugs.gnu.org/28664>.) - (with-atomic-file-output nar - (lambda (port) - (write-file item port))))) + (compress-nar cache item compression) (mkdir-p (dirname narinfo)) (with-atomic-file-output narinfo |