From bbcb78de14e03c40cd7b67140d38565ef6097302 Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Sat, 15 Dec 2018 21:14:14 -0500
Subject: [PATCH] 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.
---
 gash/config.scm.in  | 18 +++++++++++++-----
 gash/guix-utils.scm | 12 ++++++++++--
 2 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/gash/config.scm.in b/gash/config.scm.in
index 14e6d2a..27853dd 100644
--- a/gash/config.scm.in
+++ b/gash/config.scm.in
@@ -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@")
diff --git a/gash/guix-utils.scm b/gash/guix-utils.scm
index f347b5b..c4ee442 100644
--- a/gash/guix-utils.scm
+++ b/gash/guix-utils.scm
@@ -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~%"