From ad4835fe018a4a0c1955385c819fed7ec4a841d5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 17 Apr 2018 12:32:56 +0200 Subject: gremlin: Preserve offset info for dynamic entries. * guix/build/gremlin.scm (): New record type. (raw-dynamic-entries): Return a list of . (dynamic-entries): Adjust accordingly and return a list of . (elf-dynamic-info)[matching-entry]: New procedure. Use it. --- guix/build/gremlin.scm | 86 +++++++++++++++++++++++++++++--------------------- 1 file changed, 50 insertions(+), 36 deletions(-) (limited to 'guix') diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm index bb019967e5..78d1333117 100644 --- a/guix/build/gremlin.scm +++ b/guix/build/gremlin.scm @@ -99,10 +99,16 @@ dynamic linking information." ;; } d_un; ;; } Elf64_Dyn; +(define-record-type + (dynamic-entry type value offset) + dynamic-entry? + (type dynamic-entry-type) ;DT_* + (value dynamic-entry-value) ;string | number | ... + (offset dynamic-entry-offset)) ;integer + (define (raw-dynamic-entries elf segment) - "Return as a list of type/value pairs all the dynamic entries found in -SEGMENT, the 'PT_DYNAMIC' segment of ELF. In the result, each car is a DT_ -value, and the interpretation of the cdr depends on the type." + "Return as a list of for the dynamic entries found in +SEGMENT, the 'PT_DYNAMIC' segment of ELF." (define start (elf-segment-offset segment)) (define bytes @@ -123,7 +129,9 @@ value, and the interpretation of the cdr depends on the type." (if (= type DT_NULL) ;finished? (reverse result) (loop (+ offset (* 2 word-size)) - (alist-cons type value result))))))) + (cons (dynamic-entry type value + (+ start offset word-size)) + result))))))) (define (vma->offset elf vma) "Convert VMA, a virtual memory address, to an offset within ELF. @@ -148,35 +156,33 @@ offset." (define (dynamic-entries elf segment) "Return all the dynamic entries found in SEGMENT, the 'PT_DYNAMIC' segment -of ELF, as a list of type/value pairs. The type is a DT_ value, and the value -may be a string or an integer depending on the entry type (for instance, the -value of DT_NEEDED entries is a string.)" +of ELF, as a list of . The value of each entry may be a string +or an integer depending on the entry type (for instance, the value of +DT_NEEDED entries is a string.) Likewise the offset is the offset within the +string table if the type is a string." (define entries (raw-dynamic-entries elf segment)) (define string-table-offset - (any (match-lambda - ((type . value) - (and (= type DT_STRTAB) value)) - (_ #f)) + (any (lambda (entry) + (and (= (dynamic-entry-type entry) DT_STRTAB) + (dynamic-entry-value entry))) entries)) - (define (interpret-dynamic-entry type value) - (cond ((memv type (list DT_NEEDED DT_SONAME DT_RPATH DT_RUNPATH)) - (if string-table-offset - (pointer->string - (bytevector->pointer (elf-bytes elf) - (vma->offset - elf - (+ string-table-offset value)))) - value)) - (else - value))) - - (map (match-lambda - ((type . value) - (cons type (interpret-dynamic-entry type value)))) - entries)) + (define (interpret-dynamic-entry entry) + (let ((type (dynamic-entry-type entry)) + (value (dynamic-entry-value entry))) + (cond ((memv type (list DT_NEEDED DT_SONAME DT_RPATH DT_RUNPATH)) + (if string-table-offset + (let* ((offset (vma->offset elf (+ string-table-offset value))) + (value (pointer->string + (bytevector->pointer (elf-bytes elf) offset)))) + (dynamic-entry type value offset)) + (dynamic-entry type value (dynamic-entry-offset entry)))) + (else + (dynamic-entry type value (dynamic-entry-offset entry)))))) + + (map interpret-dynamic-entry entries)) ;;; @@ -200,21 +206,29 @@ value of DT_NEEDED entries is a string.)" (define (elf-dynamic-info elf) "Return dynamic-link information for ELF as an object, or #f if ELF lacks dynamic-link information." + (define (matching-entry type) + (lambda (entry) + (= type (dynamic-entry-type entry)))) + (match (dynamic-link-segment elf) (#f #f) ((? elf-segment? dynamic) (let ((entries (dynamic-entries elf dynamic))) - (%elf-dynamic-info (assv-ref entries DT_SONAME) - (filter-map (match-lambda - ((type . value) - (and (= type DT_NEEDED) value)) - (_ #f)) + (%elf-dynamic-info (find (matching-entry DT_SONAME) entries) + (filter-map (lambda (entry) + (and (= (dynamic-entry-type entry) + DT_NEEDED) + (dynamic-entry-value entry))) entries) - (or (and=> (assv-ref entries DT_RPATH) - search-path->list) + (or (and=> (find (matching-entry DT_RPATH) + entries) + (compose search-path->list + dynamic-entry-value)) '()) - (or (and=> (assv-ref entries DT_RUNPATH) - search-path->list) + (or (and=> (find (matching-entry DT_RUNPATH) + entries) + (compose search-path->list + dynamic-entry-value)) '())))))) (define %libc-libraries -- cgit v1.2.3 From b178fc236908ad2da86734ea8e01abd3ff8981da Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 17 Apr 2018 13:38:12 +0200 Subject: gremlin: Add 'strip-runpath'. * guix/build/gremlin.scm (strip-runpath): New procedure. * tests/gremlin.scm (c-compiler): New variable. ("strip-runpath"): New test. --- guix/build/gremlin.scm | 46 +++++++++++++++++++++++++++++++++++++++++++++- tests/gremlin.scm | 35 ++++++++++++++++++++++++++++++++++- 2 files changed, 79 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm index 78d1333117..e8ea66dfb3 100644 --- a/guix/build/gremlin.scm +++ b/guix/build/gremlin.scm @@ -41,7 +41,8 @@ elf-dynamic-info-runpath expand-origin - validate-needed-in-runpath)) + validate-needed-in-runpath + strip-runpath)) ;;; Commentary: ;;; @@ -320,4 +321,47 @@ be found in RUNPATH ~s~%" ;; (format (current-error-port) "~a is OK~%" file)) (null? not-found)))))) +(define (strip-runpath file) + "Remove from the DT_RUNPATH of FILE any entries that are not necessary +according to DT_NEEDED." + (define (minimal-runpath needed runpath) + (filter (lambda (directory) + (and (string-prefix? "/" directory) + (any (lambda (lib) + (file-exists? (string-append directory "/" lib))) + needed))) + runpath)) + + (define port + (open-file file "r+b")) + + (catch #t + (lambda () + (let* ((elf (parse-elf (get-bytevector-all port))) + (entries (dynamic-entries elf (dynamic-link-segment elf))) + (needed (filter-map (lambda (entry) + (and (= (dynamic-entry-type entry) + DT_NEEDED) + (dynamic-entry-value entry))) + entries)) + (runpath (find (lambda (entry) + (= DT_RUNPATH (dynamic-entry-type entry))) + entries)) + (old (search-path->list + (dynamic-entry-value runpath))) + (new (minimal-runpath needed old))) + (unless (equal? old new) + (format (current-error-port) + "~a: stripping RUNPATH to ~s (removed ~s)~%" + file new + (lset-difference string=? old new)) + (seek port (dynamic-entry-offset runpath) SEEK_SET) + (put-bytevector port (string->utf8 (string-join new ":"))) + (put-u8 port 0)) + (close-port port) + new)) + (lambda (key . args) + (false-if-exception (close-port port)) + (apply throw key args)))) + ;;; gremlin.scm ends here diff --git a/tests/gremlin.scm b/tests/gremlin.scm index 2885554967..1b47d5c384 100644 --- a/tests/gremlin.scm +++ b/tests/gremlin.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ludovic Courtès +;;; Copyright © 2015, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,12 +18,14 @@ (define-module (test-gremlin) #:use-module (guix elf) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module (guix build utils) #:use-module (guix build gremlin) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) + #:use-module (ice-9 popen) #:use-module (ice-9 match)) (define %guile-executable @@ -37,6 +39,9 @@ (define read-elf (compose parse-elf get-bytevector-all)) +(define c-compiler + (or (which "gcc") (which "cc") (which "g++"))) + (test-begin "gremlin") @@ -63,4 +68,32 @@ "../${ORIGIN}/bar/$ORIGIN/baz" "ORIGIN/foo"))) +(unless c-compiler + (test-skip 1)) +(test-equal "strip-runpath" + "hello\n" + (call-with-temporary-directory + (lambda (directory) + (with-directory-excursion directory + (call-with-output-file "t.c" + (lambda (port) + (display "int main () { puts(\"hello\"); }" port))) + (invoke c-compiler "t.c" + "-Wl,-rpath=/foo" "-Wl,-rpath=/bar") + (let* ((dyninfo (elf-dynamic-info + (parse-elf (call-with-input-file "a.out" + get-bytevector-all)))) + (old (elf-dynamic-info-runpath dyninfo)) + (new (strip-runpath "a.out")) + (new* (strip-runpath "a.out"))) + (validate-needed-in-runpath "a.out") + (and (member "/foo" old) (member "/bar" old) + (not (member "/foo" new)) + (not (member "/bar" new)) + (equal? new* new) + (let* ((pipe (open-input-pipe "./a.out")) + (str (get-string-all pipe))) + (close-pipe pipe) + str))))))) + (test-end "gremlin") -- cgit v1.2.3 From 8005640201fbc9b113f4f76fc7e55fe3f9a72738 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 18 Apr 2018 18:31:28 +0200 Subject: build-system/meson: Use 'strip-runpath' instead of PatchELF. * guix/build/meson-build-system.scm (fix-runpath): Call 'strip-runpath' instead of invoking 'patchelf'. --- guix/build/meson-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm index e7690a4c37..7efd433d6c 100644 --- a/guix/build/meson-build-system.scm +++ b/guix/build/meson-build-system.scm @@ -135,7 +135,7 @@ for example libraries only needed for the tests." (find-files dir elf-pred)) existing-elf-dirs)))) (for-each (lambda (elf-file) - (system* "patchelf" "--shrink-rpath" elf-file) + (strip-runpath elf-file) (handle-file elf-file elf-list)) elf-list))))) (for-each handle-output outputs) -- cgit v1.2.3 From 4dd91dff477b9717b3fa494b23976e4d69ab7dfc Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 6 Jun 2018 23:30:30 +0200 Subject: build-system/r: Fix type error. Reported-by: Mark H Weaver * guix/build/r-build-system.scm (pipe-to-r): Pass a list to the condition's "arguments" field. --- guix/build/r-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/r-build-system.scm b/guix/build/r-build-system.scm index 4d8ac5b479..2c0b322da9 100644 --- a/guix/build/r-build-system.scm +++ b/guix/build/r-build-system.scm @@ -44,7 +44,7 @@ (unless (zero? code) (raise (condition ((@@ (guix build utils) &invoke-error) (program "R") - (arguments (string-append params " " command)) + (arguments (cons command params)) (exit-status (status:exit-val code)) (term-signal (status:term-sig code)) (stop-signal (status:stop-sig code))))))))) -- cgit v1.2.3 From 302213b9be577bf6e120405ef4316520403fbee3 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sat, 30 Jun 2018 18:06:20 +0200 Subject: build-system/meson: Use invoke. * guix/build/meson-build-system.scm (configure, build, check, install): Use "invoke" and unconditionally return #t. --- guix/build/meson-build-system.scm | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm index 7efd433d6c..6dac007a6d 100644 --- a/guix/build/meson-build-system.scm +++ b/guix/build/meson-build-system.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Peter Mikkelsen +;;; Copyright © 2018 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -58,15 +59,17 @@ (mkdir build-dir) (chdir build-dir) - (zero? (apply system* "meson" args)))) + (apply invoke "meson" args) + #t)) (define* (build #:key parallel-build? #:allow-other-keys) "Build a given meson package." - (zero? (apply system* "ninja" - (if parallel-build? - `("-j" ,(number->string (parallel-job-count))) - '("-j" "1"))))) + (apply invoke "ninja" + (if parallel-build? + `("-j" ,(number->string (parallel-job-count))) + '("-j" "1"))) + #t) (define* (check #:key test-target parallel-tests? tests? #:allow-other-keys) @@ -75,13 +78,13 @@ (number->string (parallel-job-count)) "1")) (if tests? - (zero? (system* "ninja" test-target)) - (begin - (format #t "test suite not run~%") - #t))) + (invoke "ninja" test-target) + (format #t "test suite not run~%")) + #t) (define* (install #:rest args) - (zero? (system* "ninja" "install"))) + (invoke "ninja" "install") + #t) (define* (fix-runpath #:key (elf-directories '("lib" "lib64" "libexec" "bin" "sbin")) -- cgit v1.2.3 From 3e95125e9bd0676d4a9add9105217ad3eaef3ff0 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sun, 22 Jul 2018 17:58:16 +0200 Subject: Revert "packages: Enable threaded compression of source tarballs." Threaded compression makes tarballs non-deterministic: the result depends on the number of threads used for compressing. See . This reverts commit c8a3dea847bb9f87fa1876d0c6c3356d6226f121. --- guix/packages.scm | 5 ----- 1 file changed, 5 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index c762fa7c39..cc1f11ace2 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -629,11 +629,6 @@ specifies modules in scope when evaluating SNIPPET." (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" -- cgit v1.2.3 From 28c4905b123e7de85e5d2b654f4d15289625f2c0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Jul 2018 22:58:30 +0200 Subject: packages: 'patch-and-repack' compresses tarballs again. * guix/packages.scm (patch-and-repack): Add missing "a" in "tar cvfa". Fixes a regression introduced in 3e95125e9bd0676d4a9add9105217ad3eaef3ff0 whereby we'd always create uncompressed tarballs. --- guix/packages.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 3d9f281b74..01045ded07 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -628,7 +628,7 @@ specifies modules in scope when evaluating SNIPPET." #:fail-on-error? #t))))) (apply invoke (string-append #+tar "/bin/tar") - "cvf" #$output + "cvfa" #$output ;; avoid non-determinism in the archive "--mtime=@0" "--owner=root:0" -- cgit v1.2.3 From 8c7bebd6ea99f0ee4fb46a48ecb1883754c8cdde Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Jul 2018 22:59:49 +0200 Subject: gexp: Remove backward compatibility hack for 'imported-files'. * guix/gexp.scm (gexp->derivation): Remove #:import-creates-derivation?. (imported-files): Remove #:derivation? and adjust callers. (imported-modules), compiled-modules): Likewise. * guix/packages.scm (patch-and-repack): Adjust 'gexp->derivation' call. --- guix/gexp.scm | 28 ++++------------------------ guix/packages.scm | 3 --- tests/gexp.scm | 6 +++--- 3 files changed, 7 insertions(+), 30 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index ffc976d61b..f358102782 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -601,12 +601,6 @@ names and file names suitable for the #:allowed-references argument to allowed-references disallowed-references leaked-env-vars local-build? (substitutable? #t) - - ;; TODO: This parameter is transitional; it's here - ;; to avoid a full rebuild. Remove it on the next - ;; rebuild cycle. - import-creates-derivation? - deprecation-warnings (script-name (string-append name "-builder"))) "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a @@ -701,8 +695,6 @@ The other arguments are as for 'derivation'." extensions)) (modules (if (pair? %modules) (imported-modules %modules - #:derivation? - import-creates-derivation? #:system system #:module-path module-path #:guile guile-for-build @@ -711,8 +703,6 @@ The other arguments are as for 'derivation'." (return #f))) (compiled (if (pair? %modules) (compiled-modules %modules - #:derivation? - import-creates-derivation? #:system system #:module-path module-path #:extensions extensions @@ -1141,11 +1131,6 @@ to the source files instead of copying them." (define* (imported-files files #:key (name "file-import") - - ;; TODO: Remove this parameter on the next rebuild - ;; cycle. - (derivation? #f) - ;; The following parameters make sense when creating ;; an actual derivation. (system (%current-system)) @@ -1157,11 +1142,10 @@ file-like objects and not local file names.) FILES must be a list of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the resulting store path. FILE can be either a file name, or a file-like object, as returned by 'local-file' for example." - (if (or derivation? - (any (match-lambda - ((_ . (? struct? source)) #t) - (_ #f)) - files)) + (if (any (match-lambda + ((_ . (? struct? source)) #t) + (_ #f)) + files) (imported-files/derivation files #:name name #:symlink? derivation? #:system system #:guile guile @@ -1171,7 +1155,6 @@ as returned by 'local-file' for example." (define* (imported-modules modules #:key (name "module-import") - (derivation? #f) ;TODO: remove on next rebuild (system (%current-system)) (guile (%guile-for-build)) (module-path %load-path) @@ -1196,14 +1179,12 @@ last one is created from the given object." (cons f (search-path* module-path f))))) modules))) (imported-files files #:name name - #:derivation? derivation? #:system system #:guile guile #:deprecation-warnings deprecation-warnings))) (define* (compiled-modules modules #:key (name "module-import-compiled") - (derivation? #f) ;TODO: remove on next rebuild (system (%current-system)) (guile (%guile-for-build)) (module-path %load-path) @@ -1223,7 +1204,6 @@ they can refer to each other." (not (equal? module-path %load-path)))) (mlet %store-monad ((modules (imported-modules modules - #:derivation? derivation? #:system system #:guile guile #:module-path diff --git a/guix/packages.scm b/guix/packages.scm index 01045ded07..eab0b3404c 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -641,9 +641,6 @@ specifies modules in scope when evaluating SNIPPET." (let ((name (tarxz-name original-file-name))) (gexp->derivation name build - ;; TODO: Remove this on the next rebuild cycle. - #:import-creates-derivation? #t - #:graft? #f #:system system #:deprecation-warnings #t ;to avoid a rebuild diff --git a/tests/gexp.scm b/tests/gexp.scm index b22e635805..a0ed34aa6d 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -654,11 +654,11 @@ (drv (imported-files files))) (define (file=? file1 file2) ;; Assume deduplication is in place. - (= (stat:ino (lstat file1)) - (stat:ino (lstat file2)))) + (= (stat:ino (stat file1)) + (stat:ino (stat file2)))) (mbegin %store-monad - (built-derivations (list drv)) + (built-derivations (list (pk 'drv drv))) (mlet %store-monad ((dir -> (derivation->output-path drv)) (plain* (text-file "foo" "bar!")) (q-scm* (interned-file q-scm "c"))) -- cgit v1.2.3 From 4a42abc52c3303ae50c4ca79a00dabbea05b5fa9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Jul 2018 00:02:00 +0200 Subject: gexp: Inline bug-fix in 'compiled-modules'. This is a followup to 5d669883ecc104403c5d3ba7d172e9c02234577c. * guix/gexp.scm (compiled-modules)[build-utils-hack?]: Remove. Inline everything as if BUILD-UTILS-HACK? is true. --- guix/gexp.scm | 66 +++++++++++++++++++++-------------------------------------- 1 file changed, 23 insertions(+), 43 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index f358102782..c1070ba436 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1195,14 +1195,6 @@ corresponding to MODULES. All the MODULES are built in a context where they can refer to each other." (define total (length modules)) - (define build-utils-hack? - ;; To avoid a full rebuild, we limit the fix below to the case where - ;; MODULE-PATH is different from %LOAD-PATH. This happens when building - ;; modules for 'compute-guix-derivation' upon 'guix pull'. TODO: Make - ;; this unconditional on the next rebuild cycle. - (and (member '(guix build utils) modules) - (not (equal? module-path %load-path)))) - (mlet %store-monad ((modules (imported-modules modules #:system system #:guile guile @@ -1248,46 +1240,34 @@ they can refer to each other." (setvbuf (current-output-port) (cond-expand (guile-2.2 'line) (else _IOLBF))) - (ungexp-splicing - (if build-utils-hack? - (gexp ((define mkdir-p - ;; Capture 'mkdir-p'. - (@ (guix build utils) mkdir-p)))) - '())) + (define mkdir-p + ;; Capture 'mkdir-p'. + (@ (guix build utils) mkdir-p)) ;; Add EXTENSIONS to the search path. - ;; TODO: Remove the outer 'ungexp-splicing' on the next rebuild cycle. - (ungexp-splicing - (if (null? extensions) - '() - (gexp ((set! %load-path - (append (map (lambda (extension) - (string-append extension - "/share/guile/site/" - (effective-version))) - '((ungexp-native-splicing extensions))) - %load-path)) - (set! %load-compiled-path - (append (map (lambda (extension) - (string-append extension "/lib/guile/" - (effective-version) - "/site-ccache")) - '((ungexp-native-splicing extensions))) - %load-compiled-path)))))) + (set! %load-path + (append (map (lambda (extension) + (string-append extension + "/share/guile/site/" + (effective-version))) + '((ungexp-native-splicing extensions))) + %load-path)) + (set! %load-compiled-path + (append (map (lambda (extension) + (string-append extension "/lib/guile/" + (effective-version) + "/site-ccache")) + '((ungexp-native-splicing extensions))) + %load-compiled-path)) (set! %load-path (cons (ungexp modules) %load-path)) - (ungexp-splicing - (if build-utils-hack? - ;; Above we loaded our own (guix build utils) but now we may - ;; need to load a compile a different one. Thus, force a - ;; reload. - (gexp ((let ((utils (ungexp - (file-append modules - "/guix/build/utils.scm")))) - (when (file-exists? utils) - (load utils))))) - '())) + ;; Above we loaded our own (guix build utils) but now we may need to + ;; load a compile a different one. Thus, force a reload. + (let ((utils (string-append (ungexp modules) + "/guix/build/utils.scm"))) + (when (file-exists? utils) + (load utils))) (mkdir (ungexp output)) (chdir (ungexp modules)) -- cgit v1.2.3 From 8afa18d6e7f7aad7965af7e82e5afc975d19caea Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Jul 2018 00:09:52 +0200 Subject: gexp: Remove #:deprecation-warnings from 'imported-files'. This is a followup to 30d722c392960373bb45c3248d318ef6e248fb67. * guix/gexp.scm (imported-files/derivation): Remove #:deprecation-warnings. Pass "GUILE_WARN_DEPRECATED=no" unconditionally to #:env-vars of 'gexp->derivation'. Adjust caller. (imported-files): Remove #:deprecation-warnings and adjust callers. (imported-modules): Likewise. (compiled-modules, gexp->derivation): Adjust accordingly. --- guix/gexp.scm | 42 ++++++++++-------------------------------- 1 file changed, 10 insertions(+), 32 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index c1070ba436..3a600c3830 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -697,9 +697,7 @@ The other arguments are as for 'derivation'." (imported-modules %modules #:system system #:module-path module-path - #:guile guile-for-build - #:deprecation-warnings - deprecation-warnings) + #:guile guile-for-build) (return #f))) (compiled (if (pair? %modules) (compiled-modules %modules @@ -1070,15 +1068,7 @@ to a tree suitable for 'interned-file-tree'." #:key (name "file-import") (symlink? #f) (system (%current-system)) - (guile (%guile-for-build)) - - ;; XXX: The only reason we have - ;; #:deprecation-warnings is because (guix - ;; build utils), which we use here, relies - ;; on _IO*, which is deprecated in 2.2. On - ;; the next full-rebuild cycle, we should - ;; disable such warnings unconditionally. - (deprecation-warnings #f)) + (guile (%guile-for-build))) "Return a derivation that imports FILES into STORE. FILES must be a list of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the resulting store path. FILE can be either a file name, or a file-like object, @@ -1118,24 +1108,17 @@ to the source files instead of copying them." #:guile-for-build guile #:local-build? #t - ;; TODO: On the next rebuild cycle, set to "no" - ;; unconditionally. + ;; Avoid deprecation warnings about the use of the _IO* + ;; constants in (guix build utils). #:env-vars - (case deprecation-warnings - ((#f) - '(("GUILE_WARN_DEPRECATED" . "no"))) - ((detailed) - '(("GUILE_WARN_DEPRECATED" . "detailed"))) - (else - '()))))) + '(("GUILE_WARN_DEPRECATED" . "no"))))) (define* (imported-files files #:key (name "file-import") ;; The following parameters make sense when creating ;; an actual derivation. (system (%current-system)) - (guile (%guile-for-build)) - (deprecation-warnings #f)) + (guile (%guile-for-build))) "Import FILES into the store and return the resulting derivation or store file name (a derivation is created if and only if some elements of FILES are file-like objects and not local file names.) FILES must be a list @@ -1148,8 +1131,7 @@ as returned by 'local-file' for example." files) (imported-files/derivation files #:name name #:symlink? derivation? - #:system system #:guile guile - #:deprecation-warnings deprecation-warnings) + #:system system #:guile guile) (interned-file-tree `(,name directory ,@(file-mapping->tree files))))) @@ -1157,8 +1139,7 @@ as returned by 'local-file' for example." #:key (name "module-import") (system (%current-system)) (guile (%guile-for-build)) - (module-path %load-path) - (deprecation-warnings #f)) + (module-path %load-path)) "Return a derivation that contains the source files of MODULES, a list of module names such as `(ice-9 q)'. All of MODULES must be either names of modules to be found in the MODULE-PATH search path, or a module name followed @@ -1180,8 +1161,7 @@ last one is created from the given object." modules))) (imported-files files #:name name #:system system - #:guile guile - #:deprecation-warnings deprecation-warnings))) + #:guile guile))) (define* (compiled-modules modules #:key (name "module-import-compiled") @@ -1199,9 +1179,7 @@ they can refer to each other." #:system system #:guile guile #:module-path - module-path - #:deprecation-warnings - deprecation-warnings))) + module-path))) (define build (gexp (begin -- cgit v1.2.3 From 2abd76e8afe64ef4f4041ff02e9b22debb9f0483 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Jul 2018 11:20:09 +0200 Subject: gnu: guile: Update to 2.2.4. * gnu/packages/guile.scm (guile-2.2): Update to 2.2.4. (guile-2.2.4): Remove. * gnu/packages/package-management.scm (guix)[inputs]: Switch to GUILE-2.2. * guix/self.scm (guile-for-build): Likewise. --- gnu/packages/guile.scm | 18 ++---------------- gnu/packages/package-management.scm | 4 +--- guix/self.scm | 4 +--- 3 files changed, 4 insertions(+), 22 deletions(-) (limited to 'guix') diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index f179f293ea..59f09375ad 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -228,7 +228,7 @@ without requiring the source code to be rewritten.") (define-public guile-2.2 (package (inherit guile-2.0) (name "guile") - (version "2.2.3") + (version "2.2.4") (source (origin (method url-fetch) @@ -238,7 +238,7 @@ without requiring the source code to be rewritten.") ".tar.xz")) (sha256 (base32 - "11j01agvnci2cx32wwpqs9078856yxmvs15gcsz7ganpkj2ahlw3")) + "07p3g0v2ba2vlfbfidqzlgbhnzdx46wh2rgc5gszq1mjyx5bks6r")) (modules '((guix build utils))) ;; Remove the pre-built object files. Instead, build everything @@ -302,20 +302,6 @@ without requiring the source code to be rewritten.") (base32 "1azm25zcmxif0skxfrp11d2wc89nrzpjaann9yxdw6pvjxhs948w")))))) -(define-public guile-2.2.4 - ;; This version contains important bug fixes, in particular wrt. to crashes - ;; of multi-threaded code as used by 'guix pull' and grafting. - (package - (inherit guile-2.2) - (version "2.2.4") - (source (origin - (inherit (package-source guile-2.2)) - (uri (string-append "mirror://gnu/guile/guile-" version - ".tar.xz")) - (sha256 - (base32 - "07p3g0v2ba2vlfbfidqzlgbhnzdx46wh2rgc5gszq1mjyx5bks6r")))))) - (define-public guile-next (deprecated-package "guile-next" guile-2.2)) diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index b7e3b320f6..58b8ca235c 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -264,9 +264,7 @@ ("sqlite" ,sqlite) ("libgcrypt" ,libgcrypt) - ;; Use 2.2.4 to avoid various thread-safety issues while building - ;; code in parallel. - ("guile" ,guile-2.2.4) + ("guile" ,guile-2.2) ;; Many tests rely on the 'guile-bootstrap' package, which is why we ;; have it here. diff --git a/guix/self.scm b/guix/self.scm index 5ad644b1df..21b85eb253 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -896,10 +896,8 @@ running Guile." (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.2.2)) ("2.2" - ;; Use the latest version, which has fixes for - ;; and VM stack-marking issues. (canonical-package (module-ref (resolve-interface '(gnu packages guile)) - 'guile-2.2.4))) + 'guile-2.2))) ("2.0" (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.0)))) -- cgit v1.2.3 From 8bece84022752b635b28dba0b051d215bcc19fab Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Jul 2018 11:26:02 +0200 Subject: gnu: guile: Remove version 2.2.2. * gnu/packages/guile.scm (guile-2.2.2): Remove. * guix/self.scm (guile-for-build): Remove special case for "2.2.2". (guix-derivation): Likewise. * build-aux/build-self.scm (build): Likewise. --- build-aux/build-self.scm | 4 +--- gnu/packages/guile.scm | 15 --------------- guix/self.scm | 9 +-------- 3 files changed, 2 insertions(+), 26 deletions(-) (limited to 'guix') diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index 3ecdc931a5..d8f3ff9bb0 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -297,9 +297,7 @@ person's version identifier." ;; The procedure below is our return value. (define* (build source #:key verbose? (version (date-version-string)) system - (guile-version (match ((@ (guile) version)) - ("2.2.2" "2.2.2") - (_ (effective-version)))) + (guile-version (effective-version)) (pull-version 0) #:allow-other-keys #:rest rest) diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 59f09375ad..a6de4467d3 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -287,21 +287,6 @@ without requiring the source code to be rewritten.") (max-silent-time . 36000))))) ;10 hours (needed on ARM ; when heavily loaded) -(define-public guile-2.2.2 - ;; Keep it so that, when 'guix' runs on 2.2.2, 'guix pull' compiles objects - ;; with 2.2.2, thereby avoiding the ABI incompatibility issues described in - ;; . - (package - (inherit guile-2.2) - (version "2.2.2") - (source (origin - (inherit (package-source guile-2.2)) - (uri (string-append "mirror://gnu/guile/guile-" version - ".tar.xz")) - (sha256 - (base32 - "1azm25zcmxif0skxfrp11d2wc89nrzpjaann9yxdw6pvjxhs948w")))))) - (define-public guile-next (deprecated-package "guile-next" guile-2.2)) diff --git a/guix/self.scm b/guix/self.scm index 21b85eb253..c800c452e6 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -890,11 +890,6 @@ running Guile." 'canonical-package)) (match version - ("2.2.2" - ;; Gross hack to avoid ABI incompatibilities (see - ;; .) - (module-ref (resolve-interface '(gnu packages guile)) - 'guile-2.2.2)) ("2.2" (canonical-package (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.2))) @@ -925,9 +920,7 @@ is not supported." #:name (string-append "guix-" (shorten version)) #:pull-version pull-version - #:guile-version (match guile-version - ("2.2.2" "2.2") - (version version)) + #:guile-version guile-version #:guile-for-build guile))) (if guix (lower-object guix) -- cgit v1.2.3 From a1454169e0080d834cbddf94f04c5bcb7c3703e9 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 23 Jul 2018 17:14:15 +0200 Subject: gnu: python: Update to 3.7.0. * gnu/packages/python.scm (python-3.6): Rename to ... (python-3.7): ... this. Update to 3.7.0. [arguments]: Remove phase 'patch-timestamp-for-pyc-files' and related code. Add phases to unset SOURCE_DATE_EPOCH during the check phase. (python-3): Is now PYTHON-3.7. * guix/build/python-build-system.scm (enable-bytecode-determinism): Don't set DETERMINISTIC_BUILD. --- gnu/packages/python.scm | 61 ++++++++------------------------------ guix/build/python-build-system.scm | 2 -- 2 files changed, 13 insertions(+), 50 deletions(-) (limited to 'guix') diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index cdeedfe73b..e39460594b 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -321,10 +321,10 @@ data types.") (name "python") (properties `((superseded . ,python-2))))) -(define-public python-3.6 +(define-public python-3.7 (package (inherit python-2) (name "python") - (version "3.6.5") + (version "3.7.0") (source (origin (method url-fetch) (uri (string-append "https://www.python.org/ftp/python/" @@ -337,7 +337,7 @@ data types.") (patch-flags '("-p0")) (sha256 (base32 - "19l7inxm056jjw33zz97z0m02hsi7jnnx5kyb76abj5ml4xhad7l")) + "0j9mic5c9lbd2b20wka7hily7szz740wy9ilfrczxap63rnrk0h3")) (snippet '(begin (for-each delete-file @@ -348,53 +348,18 @@ data types.") (arguments (substitute-keyword-arguments (package-arguments python-2) ((#:phases phases) - `(modify-phases ,phases - (add-after 'unpack 'patch-timestamp-for-pyc-files - (lambda _ - ;; We set DETERMINISTIC_BUILD to only override the mtime when - ;; building with Guix, lest we break auto-compilation in - ;; environments. - (setenv "DETERMINISTIC_BUILD" "1") - (substitute* "Lib/py_compile.py" - (("source_stats\\['mtime'\\]") - "(1 if 'DETERMINISTIC_BUILD' in os.environ else source_stats['mtime'])")) - - ;; Use deterministic hashes for strings, bytes, and datetime - ;; objects. - (setenv "PYTHONHASHSEED" "0") - - ;; Reset mtime when validating bytecode header. - (substitute* "Lib/importlib/_bootstrap_external.py" - (("source_mtime = int\\(source_stats\\['mtime'\\]\\)") - "source_mtime = 1")) - #t)) - ;; These tests fail because of our change to the bytecode - ;; validation. They fail because expected exceptions do not get - ;; thrown. This seems to be no problem. - (add-after 'unpack 'disable-broken-bytecode-tests - (lambda _ - (substitute* "Lib/test/test_importlib/source/test_file_loader.py" - (("test_bad_marshal") - "disable_test_bad_marshal") - (("test_no_marshal") - "disable_test_no_marshal") - (("test_non_code_marshal") - "disable_test_non_code_marshal")) - #t)) - ;; Unset DETERMINISTIC_BUILD to allow for tests that check that - ;; stale pyc files are rebuilt. - (add-before 'check 'allow-non-deterministic-compilation - (lambda _ (unsetenv "DETERMINISTIC_BUILD") #t)) - ;; We need to rebuild all pyc files for three different - ;; optimization levels to replace all files that were not built - ;; deterministically. - - ;; FIXME: Without this phase we have close to 2000 files that + `(modify-phases ,phases + ;; Unset SOURCE_DATE_EPOCH while running the test-suite and set it + ;; again afterwards. See . + (add-before 'check 'unset-SOURCE_DATE_EPOCH + (lambda _ (unsetenv "SOURCE_DATE_EPOCH") #t)) + (add-after 'check 'reset-SOURCE_DATE_EPOCH + (lambda _ (setenv "SOURCE_DATE_EPOCH" "1") #t)) + ;; FIXME: Without this phase we have close to 400 files that ;; differ across different builds of this package. With this phase - ;; there are about 500 files left that differ. + ;; there are 44 files left that differ. (add-after 'install 'rebuild-bytecode (lambda* (#:key outputs #:allow-other-keys) - (setenv "DETERMINISTIC_BUILD" "1") (let ((out (assoc-ref outputs "out"))) (for-each (lambda (opt) @@ -421,7 +386,7 @@ data types.") "/site-packages")))))))) ;; Current 3.x version. -(define-public python-3 python-3.6) +(define-public python-3 python-3.7) ;; Current major version. (define-public python python-3) diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 376ea81f1a..5bb0ba49d5 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -246,8 +246,6 @@ installed with setuptools." (define* (enable-bytecode-determinism #:rest _) "Improve determinism of pyc files." - ;; Set DETERMINISTIC_BUILD to override the embedded mtime in pyc files. - (setenv "DETERMINISTIC_BUILD" "1") ;; Use deterministic hashes for strings, bytes, and datetime objects. (setenv "PYTHONHASHSEED" "0") #t) -- cgit v1.2.3 From 82230603ce06de7aa3e4aef2fa093a6dbf0ef8df Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 3 Aug 2018 23:12:33 -0400 Subject: build-system/gnu: If a phase returns #f, the build fails. Fixes . Introduced by commit d8a3b1b9e847d4a44d2695f95af77170d4d2788f. * guix/build/gnu-build-system.scm (gnu-build): Use 'every' instead of 'for-each'. --- guix/build/gnu-build-system.scm | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index be5ad78b93..e5f3197b0a 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -792,26 +792,26 @@ in order. Return #t if all the PHASES succeeded, #f otherwise." ;; The trick is to #:allow-other-keys everywhere, so that each procedure in ;; PHASES can pick the keyword arguments it's interested in. - (for-each (match-lambda - ((name . proc) - (let ((start (current-time time-monotonic))) - (format #t "starting phase `~a'~%" name) - (let ((result (apply proc args)) - (end (current-time time-monotonic))) - (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%" - name result - (elapsed-time end start)) - - ;; Issue a warning unless the result is #t. - (unless (eqv? result #t) - (format (current-error-port) "\ + (every (match-lambda + ((name . proc) + (let ((start (current-time time-monotonic))) + (format #t "starting phase `~a'~%" name) + (let ((result (apply proc args)) + (end (current-time time-monotonic))) + (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%" + name result + (elapsed-time end start)) + + ;; Issue a warning unless the result is #t. + (unless (eqv? result #t) + (format (current-error-port) "\ ## WARNING: phase `~a' returned `~s'. Return values other than #t ## are deprecated. Please migrate this package so that its phase ## procedures report errors by raising an exception, and otherwise ## always return #t.~%" - name result)) + name result)) - ;; Dump the environment variables as a shell script, for handy debugging. - (system "export > $NIX_BUILD_TOP/environment-variables") - result)))) - phases)) + ;; Dump the environment variables as a shell script, for handy debugging. + (system "export > $NIX_BUILD_TOP/environment-variables") + result)))) + phases)) -- cgit v1.2.3 From a7e231a2a3edbd6a70949432c1ff434d87f625ff Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 9 Aug 2018 14:37:36 +0200 Subject: build-system/haskell: Let all phases return #T unconditionally. * guix/build/haskell-build-system.scm (make-ghc-package-database, register, check, haddock): Return #T unconditionally; use INVOKE. --- guix/build/haskell-build-system.scm | 43 +++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 21 deletions(-) (limited to 'guix') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 26519ce5a6..5a72d22842 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2015 Eric Bavier ;;; Copyright © 2015 Paul van der Walt +;;; Copyright © 2018 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -178,9 +179,10 @@ first match and return the content of the group." (unless (file-exists? dest) (copy-file file dest)))) conf-files) - (zero? (system* "ghc-pkg" - (string-append "--package-db=" %tmp-db-dir) - "recache")))) + (invoke "ghc-pkg" + (string-append "--package-db=" %tmp-db-dir) + "recache") + #t)) (define* (register #:key name system inputs outputs #:allow-other-keys) "Generate the compiler registration and binary package database files for a @@ -238,32 +240,31 @@ given Haskell package." (list (string-append "--gen-pkg-config=" config-file)))) (run-setuphs "register" params) ;; The conf file is created only when there is a library to register. - (or (not (file-exists? config-file)) - (begin - (mkdir-p config-dir) - (let* ((config-file-name+id - (call-with-ascii-input-file config-file (cut grep id-rx <>)))) - (install-transitive-deps config-file %tmp-db-dir config-dir) - (rename-file config-file - (string-append config-dir "/" - config-file-name+id ".conf")) - (zero? (system* "ghc-pkg" - (string-append "--package-db=" config-dir) - "recache"))))))) + (unless (file-exists? config-file) + (mkdir-p config-dir) + (let* ((config-file-name+id + (call-with-ascii-input-file config-file (cut grep id-rx <>)))) + (install-transitive-deps config-file %tmp-db-dir config-dir) + (rename-file config-file + (string-append config-dir "/" + config-file-name+id ".conf")) + (invoke "ghc-pkg" + (string-append "--package-db=" config-dir) + "recache"))) + #t)) (define* (check #:key tests? test-target #:allow-other-keys) "Run the test suite of a given Haskell package." (if tests? (run-setuphs test-target '()) - (begin - (format #t "test suite not run~%") - #t))) + (format #t "test suite not run~%")) + #t) (define* (haddock #:key outputs haddock? haddock-flags #:allow-other-keys) "Run the test suite of a given Haskell package." - (if haddock? - (run-setuphs "haddock" haddock-flags) - #t)) + (when haddock? + (run-setuphs "haddock" haddock-flags)) + #t) (define %standard-phases (modify-phases gnu:%standard-phases -- cgit v1.2.3 From dd1e45335e135fe724acece440782344ef8ca9fd Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Fri, 6 Jul 2018 18:32:50 +0200 Subject: guix: svn: Remove all .svn folders. * guix/build/svn.scm (svn-fetch): Remove all .svn folders as they contain timestamps. --- guix/build/svn.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/svn.scm b/guix/build/svn.scm index 252d1d4ee5..913f89471b 100644 --- a/guix/build/svn.scm +++ b/guix/build/svn.scm @@ -51,7 +51,7 @@ valid Subversion revision. Return #t on success, #f otherwise." ;; of the repo. Since we want a fixed output, this directory needs ;; to be taken out. (with-directory-excursion directory - (delete-file-recursively ".svn")) + (for-each delete-file-recursively (find-files "." "^\\.svn$" #:directories? #t))) #t) -- cgit v1.2.3 From e6c4e41102f420cb05b32636909ecc9d45a624b7 Mon Sep 17 00:00:00 2001 From: Jelle Licht Date: Mon, 20 Aug 2018 16:51:04 +0200 Subject: utils: Generate valid substitutions in 'wrap-program'. * guix/build/utils.scm (wrap-program)[export-variable]: Generate valid bash substitutions when using custom separators. --- guix/build/utils.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index c58a1afd1c..5fe3286843 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1057,11 +1057,11 @@ with definitions for VARS." (format #f "export ~a=\"~a\"" var (string-join rest sep))) ((var sep 'prefix rest) - (format #f "export ~a=\"~a${~a~a+~a}$~a\"" - var (string-join rest sep) var sep sep var)) + (format #f "export ~a=\"~a${~a:+~a}$~a\"" + var (string-join rest sep) var sep var)) ((var sep 'suffix rest) - (format #f "export ~a=\"$~a${~a~a+~a}~a\"" - var var var sep sep (string-join rest sep))) + (format #f "export ~a=\"$~a${~a+~a}~a\"" + var var var sep (string-join rest sep))) ((var '= rest) (format #f "export ~a=\"~a\"" var (string-join rest ":"))) -- cgit v1.2.3 From bf91e6835d21e3bd7b49bb85b40f61389604c6f7 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Wed, 22 Aug 2018 16:22:36 +0200 Subject: build-system/meson: Strip RUNPATH and remove PatchELF traces. * guix/build-system/meson.scm (%meson-build-system-modules): Don't import (guix build rpath). * guix/build/meson-build-system.scm (fix-runpath): Rename to ... (shrink-runpath): ... this. Update docstring. Remove AUGMENT-RPATH calls and related code. (%standard-phases): Add 'shrink-runpath'. --- guix/build-system/meson.scm | 1 - guix/build/meson-build-system.scm | 52 ++++++--------------------------------- 2 files changed, 7 insertions(+), 46 deletions(-) (limited to 'guix') diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm index fddf899092..8d49020454 100644 --- a/guix/build-system/meson.scm +++ b/guix/build-system/meson.scm @@ -41,7 +41,6 @@ (define %meson-build-system-modules ;; Build-side modules imported by default. `((guix build meson-build-system) - (guix build rpath) ;; The modules from glib-or-gtk contains the modules from gnu-build-system, ;; so there is no need to import that too. ,@%glib-or-gtk-build-system-modules)) diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm index f6b8b49801..d0975fcab0 100644 --- a/guix/build/meson-build-system.scm +++ b/guix/build/meson-build-system.scm @@ -22,7 +22,6 @@ #:use-module ((guix build gnu-build-system) #:prefix gnu:) #:use-module ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:) #:use-module (guix build utils) - #:use-module (guix build rpath) #:use-module (guix build gremlin) #:use-module (guix elf) #:use-module (ice-9 match) @@ -78,42 +77,13 @@ (define* (install #:rest args) (invoke "ninja" "install")) -(define* (fix-runpath #:key (elf-directories '("lib" "lib64" "libexec" - "bin" "sbin")) - outputs #:allow-other-keys) - "Try to make sure all ELF files in ELF-DIRECTORIES are able to find their -local dependencies in their RUNPATH, by searching for the needed libraries in -the directories of the package, and adding them to the RUNPATH if needed. -Also shrink the RUNPATH to what is needed, +(define* (shrink-runpath #:key (elf-directories '("lib" "lib64" "libexec" + "bin" "sbin")) + outputs #:allow-other-keys) + "Go through all ELF files from ELF-DIRECTORIES and shrink the RUNPATH since a lot of directories are left over from the build phase of meson, for example libraries only needed for the tests." - ;; Find the directories (if any) that contains DEP-NAME. The directories - ;; searched are the ones that ELF-FILES are in. - (define (find-deps dep-name elf-files) - (map dirname (filter (lambda (file) - (string=? dep-name (basename file))) - elf-files))) - - ;; Return a list of libraries that FILE needs. - (define (file-needed file) - (let* ((elf (call-with-input-file file - (compose parse-elf get-bytevector-all))) - (dyninfo (elf-dynamic-info elf))) - (if dyninfo - (elf-dynamic-info-needed dyninfo) - '()))) - - - ;; If FILE needs any libs that are part of ELF-FILES, the RUNPATH - ;; is modified accordingly. - (define (handle-file file elf-files) - (let* ((dep-dirs (concatenate (map (lambda (dep-name) - (find-deps dep-name elf-files)) - (file-needed file))))) - (unless (null? dep-dirs) - (augment-rpath file (string-join dep-dirs ":"))))) - (define handle-output (match-lambda ((output . directory) @@ -129,10 +99,7 @@ for example libraries only needed for the tests." (elf-list (concatenate (map (lambda (dir) (find-files dir elf-pred)) existing-elf-dirs)))) - (for-each (lambda (elf-file) - (strip-runpath elf-file) - (handle-file elf-file elf-list)) - elf-list))))) + (for-each strip-runpath elf-list))))) (for-each handle-output outputs) #t) @@ -144,13 +111,8 @@ for example libraries only needed for the tests." (replace 'configure configure) (replace 'build build) (replace 'check check) - ;; XXX: We used to have 'fix-runpath' here, but it appears no longer - ;; necessary with newer Meson. However on 'core-updates' there is a - ;; useful 'strip-runpath' procedure to ensure no bogus directories in - ;; RUNPATH (remember that we tell Meson to not touch RUNPATH in - ;; (@ (gnu packages build-tools) meson-for-build)), so it should be - ;; re-added there sans the augment-rpath calls (which are not needed). - (replace 'install install))) + (replace 'install install) + (add-after 'strip 'shrink-runpath shrink-runpath))) (define* (meson-build #:key inputs phases #:allow-other-keys #:rest args) -- cgit v1.2.3 From 58352f269e46942c34d7ee4e29f91144576ca661 Mon Sep 17 00:00:00 2001 From: Alex Vong Date: Thu, 18 Oct 2018 02:53:32 +0800 Subject: build-system/haskell: Use 'strip-store-file-name'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit See the discussion at . * guix/build/haskell-build-system.scm (package-name-version): Remove it. (configure): Use 'strip-store-file-name' instead of 'package-name-version'. (setup-compiler): Likewise. (make-ghc-package-database): Likewise. (register): Likewise. * gnu/packages/haskell.scm (ghc-cairo)[arguments]: Likewise. * gnu/packages/agda.scm (agda)[arguments]: Likewise. Signed-off-by: Ludovic Courtès --- gnu/packages/agda.scm | 5 +++-- gnu/packages/haskell.scm | 4 ++-- guix/build/haskell-build-system.scm | 20 +++++++++----------- 3 files changed, 14 insertions(+), 15 deletions(-) (limited to 'guix') diff --git a/gnu/packages/agda.scm b/gnu/packages/agda.scm index 6bb38aac4d..d2113555eb 100644 --- a/gnu/packages/agda.scm +++ b/gnu/packages/agda.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Alex ter Weele ;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2018 Alex Vong ;;; ;;; This file is part of GNU Guix. ;;; @@ -85,6 +86,7 @@ (lambda* (#:key outputs inputs tests? (configure-flags '()) #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) + (name-version (strip-store-file-name out)) (input-dirs (match inputs (((_ . dir) ...) dir) @@ -95,8 +97,7 @@ `(,(string-append "--bindir=" out "/bin")) `(,(string-append "--docdir=" out - "/share/doc/" ((@@ (guix build haskell-build-system) - package-name-version) out))) + "/share/doc/" name-version)) '("--libsubdir=$compiler/$pkg-$version") '("--package-db=../package.conf.d") '("--global") diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm index 0a90ac523c..57435dca07 100644 --- a/gnu/packages/haskell.scm +++ b/gnu/packages/haskell.scm @@ -10619,6 +10619,7 @@ expose it from another module in the hierarchy. (lambda* (#:key outputs inputs tests? (configure-flags '()) #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) + (name-version (strip-store-file-name out)) (input-dirs (match inputs (((_ . dir) ...) dir) @@ -10629,8 +10630,7 @@ expose it from another module in the hierarchy. `(,(string-append "--bindir=" out "/bin")) `(,(string-append "--docdir=" out - "/share/doc/" ((@@ (guix build haskell-build-system) - package-name-version) out))) + "/share/doc/" name-version)) '("--libsubdir=$compiler/$pkg-$version") '("--package-db=../package.conf.d") '("--global") diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 72714a29ad..7b556f6431 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015 Eric Bavier ;;; Copyright © 2015 Paul van der Walt ;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2018 Alex Vong ;;; ;;; This file is part of GNU Guix. ;;; @@ -78,6 +79,7 @@ and parameters ~s~%" (doc (assoc-ref outputs "doc")) (lib (assoc-ref outputs "lib")) (bin (assoc-ref outputs "bin")) + (name-version (strip-store-file-name out)) (input-dirs (match inputs (((_ . dir) ...) dir) @@ -88,7 +90,7 @@ and parameters ~s~%" `(,(string-append "--bindir=" (or bin out) "/bin")) `(,(string-append "--docdir=" (or doc out) - "/share/doc/" (package-name-version out))) + "/share/doc/" name-version)) '("--libsubdir=$compiler/$pkg-$version") `(,(string-append "--package-db=" %tmp-db-dir)) '("--global") @@ -127,12 +129,6 @@ and parameters ~s~%" "Install a given Haskell package." (run-setuphs "copy" '())) -(define (package-name-version store-dir) - "Given a store directory STORE-DIR return 'name-version' of the package." - (let* ((base (basename store-dir))) - (string-drop base - (+ 1 (string-index base #\-))))) - (define (grep rx port) "Given a regular-expression RX including a group, read from PORT until the first match and return the content of the group." @@ -147,7 +143,7 @@ first match and return the content of the group." (define* (setup-compiler #:key system inputs outputs #:allow-other-keys) "Setup the compiler environment." (let* ((haskell (assoc-ref inputs "haskell")) - (name-version (package-name-version haskell))) + (name-version (strip-store-file-name haskell))) (cond ((string-match "ghc" name-version) (make-ghc-package-database system inputs outputs)) @@ -164,6 +160,7 @@ first match and return the content of the group." (define (make-ghc-package-database system inputs outputs) "Generate the GHC package database." (let* ((haskell (assoc-ref inputs "haskell")) + (name-version (strip-store-file-name haskell)) (input-dirs (match inputs (((_ . dir) ...) dir) @@ -171,7 +168,7 @@ first match and return the content of the group." ;; Silence 'find-files' (see 'evaluate-search-paths') (conf-dirs (with-null-error-port (search-path-as-list - `(,(string-append "lib/" (package-name-version haskell))) + `(,(string-append "lib/" name-version)) input-dirs #:pattern ".*\\.conf.d$"))) (conf-files (append-map (cut find-files <> "\\.conf$") conf-dirs))) (mkdir-p %tmp-db-dir) @@ -231,9 +228,10 @@ given Haskell package." (let* ((out (assoc-ref outputs "out")) (haskell (assoc-ref inputs "haskell")) + (name-verion (strip-store-file-name haskell)) (lib (string-append out "/lib")) - (config-dir (string-append lib "/" - (package-name-version haskell) + (config-dir (string-append lib + "/" name-verion "/" name ".conf.d")) (id-rx (make-regexp "^id: *(.*)$")) (config-file (string-append out "/" name ".conf")) -- cgit v1.2.3 From 418f1b241486ef7f98fdce1e6f8e53f2e7863fd9 Mon Sep 17 00:00:00 2001 From: Alex Vong Date: Thu, 18 Oct 2018 03:08:31 +0800 Subject: java-utils: Use 'strip-store-file-name'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit See the discussion at . * guix/build/java-utils.scm (package-name-version): Remove it. (install-javadoc): Use 'strip-store-file-name' instead of 'package-name-version'. Signed-off-by: Ludovic Courtès --- guix/build/java-utils.scm | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/build/java-utils.scm b/guix/build/java-utils.scm index 128be1edeb..8200638bee 100644 --- a/guix/build/java-utils.scm +++ b/guix/build/java-utils.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Hartmut Goebel ;;; Copyright © 2016 Ricardo Wurmus +;;; Copyright © 2018 Alex Vong ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,12 +24,6 @@ install-jars install-javadoc)) -;; Copied from haskell-build-system.scm -(define (package-name-version store-dir) - "Given a store directory STORE-DIR return 'name-version' of the package." - (let* ((base (basename store-dir))) - (string-drop base (+ 1 (string-index base #\-))))) - (define* (ant-build-javadoc #:key (target "javadoc") (make-flags '()) #:allow-other-keys) (apply invoke `("ant" ,target ,@make-flags))) @@ -48,8 +43,9 @@ is used in case the build.xml does not include an install target." install javadocs when this is not done by the install target." (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) + (name-version (strip-store-file-name out)) (docs (string-append (or (assoc-ref outputs "doc") out) - "/share/doc/" (package-name-version out) "/"))) + "/share/doc/" name-version "/"))) (mkdir-p docs) (copy-recursively apidoc-directory docs) #t))) -- cgit v1.2.3 From 1767581fb50d2b97e12053aca087b6a490156f1e Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Mon, 12 Nov 2018 18:21:04 +0100 Subject: build-system/haskell: Fix register phase. This is a follow-up to commit a7e231a2a3edbd6a70949432c1ff434d87f625ff. Reported by Marius Bakke . * guix/build/haskell-build-system.scm (register): Use "when" instead of "unless". --- guix/build/haskell-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 7b556f6431..23d97e6602 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -239,7 +239,7 @@ given Haskell package." (list (string-append "--gen-pkg-config=" config-file)))) (run-setuphs "register" params) ;; The conf file is created only when there is a library to register. - (unless (file-exists? config-file) + (when (file-exists? config-file) (mkdir-p config-dir) (let* ((config-file-name+id (call-with-ascii-input-file config-file (cut grep id-rx <>)))) -- cgit v1.2.3 From 05a5721f06acc0ac85f970991307bc52fe91f6de Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Tue, 13 Nov 2018 10:46:00 +0100 Subject: build-system/dub: Let all phases return #T unconditionally. * guix/build/dub-build-system.scm (configure, build, check): Return #T unconditionally; use INVOKE. --- guix/build/dub-build-system.scm | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) (limited to 'guix') diff --git a/guix/build/dub-build-system.scm b/guix/build/dub-build-system.scm index 9a72e3d544..3ab50733de 100644 --- a/guix/build/dub-build-system.scm +++ b/guix/build/dub-build-system.scm @@ -67,7 +67,8 @@ (symlink (string-append path "/lib/dub/" d-basename) (string-append vendor-dir "/" d-basename)))))))) inputs) - (zero? (system* "dub" "add-path" vendor-dir)))) + (invoke "dub" "add-path" vendor-dir) + #t)) (define (grep string file-name) "Find the first occurrence of STRING in the file named FILE-NAME. @@ -88,24 +89,22 @@ (define* (build #:key (dub-build-flags '()) #:allow-other-keys) "Build a given DUB package." - (if (or (grep* "sourceLibrary" "package.json") - (grep* "sourceLibrary" "dub.sdl") ; note: format is different! - (grep* "sourceLibrary" "dub.json")) - #t - (let ((status (zero? (apply system* `("dub" "build" ,@dub-build-flags))))) - (substitute* ".dub/dub.json" - (("\"lastUpgrade\": \"[^\"]*\"") - "\"lastUpgrade\": \"1970-01-01T00:00:00.0000000\"")) - status))) + (unless (or (grep* "sourceLibrary" "package.json") + (grep* "sourceLibrary" "dub.sdl") ; note: format is different! + (grep* "sourceLibrary" "dub.json")) + (apply invoke `("dub" "build" ,@dub-build-flags)) + (substitute* ".dub/dub.json" + (("\"lastUpgrade\": \"[^\"]*\"") + "\"lastUpgrade\": \"1970-01-01T00:00:00.0000000\""))) + #t) (define* (check #:key tests? #:allow-other-keys) - (if tests? - (let ((status (zero? (system* "dub" "test")))) - (substitute* ".dub/dub.json" - (("\"lastUpgrade\": \"[^\"]*\"") - "\"lastUpgrade\": \"1970-01-01T00:00:00.0000000\"")) - status) - #t)) + (when tests? + (invoke "dub" "test") + (substitute* ".dub/dub.json" + (("\"lastUpgrade\": \"[^\"]*\"") + "\"lastUpgrade\": \"1970-01-01T00:00:00.0000000\""))) + #t) (define* (install #:key inputs outputs #:allow-other-keys) "Install a given DUB package." -- cgit v1.2.3