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(-)
@@ -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"
@@ -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
@@ -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
@@ -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