Use built-in compress without an external file.
When the system does not provide a compress executable, we use our own. Before, this was done by installing an executable named 'compress' along with Gash. This commit allows the compressed-port functions to use our built-in compress without needing an external executable. * gash/config.scm.in (exec-internal-compress): New function. (%compress): Fall back to it on systems without compress. * gash/guix-utils.scm (filtered-port, filtered-output-port): When the given command list begins with a procedure, apply it to its arguments instead of using execl.
This commit is contained in:
parent
35444457f8
commit
bbcb78de14
|
@ -36,12 +36,20 @@
|
|||
(define %bzip2
|
||||
"@BZIP2@")
|
||||
|
||||
(define (exec-internal-compress . args)
|
||||
(let* ((guile "@GUILE@")
|
||||
(expr `(begin
|
||||
(set! %load-path ',%load-path)
|
||||
(set! %load-compiled-path ',%load-compiled-path)
|
||||
((@@ (gash commands compress) main) "compress" ,@args)))
|
||||
(script (with-output-to-string (lambda () (write expr)))))
|
||||
(execl guile guile "--no-auto-compile" "-c" script)))
|
||||
|
||||
(define %compress
|
||||
(let ((compress "@COMPRESS@")
|
||||
(reloc (string-append (dirname (car (command-line))) "/compress")))
|
||||
(cond ((getenv "COMPRESS"))
|
||||
((file-exists? compress) compress)
|
||||
((file-exists? reloc) reloc))))
|
||||
(let ((external-compress "@COMPRESS@"))
|
||||
(if (string-null? external-compress)
|
||||
exec-internal-compress
|
||||
external-compress)))
|
||||
|
||||
(define %gzip
|
||||
"@GZIP@")
|
||||
|
|
|
@ -73,7 +73,11 @@ buffered data is lost."
|
|||
(dup2 (fileno out) 1)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(apply execl (car command) command))
|
||||
(match command
|
||||
(((? string? name) . _)
|
||||
(apply execl name command))
|
||||
(((? procedure? proc) . args)
|
||||
(apply proc args))))
|
||||
(lambda args
|
||||
(format (current-error-port)
|
||||
"filtered-port: failed to execute '~{~a ~}': ~a~%"
|
||||
|
@ -159,7 +163,11 @@ data is lost."
|
|||
(dup2 (fileno output) 1)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(apply execl (car command) command))
|
||||
(match command
|
||||
(((? string? name) . _)
|
||||
(apply execl name command))
|
||||
(((? procedure? proc) . args)
|
||||
(apply proc args))))
|
||||
(lambda args
|
||||
(format (current-error-port)
|
||||
"filtered-output-port: failed to execute '~{~a ~}': ~a~%"
|
||||
|
|
Loading…
Reference in New Issue