unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
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





             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).