From: "Ludovic Courtès" <ludo@gnu.org>
To: 45891@debbugs.gnu.org
Subject: [bug#45891] [PATCH] packages: 'patch-and-repack' returns a directory when given a directory.
Date: Fri, 15 Jan 2021 14:15:48 +0100 [thread overview]
Message-ID: <20210115131548.8792-1-ludo@gnu.org> (raw)
Previously, 'patch-and-repack' would always create a tar.xz archive as a
result, even if the input was a directory (a checkout). This change
reduces gratuitous CPU and storage overhead.
* guix/packages.scm (patch-and-repack)[tarxz-name]: Remove 'checkout?' case.
[build](repack): New procedure, with "tar" invocation formerly at the
top level.
If SOURCE is a directory, call 'copy-recursively'; otherwise, call
'repack'.
Change NAME to ORIGINAL-FILE-NAME when it matches 'checkout?'.
---
guix/packages.scm | 65 ++++++++++++++++++++++++++---------------------
1 file changed, 36 insertions(+), 29 deletions(-)
Hi!
This change is a followup to a recent IRC discussion: it makes
‘patch-and-repack’ preserve the “directoriness” of its input.
It conflicts with other changes Maxim posted at
<https://issues.guix.gnu.org/45773>, though that could be addressed.
Thoughts?
Ludo’.
diff --git a/guix/packages.scm b/guix/packages.scm
index 4caaa9cb79..cd2cded9ee 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2017, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
@@ -635,11 +635,9 @@ specifies modules in scope when evaluating SNIPPET."
(define (tarxz-name file-name)
;; Return a '.tar.xz' file name based on FILE-NAME.
- (let ((base (cond ((numeric-extension? file-name)
- original-file-name)
- ((checkout? file-name)
- (string-drop-right file-name 9))
- (else (file-sans-extension file-name)))))
+ (let ((base (if (numeric-extension? file-name)
+ original-file-name
+ (file-sans-extension file-name))))
(string-append base
(if (equal? (file-extension base) "tar")
".xz"
@@ -689,6 +687,29 @@ specifies modules in scope when evaluating SNIPPET."
(lambda (name)
(not (member name '("." "..")))))))
+ (define (repack directory output)
+ ;; Write to OUTPUT a compressed tarball containing DIRECTORY.
+ (unless tar-supports-sort?
+ (call-with-output-file ".file_list"
+ (lambda (port)
+ (for-each (lambda (name)
+ (format port "~a~%" name))
+ (find-files directory
+ #:directories? #t
+ #:fail-on-error? #t)))))
+
+ (apply invoke #+(file-append tar "/bin/tar")
+ "cvfa" output
+ ;; Avoid non-determinism in the archive. Set the mtime
+ ;; to 1 as is the case in the store (software like gzip
+ ;; behaves differently when it stumbles upon mtime = 0).
+ "--mtime=@1"
+ "--owner=root:0" "--group=root:0"
+ (if tar-supports-sort?
+ `("--sort=name" ,directory)
+ '("--no-recursion"
+ "--files-from=.file_list"))))
+
;; Encoding/decoding errors shouldn't be silent.
(fluid-set! %default-port-conversion-strategy 'error)
@@ -742,30 +763,16 @@ specifies modules in scope when evaluating SNIPPET."
(chdir "..")
- (unless tar-supports-sort?
- (call-with-output-file ".file_list"
- (lambda (port)
- (for-each (lambda (name)
- (format port "~a~%" name))
- (find-files directory
- #:directories? #t
- #:fail-on-error? #t)))))
- (apply invoke
- (string-append #+tar "/bin/tar")
- "cvfa" #$output
- ;; Avoid non-determinism in the archive. Set the mtime
- ;; to 1 as is the case in the store (software like gzip
- ;; behaves differently when it stumbles upon mtime = 0).
- "--mtime=@1"
- "--owner=root:0"
- "--group=root:0"
- (if tar-supports-sort?
- `("--sort=name"
- ,directory)
- '("--no-recursion"
- "--files-from=.file_list")))))))
+ ;; If SOURCE is a directory (such as a checkout), return a
+ ;; directory. Otherwise create a tarball.
+ (if (file-is-directory? #+source)
+ (copy-recursively directory #$output
+ #:log (%make-void-port "w"))
+ (repack directory #$output))))))
- (let ((name (tarxz-name original-file-name)))
+ (let ((name (if (checkout? original-file-name)
+ original-file-name
+ (tarxz-name original-file-name))))
(gexp->derivation name build
#:graft? #f
#:system system
--
2.30.0
next reply other threads:[~2021-01-15 13:24 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-01-15 13:15 Ludovic Courtès [this message]
2021-01-15 22:14 ` [bug#45891] [PATCH] packages: 'patch-and-repack' returns a directory when given a directory Maxim Cournoyer
2021-01-16 21:28 ` Ludovic Courtès
2021-01-18 6:24 ` Maxim Cournoyer
2021-01-18 14:56 ` bug#45891: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210115131548.8792-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=45891@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).