nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

packages: patch-and-repack: Use invoke instead of system*. 

* guix/packages.scm (patch-and-repack): Use invoke and remove vestigial
plumbing.
This commit is contained in:
Mark H Weaver 2018-03-16 03:38:27 -04:00
parent 80420f114c
commit 7ac1b4084f
No known key found for this signature in database
GPG Key ID: 7CEF29847562C516
1 changed files with 61 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
guix/packages.scm
View File

@ -519,9 +519,9 @@ specifies modules in scope when evaluating SNIPPET."
;; Use '--force' so that patches that do not apply perfectly are ;; Use '--force' so that patches that do not apply perfectly are
;; rejected. Use '--no-backup-if-mismatch' to prevent making ;; rejected. Use '--no-backup-if-mismatch' to prevent making
;; "*.orig" file if a patch is applied with offset. ;; "*.orig" file if a patch is applied with offset.
(zero? (system* (string-append #+patch "/bin/patch") (invoke (string-append #+patch "/bin/patch")
"--force" "--no-backup-if-mismatch" "--force" "--no-backup-if-mismatch"
#+@flags "--input" patch))) #+@flags "--input" patch))
(define (first-file directory) (define (first-file directory)
;; Return the name of the first file in DIRECTORY. ;; Return the name of the first file in DIRECTORY.
@ -546,64 +546,67 @@ specifies modules in scope when evaluating SNIPPET."
#+decomp "/bin")) #+decomp "/bin"))
;; SOURCE may be either a directory or a tarball. ;; SOURCE may be either a directory or a tarball.
(and (if (file-is-directory? #+source) (if (file-is-directory? #+source)
(let* ((store (%store-directory)) (let* ((store (%store-directory))
(len (+ 1 (string-length store))) (len (+ 1 (string-length store)))
(base (string-drop #+source len)) (base (string-drop #+source len))
(dash (string-index base #\-)) (dash (string-index base #\-))
(directory (string-drop base (+ 1 dash)))) (directory (string-drop base (+ 1 dash))))
(mkdir directory) (mkdir directory)
(copy-recursively #+source directory) (copy-recursively #+source directory))
#t) #+(if (string=? decompression-type "unzip")
#+(if (string=? decompression-type "unzip") #~(invoke "unzip" #+source)
#~(zero? (system* "unzip" #+source)) #~(invoke (string-append #+tar "/bin/tar")
#~(zero? (system* (string-append #+tar "/bin/tar") "xvf" #+source)))
"xvf" #+source))))
(let ((directory (first-file ".")))
(format (current-error-port)
"source is under '~a'~%" directory)
(chdir directory)
(and (every apply-patch '#+patches) (let ((directory (first-file ".")))
#+@(if snippet (format (current-error-port)
#~((let ((module (make-fresh-user-module))) "source is under '~a'~%" directory)
(module-use-interfaces! (chdir directory)
module
(map resolve-interface '#+modules))
((@ (system base compile) compile)
'#+snippet
#:to 'value
#:opts %auto-compilation-options
#:env module)))
#~())
(begin (chdir "..") #t) (for-each apply-patch '#+patches)
(unless tar-supports-sort? (unless #+@(if snippet
(call-with-output-file ".file_list" #~((let ((module (make-fresh-user-module)))
(lambda (port) (module-use-interfaces!
(for-each (lambda (name) module
(format port "~a~%" name)) (map resolve-interface '#+modules))
(find-files directory ((@ (system base compile) compile)
#:directories? #t '#+snippet
#:fail-on-error? #t))))) #:to 'value
(zero? (apply system* #:opts %auto-compilation-options
(string-append #+tar "/bin/tar") #:env module)))
"cvf" #$output #~())
;; The bootstrap xz does not support (format (current-error-port)
;; threaded compression (introduced in "snippet returned false, indicating failure~%"))
;; 5.2.0), but it ignores the extra flag.
(string-append "--use-compress-program=" (chdir "..")
#+xz "/bin/xz --threads=0")
;; avoid non-determinism in the archive (unless tar-supports-sort?
"--mtime=@0" (call-with-output-file ".file_list"
"--owner=root:0" (lambda (port)
"--group=root:0" (for-each (lambda (name)
(if tar-supports-sort? (format port "~a~%" name))
`("--sort=name" (find-files directory
,directory) #:directories? #t
'("--no-recursion" #:fail-on-error? #t)))))
"--files-from=.file_list")))))))))) (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))) (let ((name (tarxz-name original-file-name)))
(gexp->derivation name build (gexp->derivation name build