From 7ac1b4084f04a2ac628e1e69a771b98ccb4bee3c Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Fri, 16 Mar 2018 03:38:27 -0400
Subject: packages: patch-and-repack: Use invoke instead of system*.

* guix/packages.scm (patch-and-repack): Use invoke and remove vestigial
plumbing.
---
 guix/packages.scm | 125 ++++++++++++++++++++++++++++--------------------------
 1 file changed, 64 insertions(+), 61 deletions(-)

(limited to 'guix')

diff --git a/guix/packages.scm b/guix/packages.scm
index b5c0b60440..41d98e1414 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -519,9 +519,9 @@ (define (apply-patch patch)
               ;; Use '--force' so that patches that do not apply perfectly are
               ;; rejected.  Use '--no-backup-if-mismatch' to prevent making
               ;; "*.orig" file if a patch is applied with offset.
-              (zero? (system* (string-append #+patch "/bin/patch")
-                              "--force" "--no-backup-if-mismatch"
-                              #+@flags "--input" patch)))
+              (invoke (string-append #+patch "/bin/patch")
+                      "--force" "--no-backup-if-mismatch"
+                      #+@flags "--input" patch))
 
             (define (first-file directory)
               ;; Return the name of the first file in DIRECTORY.
@@ -546,64 +546,67 @@ (define (first-file directory)
                                           #+decomp "/bin"))
 
             ;; SOURCE may be either a directory or a tarball.
-            (and (if (file-is-directory? #+source)
-                     (let* ((store     (%store-directory))
-                            (len       (+ 1 (string-length store)))
-                            (base      (string-drop #+source len))
-                            (dash      (string-index base #\-))
-                            (directory (string-drop base (+ 1 dash))))
-                       (mkdir directory)
-                       (copy-recursively #+source directory)
-                       #t)
-                     #+(if (string=? decompression-type "unzip")
-                           #~(zero? (system* "unzip" #+source))
-                           #~(zero? (system* (string-append #+tar "/bin/tar")
-                                             "xvf" #+source))))
-                 (let ((directory (first-file ".")))
-                   (format (current-error-port)
-                           "source is under '~a'~%" directory)
-                   (chdir directory)
-
-                   (and (every 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)))
-                               #~())
-
-                        (begin (chdir "..") #t)
-
-                        (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)))))
-                        (zero? (apply system*
-                                      (string-append #+tar "/bin/tar")
-                                      "cvf" #$output
-                                      ;; The bootstrap xz does not support
-                                      ;; threaded compression (introduced in
-                                      ;; 5.2.0), but it ignores the extra flag.
-                                      (string-append "--use-compress-program="
-                                                     #+xz "/bin/xz --threads=0")
-                                      ;; avoid non-determinism in the archive
-                                      "--mtime=@0"
-                                      "--owner=root:0"
-                                      "--group=root:0"
-                                      (if tar-supports-sort?
-                                          `("--sort=name"
-                                            ,directory)
-                                          '("--no-recursion"
-                                            "--files-from=.file_list"))))))))))
+            (if (file-is-directory? #+source)
+                (let* ((store     (%store-directory))
+                       (len       (+ 1 (string-length store)))
+                       (base      (string-drop #+source len))
+                       (dash      (string-index base #\-))
+                       (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)
+
+              (unless #+@(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)))
+                             #~())
+                (format (current-error-port)
+                        "snippet returned false, indicating failure~%"))
+
+              (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")
+                     "cvf" #$output
+                     ;; The bootstrap xz does not support
+                     ;; threaded compression (introduced in
+                     ;; 5.2.0), but it ignores the extra flag.
+                     (string-append "--use-compress-program="
+                                    #+xz "/bin/xz --threads=0")
+                     ;; avoid non-determinism in the archive
+                     "--mtime=@0"
+                     "--owner=root:0"
+                     "--group=root:0"
+                     (if tar-supports-sort?
+                         `("--sort=name"
+                           ,directory)
+                         '("--no-recursion"
+                           "--files-from=.file_list")))))))
 
     (let ((name (tarxz-name original-file-name)))
       (gexp->derivation name build
-- 
cgit v1.2.3