nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

publish: Factorize 'compress-nar'. 

* guix/scripts/publish.scm (compress-nar): New procedure.
(bake-narinfo+nar): Use it.
This commit is contained in:
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

26
guix/scripts/publish.scm
View File

@ -505,15 +505,10 @@ requested using POOL."
(else (else
(not-found request #:phrase ""))))) (not-found request #:phrase "")))))
(define* (bake-narinfo+nar cache item (define (compress-nar cache item compression)
#:key ttl (compression %no-compression) "Save in directory CACHE the nar for ITEM compressed with COMPRESSION."
(nar-path "/nar")) (define nar
"Write the narinfo and nar for ITEM to CACHE." (nar-cache-file cache item #:compression compression))
(let* ((compression (actual-compression item compression))
(nar (nar-cache-file cache item
#:compression compression))
(narinfo (narinfo-cache-file cache item
#:compression compression)))
(mkdir-p (dirname nar)) (mkdir-p (dirname nar))
(match (compression-type compression) (match (compression-type compression)
@ -537,7 +532,18 @@ requested using POOL."
;; guarantee the TTL (see <https://bugs.gnu.org/28664>.) ;; guarantee the TTL (see <https://bugs.gnu.org/28664>.)
(with-atomic-file-output nar (with-atomic-file-output nar
(lambda (port) (lambda (port)
(write-file item port))))) (write-file item port))))))
(define* (bake-narinfo+nar cache item
#:key ttl (compression %no-compression)
(nar-path "/nar"))
"Write the narinfo and nar for ITEM to CACHE."
(let* ((compression (actual-compression item compression))
(nar (nar-cache-file cache item
#:compression compression))
(narinfo (narinfo-cache-file cache item
#:compression compression)))
(compress-nar cache item compression)
(mkdir-p (dirname narinfo)) (mkdir-p (dirname narinfo))
(with-atomic-file-output narinfo (with-atomic-file-output narinfo