diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-02-03 19:02:43 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-02-03 19:02:43 +0100 |
| commit | 66a2862b68087c9bd100b903fe32066d790cbe2c (patch) | |
| tree | 9b58a6faa2e76503377088075c3b83836f7ab496 | |
| parent | 1ac48476728dc37ab8a56b5c8ebe4a368e0a84a0 (diff) | |
| download | nar-herder-66a2862b68087c9bd100b903fe32066d790cbe2c.tar nar-herder-66a2862b68087c9bd100b903fe32066d790cbe2c.tar.gz | |
Properly implement cached compression levels
It was sort of implemented, but I'd missed some bits.
| -rw-r--r-- | nar-herder/cached-compression.scm | 47 | ||||
| -rw-r--r-- | scripts/nar-herder.in | 2 |
2 files changed, 34 insertions, 15 deletions
diff --git a/nar-herder/cached-compression.scm b/nar-herder/cached-compression.scm index e6cf646..c440493 100644 --- a/nar-herder/cached-compression.scm +++ b/nar-herder/cached-compression.scm @@ -29,7 +29,7 @@ #:use-module (web client) #:use-module (web response) #:use-module (guix store) - #:use-module (guix utils) + #:use-module ((guix utils) #:select (call-with-decompressed-port)) #:use-module ((guix build utils) #:select (dump-port mkdir-p)) #:use-module (nar-herder utils) @@ -241,7 +241,11 @@ nar-source enabled-cached-compressions narinfo-id - missing-compression))) + missing-compression + #:level (assq-ref + (assq-ref enabled-cached-compressions + missing-compression) + 'level)))) ;; Do this here, after creating the new cached nar, ;; just in case there's a lack of space @@ -289,11 +293,12 @@ (process-job narinfo-id cached-bytes-by-compression-box))) #t)))))) -(define (make-compressed-nar database - nar-source - enabled-cached-compressions - narinfo-id - target-compression) +(define* (make-compressed-nar database + nar-source + enabled-cached-compressions + narinfo-id + target-compression + #:key level) (define cached-compression-details (assq-ref enabled-cached-compressions target-compression)) @@ -372,13 +377,27 @@ (assq-ref source-narinfo-file 'compression)) source-port - (lambda (decompressed-source-port) - (call-with-compressed-output-port - target-compression - (open-output-file tmp-dest-filename) - (lambda (compressed-port) - (dump-port decompressed-source-port - compressed-port))))))) + (lambda (decompressed-source-port) + (let ((call-with-compressed-output-port* + (match target-compression + ('gzip + (@ (zlib) call-with-gzip-output-port)) + ('lzip + (@ (lzlib) call-with-lzip-output-port)) + ('zstd + (@ (zstd) call-with-zstd-output-port)) + ('none + (lambda (port proc) + (proc port)))))) + (apply + call-with-compressed-output-port* + (open-output-file tmp-dest-filename) + (lambda (compressed-port) + (dump-port decompressed-source-port + compressed-port)) + (if level + `(#:level ,level) + '()))))))) (rename-file tmp-dest-filename dest-filename) diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index f278ac2..0b38995 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -148,7 +148,7 @@ `((type . ,(string->symbol type)))) ((type level) `((type . ,(string->symbol type)) - (level . ,level)))) + (level . ,(string->number level))))) result))) (option '("cached-compression-directory") #t #f |