diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-12-26 23:01:05 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-01-13 22:24:19 +0100 |
| commit | db0cecdf6b2f2b8f9c5a3cebe8fc60e79a692be0 (patch) | |
| tree | 80b9adeaf22272c6fdbb708d4c2ccd137dccb431 | |
| parent | 0d046587107a56467cf2027799ac79ce8c203ce0 (diff) | |
utils: Support zstd compression via Guile-zstd.
* guix/utils.scm (lzip-port): Return a single value.
(zstd-port): New procedure.
(decompressed-port, compressed-output-port): Add 'zstd' case.
* tests/utils.scm (test-compression/decompression): Test 'zstd' when
the (zstd) module is available.
| -rw-r--r-- | guix/utils.scm | 12 | ||||
| -rw-r--r-- | tests/utils.scm | 6 |
2 files changed, 15 insertions, 3 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index c321ad9943f..f8b05e7e805 100644 --- a/guix/utils.scm +++ b/guix/utils.scm | |||
| @@ -210,7 +210,13 @@ buffered data is lost." | |||
| 210 | "Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS. | 210 | "Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS. |
| 211 | Raise an error if lzlib support is missing." | 211 | Raise an error if lzlib support is missing." |
| 212 | (let ((make-port (module-ref (resolve-interface '(lzlib)) proc))) | 212 | (let ((make-port (module-ref (resolve-interface '(lzlib)) proc))) |
| 213 | (values (make-port port) '()))) | 213 | (make-port port))) |
| 214 | |||
| 215 | (define (zstd-port proc port . args) | ||
| 216 | "Return the zstd port produced by calling PROC (a symbol) on PORT and ARGS. | ||
| 217 | Raise an error if zstd support is missing." | ||
| 218 | (let ((make-port (module-ref (resolve-interface '(zstd)) proc))) | ||
| 219 | (make-port port))) | ||
| 214 | 220 | ||
| 215 | (define (decompressed-port compression input) | 221 | (define (decompressed-port compression input) |
| 216 | "Return an input port where INPUT is decompressed according to COMPRESSION, | 222 | "Return an input port where INPUT is decompressed according to COMPRESSION, |
| @@ -222,6 +228,8 @@ a symbol such as 'xz." | |||
| 222 | ('gzip (filtered-port `(,%gzip "-dc") input)) | 228 | ('gzip (filtered-port `(,%gzip "-dc") input)) |
| 223 | ('lzip (values (lzip-port 'make-lzip-input-port input) | 229 | ('lzip (values (lzip-port 'make-lzip-input-port input) |
| 224 | '())) | 230 | '())) |
| 231 | ('zstd (values (zstd-port 'make-zstd-input-port input) | ||
| 232 | '())) | ||
| 225 | (_ (error "unsupported compression scheme" compression)))) | 233 | (_ (error "unsupported compression scheme" compression)))) |
| 226 | 234 | ||
| 227 | (define (call-with-decompressed-port compression port proc) | 235 | (define (call-with-decompressed-port compression port proc) |
| @@ -281,6 +289,8 @@ program--e.g., '(\"--fast\")." | |||
| 281 | ('gzip (filtered-output-port `(,%gzip "-c" ,@options) output)) | 289 | ('gzip (filtered-output-port `(,%gzip "-c" ,@options) output)) |
| 282 | ('lzip (values (lzip-port 'make-lzip-output-port output) | 290 | ('lzip (values (lzip-port 'make-lzip-output-port output) |
| 283 | '())) | 291 | '())) |
| 292 | ('zstd (values (zstd-port 'make-zstd-output-port output) | ||
| 293 | '())) | ||
| 284 | (_ (error "unsupported compression scheme" compression)))) | 294 | (_ (error "unsupported compression scheme" compression)))) |
| 285 | 295 | ||
| 286 | (define* (call-with-compressed-output-port compression port proc | 296 | (define* (call-with-compressed-output-port compression port proc |
diff --git a/tests/utils.scm b/tests/utils.scm index c278b2a2778..9bce446d98f 100644 --- a/tests/utils.scm +++ b/tests/utils.scm | |||
| @@ -228,8 +228,10 @@ skip these tests." | |||
| 228 | get-bytevector-all))))) | 228 | get-bytevector-all))))) |
| 229 | 229 | ||
| 230 | (for-each test-compression/decompression | 230 | (for-each test-compression/decompression |
| 231 | '(gzip xz lzip) | 231 | `(gzip xz lzip zstd) |
| 232 | (list (const #t) (const #t) (const #t))) | 232 | (list (const #t) (const #t) (const #t) |
| 233 | (lambda () | ||
| 234 | (resolve-module '(zstd) #t #f #:ensure #f)))) | ||
| 233 | 235 | ||
| 234 | ;; This is actually in (guix store). | 236 | ;; This is actually in (guix store). |
| 235 | (test-equal "store-path-package-name" | 237 | (test-equal "store-path-package-name" |
