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

utils: Support compression and decompression with lzip. 

* guix/utils.scm (lzip-port): New procedure.
(decompressed-port, compressed-port, compressed-output-port): Add 'lzip
case.
* tests/utils.scm <top level>: Call 'test-compression/decompression' for
'lzip as well.
This commit is contained in:
Ludovic Courtès 2019-05-23 22:14:53 +02:00
parent 4c7ebe318f
commit 4e48923e75
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
guix/utils.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
@ -169,6 +169,17 @@ buffered data is lost."
(close-port out) (close-port out)
(loop in (cons child pids))))))))) (loop in (cons child pids)))))))))
(define (lzip-port proc port . args)
"Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS.
Raise an error if lzlib support is missing."
(let* ((lzlib (false-if-exception (resolve-interface '(guix lzlib))))
(supported? (and lzlib
((module-ref lzlib 'lzlib-available?)))))
(if supported?
(let ((make-port (module-ref lzlib proc)))
(values (make-port port) '()))
(error "lzip compression not supported" lzlib))))
(define (decompressed-port compression input) (define (decompressed-port compression input)
"Return an input port where INPUT is decompressed according to COMPRESSION, "Return an input port where INPUT is decompressed according to COMPRESSION,
a symbol such as 'xz." a symbol such as 'xz."
@ -177,17 +188,21 @@ a symbol such as 'xz."
('bzip2 (filtered-port `(,%bzip2 "-dc") input)) ('bzip2 (filtered-port `(,%bzip2 "-dc") input))
('xz (filtered-port `(,%xz "-dc") input)) ('xz (filtered-port `(,%xz "-dc") input))
('gzip (filtered-port `(,%gzip "-dc") input)) ('gzip (filtered-port `(,%gzip "-dc") input))
(else (error "unsupported compression scheme" compression)))) ('lzip (values (lzip-port 'make-lzip-input-port input)
'()))
(_ (error "unsupported compression scheme" compression))))
(define (compressed-port compression input) (define (compressed-port compression input)
"Return an input port where INPUT is decompressed according to COMPRESSION, "Return an input port where INPUT is compressed according to COMPRESSION,
a symbol such as 'xz." a symbol such as 'xz."
(match compression (match compression
((or #f 'none) (values input '())) ((or #f 'none) (values input '()))
('bzip2 (filtered-port `(,%bzip2 "-c") input)) ('bzip2 (filtered-port `(,%bzip2 "-c") input))
('xz (filtered-port `(,%xz "-c") input)) ('xz (filtered-port `(,%xz "-c") input))
('gzip (filtered-port `(,%gzip "-c") input)) ('gzip (filtered-port `(,%gzip "-c") input))
(else (error "unsupported compression scheme" compression)))) ('lzip (values (lzip-port 'make-lzip-input-port/compressed input)
'()))
(_ (error "unsupported compression scheme" compression))))
(define (call-with-decompressed-port compression port proc) (define (call-with-decompressed-port compression port proc)
"Call PROC with a wrapper around PORT, a file port, that decompresses data "Call PROC with a wrapper around PORT, a file port, that decompresses data
@ -244,7 +259,9 @@ program--e.g., '(\"--fast\")."
('bzip2 (filtered-output-port `(,%bzip2 "-c" ,@options) output)) ('bzip2 (filtered-output-port `(,%bzip2 "-c" ,@options) output))
('xz (filtered-output-port `(,%xz "-c" ,@options) output)) ('xz (filtered-output-port `(,%xz "-c" ,@options) output))
('gzip (filtered-output-port `(,%gzip "-c" ,@options) output)) ('gzip (filtered-output-port `(,%gzip "-c" ,@options) output))
(else (error "unsupported compression scheme" compression)))) ('lzip (values (lzip-port 'make-lzip-output-port output)
'()))
(_ (error "unsupported compression scheme" compression))))
(define* (call-with-compressed-output-port compression port proc (define* (call-with-compressed-output-port compression port proc
#:key (options '())) #:key (options '()))

3
tests/utils.scm
View File

@ -23,6 +23,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix store) #:select (%store-prefix store-path-package-name)) #:use-module ((guix store) #:select (%store-prefix store-path-package-name))
#:use-module ((guix search-paths) #:select (string-tokenize*)) #:use-module ((guix search-paths) #:select (string-tokenize*))
#:use-module ((guix lzlib) #:select (lzlib-available?))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
@ -214,7 +215,7 @@ skip these tests."
(for-each test-compression/decompression (for-each test-compression/decompression
'(gzip xz lzip) '(gzip xz lzip)
(list (const #t) (const #t))) (list (const #t) (const #t) lzlib-available?))
;; This is actually in (guix store). ;; This is actually in (guix store).
(test-equal "store-path-package-name" (test-equal "store-path-package-name"