From 010666376890b6adf6c14253b1e2651b5c2861e8 Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Fri, 14 Jan 2022 18:03:10 -0500
Subject: [PATCH v2] swh: Do not rely on $PATH for tar and gzip.

Fixes <https://bugs.gnu.org/52828>.

* configure.ac: Find the path of the tar utility.
* guix/config.scm.in (%tar): New variable.
* guix/self.scm (specification->package): Add "tar".
(make-config.scm): Add a 'tar' keyword parameter and use it to set
the '%tar' variable.
(compiled-guix): Add a 'tar' keyword parameter, and pass it to
'make-config.scm'; add 'guile-zlib' as an extension for "guix-core".
* guix/swh.scm (swh-download-archive): Use Guile-zlib to decompress
"flat" archives, and use an absolute path when invoking 'tar'.
---
 configure.ac       |  4 ++++
 guix/config.scm.in |  7 ++++++-
 guix/self.scm      | 18 ++++++++++++++----
 guix/swh.scm       | 13 ++++++++-----
 4 files changed, 32 insertions(+), 10 deletions(-)

diff --git a/configure.ac b/configure.ac
index 341cff8fbd..78f599b2f4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -198,6 +198,10 @@ AC_SUBST([GZIP])
 AC_SUBST([BZIP2])
 AC_SUBST([XZ])
 
+dnl The '(guix swh)' module uses 'tar'.
+AC_PATH_PROG([TAR], [tar])
+AC_SUBST([TAR])
+
 LIBGCRYPT_LIBDIR="no"
 LIBGCRYPT_PREFIX="no"
 
diff --git a/guix/config.scm.in b/guix/config.scm.in
index d582d91d74..7b400a9ff8 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -37,7 +37,9 @@ (define-module (guix config)
             %system
             %gzip
             %bzip2
-            %xz))
+            %xz
+
+            %tar))
 
 ;;; Commentary:
 ;;;
@@ -118,4 +120,7 @@ (define %bzip2
 (define %xz
   "@XZ@")
 
+(define %tar
+  "@TAR@")
+
 ;;; config.scm ends here
diff --git a/guix/self.scm b/guix/self.scm
index 943bb0b498..3944f1a98d 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -68,6 +69,7 @@ (define specification->package
       ("gzip"       (ref '(gnu packages compression) 'gzip))
       ("bzip2"      (ref '(gnu packages compression) 'bzip2))
       ("xz"         (ref '(gnu packages compression) 'xz))
+      ("tar"        (ref '(gnu packages base) 'tar))
       ("po4a"       (ref '(gnu packages gettext) 'po4a))
       ("gettext"       (ref '(gnu packages gettext) 'gettext-minimal))
       ("gcc-toolchain" (ref '(gnu packages commencement) 'gcc-toolchain))
@@ -749,6 +751,7 @@ (define* (compiled-guix source #:key
                         (gzip (specification->package "gzip"))
                         (bzip2 (specification->package "bzip2"))
                         (xz (specification->package "xz"))
+                        (tar (specification->package "tar"))
                         (guix (specification->package "guix")))
   "Return a file-like object that contains a compiled Guix."
   (define guile-avahi
@@ -832,7 +835,9 @@ (define* (compiled-guix source #:key
                     ,(local-file "../guix/store/schema.sql")))
 
                  #:extensions (list guile-gcrypt
-                                    guile-json)   ;for (guix swh)
+                                    ;; The following are for (guix swh)
+                                    guile-json
+                                    guile-zlib)
                  #:guile-for-build guile-for-build))
 
   (define *extra-modules*
@@ -964,6 +969,7 @@ (define* (compiled-guix source #:key
                     => ,(make-config.scm #:gzip gzip
                                          #:bzip2 bzip2
                                          #:xz xz
+                                         #:tar tar
                                          #:package-name
                                          %guix-package-name
                                          #:package-version
@@ -1071,7 +1077,7 @@ (define %default-config-variables
     (%storedir . "/gnu/store")
     (%sysconfdir . "/etc")))
 
-(define* (make-config.scm #:key gzip xz bzip2
+(define* (make-config.scm #:key gzip xz bzip2 tar
                           (package-name "GNU Guix")
                           (package-version "0")
                           (channel-metadata #f)
@@ -1097,7 +1103,8 @@ (define* (make-config.scm #:key gzip xz bzip2
                                %config-directory
                                %gzip
                                %bzip2
-                               %xz))
+                               %xz
+                               %tar))
 
                    (define %system
                      #$(%current-system))
@@ -1142,7 +1149,10 @@ (define* (make-config.scm #:key gzip xz bzip2
                    (define %bzip2
                      #+(and bzip2 (file-append bzip2 "/bin/bzip2")))
                    (define %xz
-                     #+(and xz (file-append xz "/bin/xz"))))
+                     #+(and xz (file-append xz "/bin/xz")))
+
+                   (define %tar
+                     #+(and tar (file-append tar "/bin/tar"))))
 
                ;; Guile 2.0 *requires* the 'define-module' to be at the
                ;; top-level or the 'toplevel-ref' in the resulting .go file are
diff --git a/guix/swh.scm b/guix/swh.scm
index c7c1c873a2..93bb023192 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,7 @@ (define-module (guix swh)
   #:use-module (guix base16)
   #:use-module (guix build utils)
   #:use-module ((guix build syscalls) #:select (mkdtemp!))
+  #:use-module (guix config)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (web response)
@@ -35,6 +37,7 @@ (define-module (guix swh)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 popen)
   #:use-module ((ice-9 ftw) #:select (scandir))
+  #:use-module (zlib)
   #:export (%swh-base-url
             %verify-swh-certificate?
             %allow-request?
@@ -674,11 +677,11 @@ (define* (swh-download-archive swhid output
                 swhid)
         #f)
        ((? port? input)
-        (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory
-                               (match archive-type
-                                 ('flat "-xzvf")     ;gzipped
-                                 ('git-bare "-xvf")) ;uncompressed
-                               "-")))
+        (let ((input (match archive-type
+                       ;; "flat" archives are compressed.
+                       ('flat (make-zlib-input-port input #:format 'gzip))
+                       ('git-bare input)))
+              (tar (open-pipe* OPEN_WRITE %tar "-C" directory "-xvf" "-")))
           (dump-port input tar)
           (close-port input)
           (let ((status (close-pipe tar)))
-- 
2.34.0

