all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [bug#45774] [PATCH core-updates 1/1] guix: packages: Allow patch-and-repack to work with plain files.
@ 2021-01-10 20:05 Maxim Cournoyer
  2021-01-13 17:40 ` [bug#45774] [PATCH core-updates v2] build-systems/gnu: Allow unpacking/repacking more kind of files Maxim Cournoyer
  2021-01-18 16:51 ` [bug#45774] [PATCH core-updates v3 1/2] utils: Retrieve the store prefix from NIX_STORE_DIR, not STORE_DIR Maxim Cournoyer
  0 siblings, 2 replies; 11+ messages in thread
From: Maxim Cournoyer @ 2021-01-10 20:05 UTC (permalink / raw)
  To: 45773, 45774

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset=yes, Size: 13553 bytes --]

This change allows the use of the snippet field on a single file origin.
Previously, the patch-and-repack procedure would fail on plain files, as it
would end up invoking tar when attempting to extract non-tarballs.

* guix/packages.scm (patch-and-repack): Only add the compressor utility to the
PATH when the file is compressed.  Bind more inputs in the mlet, and use them
for decompressing single files.  Adjust decompression and compression routines.
[decompression-type]: Return #f when no known compression extension is used.
[tarball?]: New nested procedure.
* tests/packages.scm: Add tests.  Add missing copyright year for Jan.
---
 guix/packages.scm  | 96 +++++++++++++++++++++++++++++++---------------
 tests/packages.scm | 87 +++++++++++++++++++++++++++++++++++++++--
 2 files changed, 149 insertions(+), 34 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 93407c143c..f6336e7345 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -5,7 +5,7 @@
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
-;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -615,7 +615,8 @@ specifies modules in scope when evaluating SNIPPET."
           ((string-suffix? "bz2" source-file-name) "bzip2")
           ((string-suffix? "lz" source-file-name)  "lzip")
           ((string-suffix? "zip" source-file-name) "unzip")
-          (else "xz")))
+          ((string-suffix? "xz" source-file-name) "xz")
+          (else #f)))                   ;no compression used
 
   (define original-file-name
     ;; Remove the store prefix plus the slash, hash, and hyphen.
@@ -653,19 +654,29 @@ specifies modules in scope when evaluating SNIPPET."
        (lower-object patch system))))
 
   (mlet %store-monad ((tar ->     (lookup-input "tar"))
+                      (gzip ->    (lookup-input "gzip"))
+                      (bzip2 ->   (lookup-input "bzip2"))
+                      (lzip ->    (lookup-input "lzip"))
                       (xz ->      (lookup-input "xz"))
                       (patch ->   (lookup-input "patch"))
                       (locales -> (lookup-input "locales"))
-                      (decomp ->  (lookup-input decompression-type))
+                      (decomp ->  (and=> decompression-type lookup-input))
                       (patches    (sequence %store-monad
                                             (map instantiate-patch patches))))
     (define build
       (with-imported-modules '((guix build utils))
         #~(begin
             (use-modules (ice-9 ftw)
+                         (ice-9 match)
+                         (ice-9 regex)
                          (srfi srfi-1)
+                         (srfi srfi-26)
                          (guix build utils))
 
+            (define (tarball? file-name)
+              ;; Return true if FILE-NAME has a tar extension.
+              (string-match "\\.tar(\\..*)?$" file-name))
+
             ;; The --sort option was added to GNU tar in version 1.28, released
             ;; 2014-07-28.  During bootstrap we must cope with older versions.
             (define tar-supports-sort?
@@ -702,12 +713,15 @@ specifies modules in scope when evaluating SNIPPET."
                                              (package-version locales)))))
               (setlocale LC_ALL "en_US.utf8"))
 
-            (setenv "PATH" (string-append #+xz "/bin" ":"
-                                          #+decomp "/bin"))
+            (setenv "PATH"
+                    (string-append #+xz "/bin"
+                                   (if #+decomp
+                                       (string-append ":" #+decomp "/bin")
+                                       "")))
 
             (setenv "XZ_DEFAULTS" (string-join (%xz-parallel-args)))
 
-            ;; SOURCE may be either a directory or a tarball.
+            ;; SOURCE may be either a directory, a tarball or a simple file.
             (if (file-is-directory? #+source)
                 (let* ((store     (%store-directory))
                        (len       (+ 1 (string-length store)))
@@ -716,31 +730,51 @@ specifies modules in scope when evaluating SNIPPET."
                        (directory (string-drop base (+ 1 dash))))
                   (mkdir directory)
                   (copy-recursively #+source directory))
-                #+(if (string=? decompression-type "unzip")
-                      #~(invoke "unzip" #+source)
-                      #~(invoke (string-append #+tar "/bin/tar")
-                                "xvf" #+source)))
-
-            (let ((directory (first-file ".")))
-              (format (current-error-port)
-                      "source is under '~a'~%" directory)
-              (chdir directory)
-
-              (for-each apply-patch '#+patches)
-
-              #+(if snippet
-                    #~(let ((module (make-fresh-user-module)))
-                        (module-use-interfaces!
-                         module
-                         (map resolve-interface '#+modules))
-                        ((@ (system base compile) compile)
-                         '#+snippet
-                         #:to 'value
-                         #:opts %auto-compilation-options
-                         #:env module))
-                    #~#t)
-
-              (chdir "..")
+                ;; File is *not* a directory.
+                (cond
+                 ((tarball? #+source)
+                  (invoke (string-append #+tar "/bin/tar")
+                          "xvf" #+source))
+                 ((and=> #+decompression-type (cut string= "unzip" <>))
+                  ("unzip" (invoke "unzip" #+source)))
+                 (else
+                  ;; A simple file, either compressed or not.
+                  (match #+decompression-type
+                    ;; Note: Referring to the store unzip here (#+unzip)
+                    ;; introduces a cycle.
+                    ("unzip" (invoke "unzip" #+source))
+                    (else
+                     ;; bzip2, gzip, lzip and xz share a common CLI.
+                     (let ((name (strip-store-file-name #+source))
+                           (command (and=> #+decomp
+                                           (cut string-append <> "/bin/"
+                                                #+decompression-type))))
+                       (copy-file #+source name)
+                       (when command
+                         (invoke command "--decompress" name))))))))
+
+
+            (let* ((file (first-file "."))
+                   (directory (if (file-is-directory? file)
+                                  file
+                                  ".")))
+              (format (current-error-port) "source is at '~a'~%" file)
+
+              (with-directory-excursion directory
+
+                (for-each apply-patch '#+patches)
+
+                #+(if snippet
+                      #~(let ((module (make-fresh-user-module)))
+                          (module-use-interfaces!
+                           module
+                           (map resolve-interface '#+modules))
+                          ((@ (system base compile) compile)
+                           '#+snippet
+                           #:to 'value
+                           #:opts %auto-compilation-options
+                           #:env module))
+                      #~#t))
 
               (unless tar-supports-sort?
                 (call-with-output-file ".file_list"
diff --git a/tests/packages.scm b/tests/packages.scm
index a867f2fd6d..5c84dbf4b8 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,12 +18,12 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-(define-module (test-packages)
+(define-module (tests packages)
   #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix grafts)
-  #:use-module ((guix gexp) #:select (local-file local-file-file))
+  #:use-module (guix gexp)
   #:use-module (guix utils)
   #:use-module ((guix diagnostics)
                 ;; Rename the 'location' binding to allow proper syntax
@@ -32,6 +33,7 @@
                                   (else name))))
   #:use-module ((gcrypt hash) #:prefix gcrypt:)
   #:use-module (guix derivations)
+  #:use-module (guix download)
   #:use-module (guix packages)
   #:use-module (guix grafts)
   #:use-module (guix search-paths)
@@ -576,6 +578,11 @@
     (build-derivations %store (list drv))
     (call-with-input-file output get-string-all)))
 
+\f
+;;;
+;;; Source derivation with snippets.
+;;;
+
 (unless (network-reachable?) (test-skip 1))
 (test-equal "package-source-derivation, snippet"
   "OK"
@@ -631,6 +638,80 @@
     (and (build-derivations %store (list (pk 'snippet-drv drv)))
          (call-with-input-file out get-string-all))))
 
+;; Note: lzip is not part of bootstrap-coreutils&co, so is not included to
+;; avoid having to rebuild the world.
+(define compressors '(("gzip"  . "gz")
+                      ("xz"    . "xz")
+                      ("bzip2" . "bz2")
+                      (#f      . #f)))
+
+(for-each
+ (match-lambda
+   ((comp . ext)
+    (unless (network-reachable?) (test-skip 1))
+    (test-equal (string-append "origin->derivation, single file with snippet "
+                               "(compression: " (if comp comp "None") ")")
+      "2 + 2 = 4"
+      (let* ((name "maths")
+             (compressed-name (if comp
+                                  (string-append name "." ext)
+                                  name))
+             (command #~(if #+comp
+                            (string-append #+%bootstrap-coreutils&co
+                                           "/bin/" #+comp)
+                            #f))
+             (f (with-imported-modules '((guix build utils))
+                  (computed-file compressed-name
+                                 #~(begin
+                                     (use-modules (guix build utils)
+                                                  (rnrs io simple))
+                                     (with-output-to-file #+name
+                                       (lambda _
+                                         (format #t "2 + 2 = 5")))
+                                     (when #+command
+                                       (invoke #+command #+name))
+                                     (copy-file #+compressed-name #$output)))))
+             (file-drv (run-with-store %store (lower-object f)))
+             (file (derivation->output-path file-drv))
+             (file-drv-outputs (derivation-outputs file-drv))
+             (_ (build-derivations %store (list file-drv)))
+             (file-hash (derivation-output-hash
+                         (assoc-ref file-drv-outputs "out")))
+             ;; Create an origin using the above computed file and its hash.
+             (source (origin
+                       (method url-fetch)
+                       (uri (string-append "file://" file))
+                       (file-name compressed-name)
+                       (patch-inputs `(("tar"   ,%bootstrap-coreutils&co)
+                                       ("xz"    ,%bootstrap-coreutils&co)
+                                       ("bzip2" ,%bootstrap-coreutils&co)
+                                       ("gzip"  ,%bootstrap-coreutils&co)))
+                       (patch-guile %bootstrap-guile)
+                       (modules '((guix build utils)))
+                       (snippet `(substitute* ,name
+                                   (("5") "4")))
+                       (hash (content-hash file-hash))))
+             ;; Build origin.
+             (drv (run-with-store %store (origin->derivation source)))
+             (out (derivation->output-path drv)))
+        ;; Decompress the resulting tar.xz and return its content.
+        (and (build-derivations %store (list drv))
+             (let* ((bin #~(string-append #+%bootstrap-coreutils&co
+                                          "/bin"))
+                    (f (computed-file
+                        name
+                        (with-imported-modules '((guix build utils))
+                          #~(begin
+                              (use-modules (guix build utils))
+                              (setenv "PATH" #+bin)
+                              (invoke "tar" "xvf" #+out)
+                              (copy-file #+name #$output)))))
+                    (drv (run-with-store %store (lower-object f)))
+                    (_ (build-derivations %store (list drv))))
+               (call-with-input-file (derivation->output-path drv)
+                 get-string-all)))))))
+ compressors)
+
 (test-assert "return value"
   (let ((drv (package-derivation %store (dummy-package "p"))))
     (and (derivation? drv)
-- 
2.29.2





^ permalink raw reply related	[flat|nested] 11+ messages in thread
* [bug#45773] [PATCH core-updates 0/1] Allow patch-and-repack to work with plain files.
@ 2021-01-10 20:02 Maxim Cournoyer
  2021-01-10 22:07 ` Maxim Cournoyer
  0 siblings, 1 reply; 11+ messages in thread
From: Maxim Cournoyer @ 2021-01-10 20:02 UTC (permalink / raw)
  To: 45773

While attempting to reproduce the now closed issue
<http://issues.guix.gnu.org/30116>, I stumbled upon another annoyance, which
is that the patch-and-repack procedure used as part of an origin derivation
didn't support single files, so the following failed, for example:

<#part type="text/plain" filename="/home/maxim/src/guix-core-updates/repro.scm" disposition=inline description="Script exhibiting problem">
<#/part>

The following patch fixes that, allowing to use plain files with any of the
already supported compressors, or non-tarball archived that would include a
single directory (the same convention as used for our tarballs).

Maxim Cournoyer (1):
  guix: packages: Allow patch-and-repack to work with plain files.

 guix/packages.scm  | 96 +++++++++++++++++++++++++++++++---------------
 tests/packages.scm | 87 +++++++++++++++++++++++++++++++++++++++--
 2 files changed, 149 insertions(+), 34 deletions(-)

-- 
2.29.2




^ permalink raw reply	[flat|nested] 11+ messages in thread

end of thread, other threads:[~2021-01-27 23:12 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-01-10 20:05 [bug#45774] [PATCH core-updates 1/1] guix: packages: Allow patch-and-repack to work with plain files Maxim Cournoyer
2021-01-13 17:40 ` [bug#45774] [PATCH core-updates v2] build-systems/gnu: Allow unpacking/repacking more kind of files Maxim Cournoyer
2021-01-14 17:48   ` [bug#45773] [PATCH core-updates 0/1] Allow patch-and-repack to work with plain files Ludovic Courtès
2021-01-14 18:43     ` Maxim Cournoyer
2021-01-27  3:57       ` bug#45773: " Maxim Cournoyer
2021-01-18 16:51 ` [bug#45774] [PATCH core-updates v3 1/2] utils: Retrieve the store prefix from NIX_STORE_DIR, not STORE_DIR Maxim Cournoyer
2021-01-18 16:51   ` [bug#45774] [PATCH core-updates v3 2/2] build-systems/gnu: Allow unpacking/repacking more kind of files Maxim Cournoyer
2021-01-27  3:58   ` [bug#45774] bug#45958: [PATCH core-updates v3 1/2] utils: Retrieve the store prefix from NIX_STORE_DIR, not STORE_DIR Maxim Cournoyer
2021-01-27 23:10     ` [bug#45958] " Ludovic Courtès
  -- strict thread matches above, loose matches on Subject: below --
2021-01-10 20:02 [bug#45773] [PATCH core-updates 0/1] Allow patch-and-repack to work with plain files Maxim Cournoyer
2021-01-10 22:07 ` Maxim Cournoyer

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.