me
/
guix
Archived
1
0
Fork 0
Code

publish: Factorize 'compress-nar'. 

* guix/scripts/publish.scm (compress-nar): New procedure.
(bake-narinfo+nar): Use it.
master
Ludovic Courtès 2019-05-29 11:38:17 +02:00
parent e84e036943
commit 73bddab545
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 30 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
guix/scripts/publish.scm
View File

@ -505,6 +505,35 @@ requested using POOL."
(else (else
(not-found request #:phrase ""))))) (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 (define* (bake-narinfo+nar cache item
#:key ttl (compression %no-compression) #:key ttl (compression %no-compression)
(nar-path "/nar")) (nar-path "/nar"))
@ -514,30 +543,7 @@ requested using POOL."
#:compression compression)) #:compression compression))
(narinfo (narinfo-cache-file cache item (narinfo (narinfo-cache-file cache item
#:compression compression))) #:compression compression)))
(compress-nar cache item 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)))))
(mkdir-p (dirname narinfo)) (mkdir-p (dirname narinfo))
(with-atomic-file-output narinfo (with-atomic-file-output narinfo