From cf87cc894d6913e5c58a381890f920d7e1edf178 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 18 Mar 2015 19:00:12 +0100 Subject: packages: Rewrite 'patch-and-repack' using gexps. * guix/packages.scm (patch-and-repack): Remove 'store' parameter and change default value of #:inputs to (%standard-patch-inputs). [lookup-input, instantiate-patch]: New procedures. [patch-inputs]: Remove. [builder]: Rename to... [build]: ... this. Use gexps instead of sexps. (patch-and-repack*): Remove. (origin->derivation): Use 'patch-and-repack' instead of 'patch-and-repack*'. * tests/packages.scm ("package-source-derivation, snippet")[source](snippet): Remove references to '%build-inputs' and '%outputs'. --- guix/packages.scm | 226 +++++++++++++++++++++++++----------------------------- 1 file changed, 103 insertions(+), 123 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index ec0e79d08b..f12ef99b3e 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -26,6 +26,7 @@ #:use-module (guix base32) #:use-module (guix derivations) #:use-module (guix build-system) + #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) @@ -349,10 +350,9 @@ the build code of derivation." (package->derivation (default-guile) system #:graft? #f)) -;; TODO: Rewrite using %STORE-MONAD and gexps. -(define* (patch-and-repack store source patches +(define* (patch-and-repack source patches #:key - (inputs '()) + (inputs (%standard-patch-inputs)) (snippet #f) (flags '("-p1")) (modules '()) @@ -370,6 +370,11 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." (derivation->output-path source) source)) + (define (lookup-input name) + (match (assoc-ref inputs name) + ((package) package) + (#f #f))) + (define decompression-type (cond ((string-suffix? "gz" source-file-name) "gzip") ((string-suffix? "bz2" source-file-name) "bzip2") @@ -398,115 +403,93 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." ".xz" ".tar.xz")))) - (define patch-inputs - (map (lambda (number patch) - (list (string-append "patch" (number->string number)) - (match patch - ((? string?) - (add-to-store store (basename patch) #t - "sha256" patch)) - ((? origin?) - (package-source-derivation store patch system))))) - (iota (length patches)) - - patches)) - - (define builder - `(begin - (use-modules (ice-9 ftw) - (srfi srfi-1) - (guix build utils)) - - ;; Encoding/decoding errors shouldn't be silent. - (fluid-set! %default-port-conversion-strategy 'error) - - (let ((locales (assoc-ref %build-inputs "locales")) - (out (assoc-ref %outputs "out")) - (xz (assoc-ref %build-inputs "xz")) - (decomp (assoc-ref %build-inputs ,decompression-type)) - (source (assoc-ref %build-inputs "source")) - (tar (string-append (assoc-ref %build-inputs "tar") - "/bin/tar")) - (patch (string-append (assoc-ref %build-inputs "patch") - "/bin/patch"))) - (define (apply-patch input) - (let ((patch* (assoc-ref %build-inputs input))) - (format (current-error-port) "applying '~a'...~%" patch*) - - ;; Use '--force' so that patches that do not apply perfectly are - ;; rejected. - (zero? (system* patch "--force" ,@flags "--input" patch*)))) - - (define (first-file directory) - ;; Return the name of the first file in DIRECTORY. - (car (scandir directory - (lambda (name) - (not (member name '("." ".."))))))) - - (when locales - ;; First of all, install a UTF-8 locale so that UTF-8 file names - ;; are correctly interpreted. During bootstrap, LOCALES is #f. - (setenv "LOCPATH" (string-append locales "/lib/locale")) - (setlocale LC_ALL "en_US.UTF-8")) - - (setenv "PATH" (string-append xz "/bin" ":" - decomp "/bin")) - - ;; SOURCE may be either a directory or a tarball. - (and (if (file-is-directory? source) - (let* ((store (or (getenv "NIX_STORE") "/gnu/store")) - (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) - (zero? (system* tar "xvf" source))) - (let ((directory (first-file "."))) - (format (current-error-port) - "source is under '~a'~%" directory) - (chdir directory) - - (and (every apply-patch ',(map car patch-inputs)) - - ,@(if snippet - `((let ((module (make-fresh-user-module))) - (module-use-interfaces! module - (map resolve-interface - ',modules)) - (module-define! module '%build-inputs - %build-inputs) - (module-define! module '%outputs %outputs) - ((@ (system base compile) compile) - ',snippet - #:to 'value - #:opts %auto-compilation-options - #:env module))) - '()) - - (begin (chdir "..") #t) - (zero? (system* tar "cvfa" out directory)))))))) - - - (let ((name (tarxz-name original-file-name)) - (inputs (filter-map (match-lambda - ((name (? package? p)) - (and (member name (cons decompression-type - '("tar" "xz" "patch"))) - (list name - (package-derivation store p system - #:graft? #f))))) - (or inputs (%standard-patch-inputs)))) - (modules (delete-duplicates (cons '(guix build utils) modules)))) - - (build-expression->derivation store name builder - #:inputs `(("source" ,source) - ,@inputs - ,@patch-inputs) - #:system system - #:modules modules - #:guile-for-build guile-for-build))) + (define instantiate-patch + (match-lambda + ((? string? patch) + (interned-file patch #:recursive? #t)) + ((? origin? patch) + (origin->derivation patch system)))) + + (mlet %store-monad ((tar -> (lookup-input "tar")) + (xz -> (lookup-input "xz")) + (patch -> (lookup-input "patch")) + (locales -> (lookup-input "locales")) + (decomp -> (lookup-input decompression-type)) + (patches (sequence %store-monad + (map instantiate-patch patches)))) + (define build + #~(begin + (use-modules (ice-9 ftw) + (srfi srfi-1) + (guix build utils)) + + (define (apply-patch patch) + (format (current-error-port) "applying '~a'...~%" patch) + + ;; Use '--force' so that patches that do not apply perfectly are + ;; rejected. + (zero? (system* (string-append #$patch "/bin/patch") + "--force" #$@flags "--input" patch))) + + (define (first-file directory) + ;; Return the name of the first file in DIRECTORY. + (car (scandir directory + (lambda (name) + (not (member name '("." ".."))))))) + + ;; Encoding/decoding errors shouldn't be silent. + (fluid-set! %default-port-conversion-strategy 'error) + + (when #$locales + ;; First of all, install a UTF-8 locale so that UTF-8 file names + ;; are correctly interpreted. During bootstrap, LOCALES is #f. + (setenv "LOCPATH" (string-append #$locales "/lib/locale")) + (setlocale LC_ALL "en_US.UTF-8")) + + (setenv "PATH" (string-append #$xz "/bin" ":" + #$decomp "/bin")) + + ;; SOURCE may be either a directory or a tarball. + (and (if (file-is-directory? #$source) + (let* ((store (or (getenv "NIX_STORE") "/gnu/store")) + (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) + (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) + (zero? (system* (string-append #$tar "/bin/tar") + "cvfa" #$output directory))))))) + + (let ((name (tarxz-name original-file-name)) + (modules (delete-duplicates (cons '(guix build utils) modules)))) + (gexp->derivation name build + #:graft? #f + #:system system + #:modules modules + #:guile-for-build guile-for-build)))) (define (transitive-inputs inputs) (let loop ((inputs inputs) @@ -954,9 +937,6 @@ cross-compilation target triplet." (package->cross-derivation package target system) (package->derivation package system))) -(define patch-and-repack* - (store-lift patch-and-repack)) - (define* (origin->derivation source #:optional (system (%current-system))) "When SOURCE is an object, return its derivation for SYSTEM. When @@ -976,14 +956,14 @@ outside of the store) or SOURCE itself (if SOURCE is already a store item.)" (default-guile)) system #:graft? #f))) - (patch-and-repack* source patches - #:inputs inputs - #:snippet snippet - #:flags flags - #:system system - #:modules modules - #:imported-modules modules - #:guile-for-build guile))) + (patch-and-repack source patches + #:inputs inputs + #:snippet snippet + #:flags flags + #:system system + #:modules modules + #:imported-modules modules + #:guile-for-build guile))) ((and (? string?) (? direct-store-path?) file) (with-monad %store-monad (return file))) -- cgit v1.2.3 From ec3b1c575d2d866646920490e849c4a0c708df60 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 21 Mar 2015 21:58:04 +0100 Subject: gnu: Use 'glibc-utf8-locales-final' in the default patching inputs. * gnu/packages/commencement.scm (glibc-utf8-locales-final): Make public. * guix/packages.scm (%standard-patch-inputs): Use GLIBC-UTF8-LOCALES-FINAL instead of GLIBC-UTF8-LOCALES. --- gnu/packages/commencement.scm | 2 +- guix/packages.scm | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm index f312e1729c..d96a8237c3 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -616,7 +616,7 @@ store.") (current-source-location) #:guile %bootstrap-guile))) -(define glibc-utf8-locales-final +(define-public glibc-utf8-locales-final ;; Now that we have GUILE-FINAL, build the UTF-8 locales. They are needed ;; by the build processes afterwards so their 'scm_to_locale_string' works ;; with the full range of Unicode codepoints (remember diff --git a/guix/packages.scm b/guix/packages.scm index f12ef99b3e..69cfd6d26c 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -336,7 +336,8 @@ corresponds to the arguments expected by `set-path-environment-variable'." ("gzip" ,(ref '(gnu packages compression) 'gzip)) ("lzip" ,(ref '(gnu packages compression) 'lzip)) ("patch" ,(ref '(gnu packages base) 'patch)) - ("locales" ,(ref '(gnu packages base) 'glibc-utf8-locales))))) + ("locales" ,(ref '(gnu packages commencement) + 'glibc-utf8-locales-final))))) (define (default-guile) "Return the default Guile package used to run the build code of -- cgit v1.2.3 From a158484db41f1662032609da61cd3ae9f292607b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 21 Mar 2015 22:07:11 +0100 Subject: packages: Make sure the patch inputs are not #f. Fixes build issues whereby #:inputs would be #f. See . * guix/packages.scm (patch-and-repack): #:input defaults to #f. [lookup-input]: When INPUTS is #f, use (%standard-patch-inputs). --- guix/packages.scm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 69cfd6d26c..ca9d3a9fb1 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -353,7 +353,7 @@ the build code of derivation." (define* (patch-and-repack source patches #:key - (inputs (%standard-patch-inputs)) + inputs (snippet #f) (flags '("-p1")) (modules '()) @@ -371,10 +371,14 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." (derivation->output-path source) source)) - (define (lookup-input name) - (match (assoc-ref inputs name) - ((package) package) - (#f #f))) + (define lookup-input + ;; The default value of the 'patch-inputs' field, and thus INPUTS is #f, + ;; so deal with that. + (let ((inputs (or inputs (%standard-patch-inputs)))) + (lambda (name) + (match (assoc-ref inputs name) + ((package) package) + (#f #f))))) (define decompression-type (cond ((string-suffix? "gz" source-file-name) "gzip") -- cgit v1.2.3 From 17287d7d47567aa1649250182e0f7ab11d5d55d1 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Tue, 24 Mar 2015 10:52:05 -0500 Subject: packages: Add zip archive support to 'patch-and-repack'. Fixes . * guix/packages.scm (%standard-patch-inputs): Add "unzip". (patch-and-repack)[decompression-type]: Detect zip archive. [build]: Invoke "unzip" when appropriate. --- guix/packages.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index ca9d3a9fb1..99fbd24cb6 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -335,6 +335,7 @@ corresponds to the arguments expected by `set-path-environment-variable'." ("bzip2" ,(ref '(gnu packages compression) 'bzip2)) ("gzip" ,(ref '(gnu packages compression) 'gzip)) ("lzip" ,(ref '(gnu packages compression) 'lzip)) + ("unzip" ,(ref '(gnu packages zip) 'unzip)) ("patch" ,(ref '(gnu packages base) 'patch)) ("locales" ,(ref '(gnu packages commencement) 'glibc-utf8-locales-final))))) @@ -384,6 +385,7 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." (cond ((string-suffix? "gz" source-file-name) "gzip") ((string-suffix? "bz2" source-file-name) "bzip2") ((string-suffix? "lz" source-file-name) "lzip") + ((string-suffix? "zip" source-file-name) "unzip") (else "xz"))) (define original-file-name @@ -464,8 +466,10 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." (mkdir directory) (copy-recursively #$source directory) #t) - (zero? (system* (string-append #$tar "/bin/tar") - "xvf" #$source))) + #$(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) -- cgit v1.2.3 From f8503e2b2588391c4c0f8d8dd11ef3e9449a2884 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 31 Mar 2015 22:43:01 +0200 Subject: utils: 'modify-phases' no longer introduces quotes. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Suggested by Taylan Ulrich Bayırlı/Kammer . * guix/build/utils.scm (%modify-phases): Remove quotes. * guix/build/cmake-build-system.scm (%standard-phases): Adjust accordingly. * guix/build/glib-or-gtk-build-system.scm (%standard-phases): Likewise. * guix/build/gnu-dist.scm (%dist-phases): Likewise. * guix/build/perl-build-system.scm (%standard-phases): Likewise. * guix/build/python-build-system.scm (%standard-phases): Likewise. * guix/build/ruby-build-system.scm (%standard-phases): Likewise. * guix/build/waf-build-system.scm (%standard-phases): Likewise. * gnu/packages/bash.scm, gnu/packages/code.scm, gnu/packages/gl.scm, gnu/packages/gnome.scm, gnu/packages/graphics.scm, gnu/packages/image.scm, gnu/packages/key-mon.scm, gnu/packages/ocr.scm, gnu/packages/plotutils.scm, gnu/packages/search.scm, gnu/packages/video.scm: Likewise. --- gnu/packages/bash.scm | 4 ++-- gnu/packages/code.scm | 8 ++++---- gnu/packages/gl.scm | 12 ++++++------ gnu/packages/gnome.scm | 4 ++-- gnu/packages/graphics.scm | 4 ++-- gnu/packages/image.scm | 4 ++-- gnu/packages/key-mon.scm | 2 +- gnu/packages/ocr.scm | 2 +- gnu/packages/plotutils.scm | 6 +++--- gnu/packages/search.scm | 6 +++--- gnu/packages/video.scm | 6 +++--- guix/build/cmake-build-system.scm | 4 ++-- guix/build/glib-or-gtk-build-system.scm | 6 +++--- guix/build/gnu-dist.scm | 10 +++++----- guix/build/perl-build-system.scm | 8 ++++---- guix/build/python-build-system.scm | 12 ++++++------ guix/build/ruby-build-system.scm | 10 +++++----- guix/build/utils.scm | 8 ++++---- guix/build/waf-build-system.scm | 8 ++++---- 19 files changed, 62 insertions(+), 62 deletions(-) (limited to 'guix') diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm index d98ef0582b..02cb45c955 100644 --- a/gnu/packages/bash.scm +++ b/gnu/packages/bash.scm @@ -193,8 +193,8 @@ number/base32-hash tuples, directly usable in the 'patch-series' form." #:tests? #f #:phases (modify-phases %standard-phases - (add-after install post-install ,post-install-phase) - (add-after install install-headers + (add-after 'install 'post-install ,post-install-phase) + (add-after 'install 'install-headers ,install-headers-phase)))) (synopsis "The GNU Bourne-Again SHell") (description diff --git a/gnu/packages/code.scm b/gnu/packages/code.scm index ed9ba0e31f..9d2bde829d 100644 --- a/gnu/packages/code.scm +++ b/gnu/packages/code.scm @@ -142,8 +142,8 @@ a large, deeply nested project.") (build-system gnu-build-system) (arguments '(#:phases (modify-phases %standard-phases - (delete configure) - (add-before build make-dotl-files-older + (delete 'configure) + (add-before 'build 'make-dotl-files-older (lambda _ ;; Make the '.l' files as old as the '.c' ;; files to avoid triggering the rule that @@ -155,7 +155,7 @@ a large, deeply nested project.") (set-file-time file ref)) (find-files "." "\\.[chl]$")) #t)) - (add-before install make-target-directories + (add-before 'install 'make-target-directories (lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) (mkdir-p (string-append out "/bin")) @@ -163,7 +163,7 @@ a large, deeply nested project.") "/share/man/man1")) (mkdir-p (string-append out "/share/doc"))))) - (replace check + (replace 'check (lambda _ (setenv "HOME" (getcwd)) (setenv "PATH" diff --git a/gnu/packages/gl.scm b/gnu/packages/gl.scm index dc90a1231d..66f172927f 100644 --- a/gnu/packages/gl.scm +++ b/gnu/packages/gl.scm @@ -149,7 +149,7 @@ Polygon meshes, and Extruded polygon meshes") (arguments '(#:phases (modify-phases %standard-phases - (add-after unpack autogen + (add-after 'unpack 'autogen (lambda _ (zero? (system* "sh" "autogen.sh"))))))) (home-page "https://github.com/divVerent/s2tc") @@ -282,10 +282,10 @@ emulation to complete hardware acceleration for modern GPUs.") (arguments '(#:phases (modify-phases %standard-phases - (delete configure) - (delete build) - (delete check) - (replace install + (delete 'configure) + (delete 'build) + (delete 'check) + (replace 'install (lambda* (#:key outputs #:allow-other-keys) (copy-recursively "include" (string-append (assoc-ref outputs "out") @@ -318,7 +318,7 @@ emulation to complete hardware acceleration for modern GPUs.") '(#:phases (modify-phases %standard-phases (replace - install + 'install (lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) (mkdir-p (string-append out "/bin")) diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 0e674da899..bf19b9ec82 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -1639,11 +1639,11 @@ library.") (arguments '(#:phases (modify-phases %standard-phases - (add-before configure patch-/bin/true + (add-before 'configure 'patch-/bin/true (lambda _ (substitute* "configure" (("/bin/true") (which "true"))))) - (add-after install wrap-pixbuf + (add-after 'install 'wrap-pixbuf ;; Use librsvg's loaders.cache to support SVG files. (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) diff --git a/gnu/packages/graphics.scm b/gnu/packages/graphics.scm index f574628698..14badc949c 100644 --- a/gnu/packages/graphics.scm +++ b/gnu/packages/graphics.scm @@ -181,14 +181,14 @@ output.") (build-system gnu-build-system) (arguments `(#:phases (modify-phases %standard-phases - (replace configure + (replace 'configure (lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) (chdir "trunk") (zero? (system* "qmake" (string-append "prefix=" out)))))) - (add-after install wrap-program + (add-after 'install 'wrap-program (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin")) diff --git a/gnu/packages/image.scm b/gnu/packages/image.scm index 93dd2ac4e6..ece0e8c54a 100644 --- a/gnu/packages/image.scm +++ b/gnu/packages/image.scm @@ -204,11 +204,11 @@ the W3C's XML-based Scaleable Vector Graphic (SVG) format.") (modify-phases %standard-phases ;; Prevent make from trying to regenerate config.h.in. (add-after - unpack set-config-h-in-file-time + 'unpack 'set-config-h-in-file-time (lambda _ (set-file-time "config/config.h.in" (stat "configure")))) (add-after - unpack patch-reg-wrapper + 'unpack 'patch-reg-wrapper (lambda _ (substitute* "prog/reg_wrapper.sh" ((" /bin/sh ") diff --git a/gnu/packages/key-mon.scm b/gnu/packages/key-mon.scm index d29f30258d..c890f85f8d 100644 --- a/gnu/packages/key-mon.scm +++ b/gnu/packages/key-mon.scm @@ -42,7 +42,7 @@ (arguments `(#:python ,python-2 ;uses the Python 2 'print' syntax #:phases (modify-phases %standard-phases - (add-after install wrap + (add-after 'install 'wrap (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin")) diff --git a/gnu/packages/ocr.scm b/gnu/packages/ocr.scm index 32da42b95f..b94a7f51cb 100644 --- a/gnu/packages/ocr.scm +++ b/gnu/packages/ocr.scm @@ -76,7 +76,7 @@ it produces text in 8-bit or UTF-8 formats.") '(#:phases (modify-phases %standard-phases (add-after - unpack autogen + 'unpack 'autogen (lambda _ (zero? (system* "sh" "autogen.sh"))))) #:configure-flags diff --git a/gnu/packages/plotutils.scm b/gnu/packages/plotutils.scm index 245dfe9c67..6166226dce 100644 --- a/gnu/packages/plotutils.scm +++ b/gnu/packages/plotutils.scm @@ -118,13 +118,13 @@ using the Cairo drawing library.") '(#:tests? #f #:phases (modify-phases %standard-phases - (replace configure (lambda _ (chdir "src"))) - (add-before install make-target-directories + (replace 'configure (lambda _ (chdir "src"))) + (add-before 'install 'make-target-directories (lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) (mkdir-p (string-append out "/bin")) #t))) - (add-after install install-prefabs + (add-after 'install 'install-prefabs (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (dir (string-append out diff --git a/gnu/packages/search.scm b/gnu/packages/search.scm index d1133248df..4a4ad20759 100644 --- a/gnu/packages/search.scm +++ b/gnu/packages/search.scm @@ -76,10 +76,10 @@ rich set of boolean query operators.") (arguments `(#:phases (modify-phases %standard-phases (add-before - configure chdir-source + 'configure 'chdir-source (lambda _ (chdir "libtocc/src"))) (replace - check + 'check (lambda _ (with-directory-excursion "../tests" (and (zero? (system* "./configure" @@ -113,7 +113,7 @@ files and directories.") `(#:tests? #f ;No tests #:phases (modify-phases %standard-phases (add-after - unpack chdir-source + 'unpack 'chdir-source (lambda _ (chdir "cli/src")))))) (home-page "http://t-o-c-c.com/") (synopsis "Command-line interface to libtocc") diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index bc589a6edb..8223a3fa70 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -738,12 +738,12 @@ several areas.") '(#:phases (modify-phases %standard-phases (add-before - configure setup-waf + 'configure 'setup-waf (lambda* (#:key inputs #:allow-other-keys) (copy-file (assoc-ref inputs "waf") "waf") (setenv "CC" "gcc"))) (add-before - configure patch-wscript + 'configure 'patch-wscript (lambda* (#:key inputs #:allow-other-keys) (substitute* "wscript" ;; XXX Remove this when our Samba package provides a .pc file. @@ -1219,7 +1219,7 @@ capabilities.") '(#:phases (modify-phases %standard-phases (add-after - unpack autogen + 'unpack 'autogen (lambda _ (zero? (system* "sh" "autogen.sh"))))))) (home-page "http://www.vapoursynth.com/") diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm index d8d437c653..f57622e0f4 100644 --- a/guix/build/cmake-build-system.scm +++ b/guix/build/cmake-build-system.scm @@ -73,8 +73,8 @@ ;; Everything is as with the GNU Build System except for the `configure' ;; and 'check' phases. (modify-phases gnu:%standard-phases - (replace check check) - (replace configure configure))) + (replace 'check check) + (replace 'configure configure))) (define* (cmake-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm index c57bc3e731..9c0104365d 100644 --- a/guix/build/glib-or-gtk-build-system.scm +++ b/guix/build/glib-or-gtk-build-system.scm @@ -240,9 +240,9 @@ needed." (define %standard-phases (modify-phases gnu:%standard-phases - (add-after install glib-or-gtk-compile-schemas compile-glib-schemas) - (add-after install glib-or-gtk-icon-cache generate-icon-cache) - (add-after install glib-or-gtk-wrap wrap-all-programs))) + (add-after 'install 'glib-or-gtk-compile-schemas compile-glib-schemas) + (add-after 'install 'glib-or-gtk-icon-cache generate-icon-cache) + (add-after 'install 'glib-or-gtk-wrap wrap-all-programs))) (define* (glib-or-gtk-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/gnu-dist.scm b/guix/build/gnu-dist.scm index 887b5e94e9..ad69c6cf16 100644 --- a/guix/build/gnu-dist.scm +++ b/guix/build/gnu-dist.scm @@ -83,10 +83,10 @@ (define %dist-phases ;; Phases for building a source tarball. (modify-phases %standard-phases - (delete strip) - (replace install install-dist) - (replace build build) - (add-before configure autoreconf autoreconf) - (replace unpack copy-source))) + (delete 'strip) + (replace 'install install-dist) + (replace 'build build) + (add-before 'configure 'autoreconf autoreconf) + (replace 'unpack copy-source))) ;;; gnu-dist.scm ends here diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm index 9ca5353bb9..8f480eae16 100644 --- a/guix/build/perl-build-system.scm +++ b/guix/build/perl-build-system.scm @@ -72,10 +72,10 @@ ;; Everything is as with the GNU Build System except for the `configure', ;; `build', `check', and `install' phases. (modify-phases gnu:%standard-phases - (replace install install) - (replace check check) - (replace build build) - (replace configure configure))) + (replace 'install install) + (replace 'check check) + (replace 'build build) + (replace 'configure configure))) (define* (perl-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 9f853134bd..26a7254db9 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -123,12 +123,12 @@ installed with setuptools." ;; 'configure' and 'build' phases are not needed. Everything is done during ;; 'install'. (modify-phases gnu:%standard-phases - (delete configure) - (replace install install) - (replace check check) - (replace build build) - (add-after install wrap wrap) - (add-before strip rename-pth-file rename-pth-file))) + (delete 'configure) + (replace 'install install) + (replace 'check check) + (replace 'build build) + (add-after 'install 'wrap wrap) + (add-before 'strip 'rename-pth-file rename-pth-file))) (define* (python-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index a143df467f..531cf382ae 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -72,11 +72,11 @@ directory." (define %standard-phases (modify-phases gnu:%standard-phases - (delete configure) - (add-after unpack gitify gitify) - (replace build build) - (replace install install) - (replace check check))) + (delete 'configure) + (add-after 'unpack 'gitify gitify) + (replace 'build build) + (replace 'install install) + (replace 'check check))) (define* (ruby-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index a5a6167a8c..5d5566d1e3 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -446,13 +446,13 @@ an expression evaluating to a procedure." (define-syntax %modify-phases (syntax-rules (delete replace add-before add-after) ((_ phases (delete old-phase-name)) - (alist-delete 'old-phase-name phases)) + (alist-delete old-phase-name phases)) ((_ phases (replace old-phase-name new-phase)) - (alist-replace 'old-phase-name new-phase phases)) + (alist-replace old-phase-name new-phase phases)) ((_ phases (add-before old-phase-name new-phase-name new-phase)) - (alist-cons-before 'old-phase-name 'new-phase-name new-phase phases)) + (alist-cons-before old-phase-name new-phase-name new-phase phases)) ((_ phases (add-after old-phase-name new-phase-name new-phase)) - (alist-cons-after 'old-phase-name 'new-phase-name new-phase phases)))) + (alist-cons-after old-phase-name new-phase-name new-phase phases)))) ;;; diff --git a/guix/build/waf-build-system.scm b/guix/build/waf-build-system.scm index d172c5a836..85f0abcfd6 100644 --- a/guix/build/waf-build-system.scm +++ b/guix/build/waf-build-system.scm @@ -70,10 +70,10 @@ (define %standard-phases (modify-phases gnu:%standard-phases - (replace configure configure) - (replace build build) - (replace check check) - (replace install install))) + (replace 'configure configure) + (replace 'build build) + (replace 'check check) + (replace 'install install))) (define* (waf-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- cgit v1.2.3 From 1968262a237e398f12a25eb2cbda4c944a2ce1bf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 31 Mar 2015 22:55:41 +0200 Subject: utils: 'find-files' takes an arbitrary predicate as its second argument. * guix/build/utils.scm (file-name-predicate): New procedure. (find-files): Rename second parameter to 'pred'. When 'pred' is not a procedure, call 'file-name-predicate'. Use PRED instead of 'regexp-exec' in the leaf procedure. --- guix/build/utils.scm | 64 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 37 insertions(+), 27 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 5d5566d1e3..74165c717f 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -44,6 +44,7 @@ mkdir-p copy-recursively delete-file-recursively + file-name-predicate find-files search-path-as-list @@ -263,33 +264,42 @@ errors." ;; Don't follow symlinks. lstat))) -(define (find-files dir regexp) - "Return the lexicographically sorted list of files under DIR whose basename -matches REGEXP." - (define file-rx - (if (regexp? regexp) - regexp - (make-regexp regexp))) - - ;; Sort the result to get deterministic results. - (sort (file-system-fold (const #t) - (lambda (file stat result) ; leaf - (if (regexp-exec file-rx (basename file)) - (cons file result) - result)) - (lambda (dir stat result) ; down - result) - (lambda (dir stat result) ; up - result) - (lambda (file stat result) ; skip - result) - (lambda (file stat errno result) - (format (current-error-port) "find-files: ~a: ~a~%" - file (strerror errno)) - result) - '() - dir) - string Date: Wed, 1 Apr 2015 13:46:01 +0200 Subject: gremlin: Add libnsl to libc's library list. * guix/build/gremlin.scm (%libc-libraries): Add "libnsl.so". --- guix/build/gremlin.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm index e8429129e1..253713b587 100644 --- a/guix/build/gremlin.scm +++ b/guix/build/gremlin.scm @@ -197,6 +197,7 @@ value of DT_NEEDED entries is a string.)" "libc.so" "libdl.so" "libm.so" + "libnsl.so" ;NEEDED by nscd "libpthread.so" "libresolv.so" "librt.so" -- cgit v1.2.3 From 7be8c63e0de635f8c669dc19d7ac1d3cdbe28894 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 1 Apr 2015 14:02:49 +0200 Subject: gremlin: Guard against invalid ELF segments. * guix/build/gremlin.scm (&elf-error, &invalid-segment-size): New error condition types. (dynamic-link-segment): Compare SEGMENT's offset + size to ELF's total size. (validate-needed-in-runpath): Wrap body in 'guard' form. --- guix/build/gremlin.scm | 78 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 57 insertions(+), 21 deletions(-) (limited to 'guix') diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm index 253713b587..24a7b558af 100644 --- a/guix/build/gremlin.scm +++ b/guix/build/gremlin.scm @@ -22,10 +22,17 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) - #:export (elf-dynamic-info + #:export (elf-error? + elf-error-elf + invalid-segment-size? + invalid-segment-size-segment + + elf-dynamic-info elf-dynamic-info? elf-dynamic-info-sopath elf-dynamic-info-needed @@ -41,12 +48,31 @@ ;;; ;;; Code: +(define-condition-type &elf-error &error + elf-error? + (elf elf-error-elf)) + +(define-condition-type &invalid-segment-size &elf-error + invalid-segment-size? + (segment invalid-segment-size-segment)) + + (define (dynamic-link-segment elf) "Return the 'PT_DYNAMIC' segment of ELF--i.e., the segment that contains dynamic linking information." - (find (lambda (segment) - (= (elf-segment-type segment) PT_DYNAMIC)) - (elf-segments elf))) + (let ((size (bytevector-length (elf-bytes elf)))) + (find (lambda (segment) + (unless (<= (+ (elf-segment-offset segment) + (elf-segment-filesz segment)) + size) + ;; This happens on separate debug output files created by + ;; 'strip --only-keep-debug' (Binutils 2.25.) + (raise (condition (&invalid-segment-size + (elf elf) + (segment segment))))) + + (= (elf-segment-type segment) PT_DYNAMIC)) + (elf-segments elf)))) (define (word-reader size byte-order) "Return a procedure to read a word of SIZE bytes according to BYTE-ORDER." @@ -215,23 +241,33 @@ value of DT_NEEDED entries is a string.)" present in its RUNPATH, or if FILE lacks dynamic-link information. Return #f otherwise. Libraries whose name matches ALWAYS-FOUND? are considered to be always available." - (let* ((elf (call-with-input-file file - (compose parse-elf get-bytevector-all))) - (dyninfo (elf-dynamic-info elf))) - (when dyninfo - (let* ((runpath (elf-dynamic-info-runpath dyninfo)) - (needed (remove always-found? - (elf-dynamic-info-needed dyninfo))) - (not-found (remove (cut search-path runpath <>) - needed))) - (for-each (lambda (lib) - (format (current-error-port) - "error: '~a' depends on '~a', which cannot \ + (guard (c ((invalid-segment-size? c) + (let ((segment (invalid-segment-size-segment c))) + (format (current-error-port) + "~a: error: offset + size of segment ~a (type ~a) \ +exceeds total size~%" + file + (elf-segment-index segment) + (elf-segment-type segment)) + #f))) + + (let* ((elf (call-with-input-file file + (compose parse-elf get-bytevector-all))) + (dyninfo (elf-dynamic-info elf))) + (when dyninfo + (let* ((runpath (elf-dynamic-info-runpath dyninfo)) + (needed (remove always-found? + (elf-dynamic-info-needed dyninfo))) + (not-found (remove (cut search-path runpath <>) + needed))) + (for-each (lambda (lib) + (format (current-error-port) + "error: '~a' depends on '~a', which cannot \ be found in RUNPATH ~s~%" - file lib runpath)) - not-found) - ;; (when (null? not-found) - ;; (format (current-error-port) "~a is OK~%" file)) - (null? not-found))))) + file lib runpath)) + not-found) + ;; (when (null? not-found) + ;; (format (current-error-port) "~a is OK~%" file)) + (null? not-found)))))) ;;; gremlin.scm ends here -- cgit v1.2.3 From bb42c78a23a96ef79c2b5e3b98c55eef53eac9fe Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 1 Apr 2015 15:34:19 +0200 Subject: build-system: Factorize the list of modules imported on the build side. * guix/build-system/gnu.scm (%default-modules): Rename to... (%gnu-build-system-modules): ... this. (%default-modules): New variable. (dist-package, gnu-build): Use %GNU-BUILD-SYSTEM-MODULES for #:imported-modules. (gnu-cross-build): Likewise, and use %DEFAULT-MODULES for #:modules. * guix/build-system/cmake.scm (%cmake-build-system-modules): New variable. (cmake-build): Use it for #:imported-modules. * guix/build-system/glib-or-gtk.scm (%default-imported-modules): Rename to... (%glib-or-gtk-build-system-modules): ... this. Refer to %GNU-BUILD-SYSTEM-MODULES. Adjust uses. * guix/build-system/perl.scm (%perl-build-system-modules): New variable. (perl-build): Use it for #:imported-modules. * guix/build-system/python.scm (%python-build-system-modules): New variable. (python-build): Use it for #:imported-modules. * guix/build-system/ruby.scm (%ruby-build-system-modules): New variable. (ruby-build): Use it for #:imported-modules. * guix/build-system/waf.scm (%waf-build-system-modules): New variable. (waf-build): Use it for #:imported-modules. --- guix/build-system/cmake.scm | 14 +++++++++----- guix/build-system/glib-or-gtk.scm | 14 +++++++------- guix/build-system/gnu.scm | 20 ++++++++++++-------- guix/build-system/perl.scm | 14 +++++++++----- guix/build-system/python.scm | 12 ++++++++---- guix/build-system/ruby.scm | 14 +++++++++----- guix/build-system/waf.scm | 12 ++++++++---- 7 files changed, 62 insertions(+), 38 deletions(-) (limited to 'guix') diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 0425e9fb39..2e6784251e 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Cyril Roelandt ;;; ;;; This file is part of GNU Guix. @@ -25,7 +25,8 @@ #:use-module (guix build-system gnu) #:use-module (guix packages) #:use-module (ice-9 match) - #:export (cmake-build + #:export (%cmake-build-system-modules + cmake-build cmake-build-system)) ;; Commentary: @@ -35,6 +36,11 @@ ;; ;; Code: +(define %cmake-build-system-modules + ;; Build-side modules imported by default. + `((guix build cmake-build-system) + ,@%gnu-build-system-modules)) + (define (default-cmake) "Return the default CMake package." @@ -86,9 +92,7 @@ (phases '(@ (guix build cmake-build-system) %standard-phases)) (system (%current-system)) - (imported-modules '((guix build cmake-build-system) - (guix build gnu-build-system) - (guix build utils))) + (imported-modules %cmake-build-system-modules) (modules '((guix build cmake-build-system) (guix build utils)))) "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm index 7a90587136..85d01961a5 100644 --- a/guix/build-system/glib-or-gtk.scm +++ b/guix/build-system/glib-or-gtk.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Cyril Roelandt ;;; Copyright © 2014 Federico Beffa ;;; @@ -26,7 +26,8 @@ #:use-module (guix build-system gnu) #:use-module (guix packages) #:use-module (ice-9 match) - #:export (glib-or-gtk-build + #:export (%glib-or-gtk-build-system-modules + glib-or-gtk-build glib-or-gtk-build-system)) ;; Commentary: @@ -67,11 +68,10 @@ '((guix build glib-or-gtk-build-system) (guix build utils))) -(define %default-imported-modules +(define %glib-or-gtk-build-system-modules ;; Build-side modules imported and used by default. - '((guix build gnu-build-system) - (guix build glib-or-gtk-build-system) - (guix build utils))) + `((guix build glib-or-gtk-build-system) + ,@%gnu-build-system-modules)) (define (default-glib) "Return the default glib package from which we use @@ -136,7 +136,7 @@ %standard-phases)) (glib-or-gtk-wrap-excluded-outputs ''()) (system (%current-system)) - (imported-modules %default-imported-modules) + (imported-modules %glib-or-gtk-build-system-modules) (modules %default-modules) allowed-references) "Build SOURCE with INPUTS. See GNU-BUILD for more details." diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index c91ad2ee0c..e4cbd29395 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -24,7 +24,8 @@ #:use-module (guix packages) #:use-module (srfi srfi-1) #:use-module (ice-9 match) - #:export (gnu-build + #:export (%gnu-build-system-modules + gnu-build gnu-build-system standard-packages package-with-explicit-inputs @@ -41,11 +42,16 @@ ;; ;; Code: -(define %default-modules +(define %gnu-build-system-modules ;; Build-side modules imported and used by default. '((guix build gnu-build-system) (guix build utils))) +(define %default-modules + ;; Modules in scope in the build-side environment. + '((guix build gnu-build-system) + (guix build utils))) + (define* (package-with-explicit-inputs p inputs #:optional (loc (current-source-location)) @@ -182,7 +188,7 @@ runs `make distcheck' and whose result is one or more source tarballs." (let* ((args (default-keyword-arguments (package-arguments p) `(#:phases #f #:modules ,%default-modules - #:imported-modules ,%default-modules)))) + #:imported-modules ,%gnu-build-system-modules)))) (substitute-keyword-arguments args ((#:modules modules) `((guix build gnu-dist) @@ -280,7 +286,7 @@ standard packages used as implicit inputs of the GNU build system." (phases '%standard-phases) (locale "en_US.UTF-8") (system (%current-system)) - (imported-modules %default-modules) + (imported-modules %gnu-build-system-modules) (modules %default-modules) (substitutable? #t) allowed-references) @@ -414,10 +420,8 @@ is one of `host' or `target'." (phases '%standard-phases) (locale "en_US.UTF-8") (system (%current-system)) - (imported-modules '((guix build gnu-build-system) - (guix build utils))) - (modules '((guix build gnu-build-system) - (guix build utils))) + (imported-modules %gnu-build-system-modules) + (modules %default-modules) (substitutable? #t) allowed-references) "Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm index e0f86438a8..7833153676 100644 --- a/guix/build-system/perl.scm +++ b/guix/build-system/perl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,7 +24,8 @@ #:use-module (guix build-system gnu) #:use-module (guix packages) #:use-module (ice-9 match) - #:export (perl-build + #:export (%perl-build-system-modules + perl-build perl-build-system)) ;; Commentary: @@ -35,6 +36,11 @@ ;; ;; Code: +(define %perl-build-system-modules + ;; Build-side modules imported by default. + `((guix build perl-build-system) + ,@%gnu-build-system-modules)) + (define (default-perl) "Return the default Perl package." @@ -83,9 +89,7 @@ (outputs '("out")) (system (%current-system)) (guile #f) - (imported-modules '((guix build perl-build-system) - (guix build gnu-build-system) - (guix build utils))) + (imported-modules %perl-build-system-modules) (modules '((guix build perl-build-system) (guix build utils)))) "Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index 37108650d0..d498cf618b 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -27,7 +27,8 @@ #:use-module (guix build-system gnu) #:use-module (ice-9 match) #:use-module (srfi srfi-26) - #:export (package-with-python2 + #:export (%python-build-system-modules + package-with-python2 python-build python-build-system)) @@ -38,6 +39,11 @@ ;; ;; Code: +(define %python-build-system-modules + ;; Build-side modules imported by default. + `((guix build python-build-system) + ,@%gnu-build-system-modules)) + (define (default-python) "Return the default Python package." ;; Lazily resolve the binding to avoid a circular dependency. @@ -132,9 +138,7 @@ prepended to the name." (search-paths '()) (system (%current-system)) (guile #f) - (imported-modules '((guix build python-build-system) - (guix build gnu-build-system) - (guix build utils))) + (imported-modules %python-build-system-modules) (modules '((guix build python-build-system) (guix build utils)))) "Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE diff --git a/guix/build-system/ruby.scm b/guix/build-system/ruby.scm index 08301ec609..83bc93d901 100644 --- a/guix/build-system/ruby.scm +++ b/guix/build-system/ruby.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson -;;; Copyright © 2014 Ludovic Courtès +;;; Copyright © 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,9 +25,15 @@ #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) - #:export (ruby-build + #:export (%ruby-build-system-modules + ruby-build ruby-build-system)) +(define %ruby-build-system-modules + ;; Build-side modules imported by default. + `((guix build ruby-build-system) + ,@%gnu-build-system-modules)) + (define (default-ruby) "Return the default Ruby package." ;; Lazily resolve the binding to avoid a circular dependency. @@ -72,9 +78,7 @@ (search-paths '()) (system (%current-system)) (guile #f) - (imported-modules '((guix build ruby-build-system) - (guix build gnu-build-system) - (guix build utils))) + (imported-modules %ruby-build-system-modules) (modules '((guix build ruby-build-system) (guix build utils)))) "Build SOURCE using RUBY and INPUTS." diff --git a/guix/build-system/waf.scm b/guix/build-system/waf.scm index 494cb957ac..c67f649fa7 100644 --- a/guix/build-system/waf.scm +++ b/guix/build-system/waf.scm @@ -27,7 +27,8 @@ #:select (default-python default-python2)) #:use-module (ice-9 match) #:use-module (srfi srfi-26) - #:export (waf-build + #:export (%waf-build-system-modules + waf-build waf-build-system)) ;; Commentary: @@ -38,6 +39,11 @@ ;; ;; Code: +(define %waf-build-system-modules + ;; Build-side modules imported by default. + `((guix build waf-build-system) + ,@%gnu-build-system-modules)) + (define* (lower name #:key source inputs native-inputs outputs system target (python (default-python)) @@ -75,9 +81,7 @@ (search-paths '()) (system (%current-system)) (guile #f) - (imported-modules '((guix build waf-build-system) - (guix build gnu-build-system) - (guix build utils))) + (imported-modules %waf-build-system-modules) (modules '((guix build waf-build-system) (guix build utils)))) "Build SOURCE with INPUTS. This assumes that SOURCE provides a 'waf' file -- cgit v1.2.3 From 4ba3a84d07168f85f13984e6bd143afc4b70a319 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 1 Apr 2015 15:43:54 +0200 Subject: utils: Make the second 'find-files' argument optional. * guix/build/utils.scm (find-files): Make 'pred' optional. --- guix/build/utils.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 74165c717f..5d229b5f83 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -273,11 +273,12 @@ name matches REGEXP." (lambda (file stat) (regexp-exec file-rx (basename file))))) -(define (find-files dir pred) +(define* (find-files dir #:optional (pred (const #t))) "Return the lexicographically sorted list of files under DIR for which PRED returns true. PRED is passed two arguments: the absolute file name, and its -stat buffer. PRED can also be a regular expression, in which case it is -equivalent to (file-name-predicate PRED)." +stat buffer; the default predicate always returns true. PRED can also be a +regular expression, in which case it is equivalent to (file-name-predicate +PRED)." (let ((pred (if (procedure? pred) pred (file-name-predicate pred)))) -- cgit v1.2.3 From 112da5887550ab929112dbe4ce9df535fc0a7006 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 1 Apr 2015 16:47:49 +0200 Subject: build-system/gnu: Add 'validate-runpath' phase. * guix/build/gnu-build-system.scm (every*, validate-runpath): New procedures. (%standard-phases): Add 'validate-runpath'. * guix/build-system/gnu.scm (%gnu-build-system-modules): Add (guix build gremlin) and (guix elf). (gnu-build): Add #:validate-runpath?. [builder]: Pass it. (gnu-cross-build): Likewise. * gnu/packages/base.scm (glibc)[arguments]: Add #:validate-runpath? #f. --- gnu/packages/base.scm | 6 ++++ guix/build-system/gnu.scm | 8 +++++- guix/build/gnu-build-system.scm | 62 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 75 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index 3ed853a179..3ff3172f0f 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -393,6 +393,12 @@ included.") ;; . #:parallel-build? #f + ;; The libraries have an empty RUNPATH, but some, such as the versioned + ;; libraries (libdl-2.21.so, etc.) have ld.so marked as NEEDED. Since + ;; these libraries are always going to be found anyway, just skip + ;; RUNPATH checks. + #:validate-runpath? #f + #:configure-flags (list "--enable-add-ons" "--sysconfdir=/etc" diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index e4cbd29395..3ccdef1328 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -45,7 +45,9 @@ (define %gnu-build-system-modules ;; Build-side modules imported and used by default. '((guix build gnu-build-system) - (guix build utils))) + (guix build utils) + (guix build gremlin) + (guix elf))) (define %default-modules ;; Modules in scope in the build-side environment. @@ -283,6 +285,7 @@ standard packages used as implicit inputs of the GNU build system." (strip-flags ''("--strip-debug")) (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) + (validate-runpath? #t) (phases '%standard-phases) (locale "en_US.UTF-8") (system (%current-system)) @@ -345,6 +348,7 @@ are allowed to refer to." #:parallel-tests? ,parallel-tests? #:patch-shebangs? ,patch-shebangs? #:strip-binaries? ,strip-binaries? + #:validate-runpath? ,validate-runpath? #:strip-flags ,strip-flags #:strip-directories ,strip-directories))) @@ -417,6 +421,7 @@ is one of `host' or `target'." (strip-flags ''("--strip-debug")) (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) + (validate-runpath? #t) (phases '%standard-phases) (locale "en_US.UTF-8") (system (%current-system)) @@ -490,6 +495,7 @@ platform." #:parallel-tests? ,parallel-tests? #:patch-shebangs? ,patch-shebangs? #:strip-binaries? ,strip-binaries? + #:validate-runpath? ,validate-runpath? #:strip-flags ,strip-flags #:strip-directories ,strip-directories)))) diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 5ae537150f..5220bda71f 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -18,12 +18,15 @@ (define-module (guix build gnu-build-system) #:use-module (guix build utils) + #:use-module (guix build gremlin) + #:use-module (guix elf) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 format) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (rnrs io ports) #:export (%standard-phases gnu-build)) @@ -398,6 +401,64 @@ makefiles." strip-directories))) outputs)))) +(define (every* pred lst) + "This is like 'every', but process all the elements of LST instead of +stopping as soon as PRED returns false. This is useful when PRED has side +effects, such as displaying warnings or error messages." + (let loop ((lst lst) + (result #t)) + (match lst + (() + result) + ((head . tail) + (loop tail (and (pred head) result)))))) + +(define* (validate-runpath #:key + validate-runpath? + (elf-directories '("lib" "lib64" "libexec" + "bin" "sbin")) + outputs #:allow-other-keys) + "When VALIDATE-RUNPATH? is true, validate that all the ELF files in +ELF-DIRECTORIES have their dependencies found in their 'RUNPATH'. + +Since the ELF parser needs to have a copy of files in memory, better run this +phase after stripping." + (define (sub-directory parent) + (lambda (directory) + (let ((directory (string-append parent "/" directory))) + (and (directory-exists? directory) directory)))) + + (define (validate directory) + (define (file=? file1 file2) + (let ((st1 (stat file1)) + (st2 (stat file2))) + (= (stat:ino st1) (stat:ino st2)))) + + ;; There are always symlinks from '.so' to '.so.1' and so on, so delete + ;; duplicates. + (let ((files (delete-duplicates (find-files directory (lambda (file stat) + (elf-file? file))) + file=?))) + (format (current-error-port) + "validating RUNPATH of ~a binaries in ~s...~%" + (length files) directory) + (every* validate-needed-in-runpath files))) + + (if validate-runpath? + (let ((dirs (append-map (match-lambda + (("debug" . _) + ;; The "debug" output is full of ELF files + ;; that are not worth checking. + '()) + ((name . output) + (filter-map (sub-directory output) + elf-directories))) + outputs))) + (every* validate dirs)) + (begin + (format (current-error-port) "skipping RUNPATH validation~%") + #t))) + (define* (validate-documentation-location #:key outputs #:allow-other-keys) "Documentation should go to 'share/info' and 'share/man', not just 'info/' @@ -486,6 +547,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS." patch-source-shebangs configure patch-generated-file-shebangs build check install patch-shebangs strip + validate-runpath validate-documentation-location compress-documentation))) -- cgit v1.2.3 From dacd5d2ca7411251570cf486febcb2cde3ed021f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 5 Apr 2015 15:31:55 +0200 Subject: gremlin: Ignore non-store file names in RUNPATH and warn about them. * guix/build/gremlin.scm (validate-needed-in-runpath)[runpath]: Add (filter absolute-file-name? ...). Emit a warning when RUNPATH file names that do not match 'store-file-name?'. Change format of error message to begin with file name. * guix/build/utils.scm (store-file-name?): New procedure. --- guix/build/gremlin.scm | 14 ++++++++++++-- guix/build/utils.scm | 5 +++++ 2 files changed, 17 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm index 24a7b558af..30b06034dd 100644 --- a/guix/build/gremlin.scm +++ b/guix/build/gremlin.scm @@ -18,6 +18,7 @@ (define-module (guix build gremlin) #:use-module (guix elf) + #:use-module ((guix build utils) #:select (store-file-name?)) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -255,14 +256,23 @@ exceeds total size~%" (compose parse-elf get-bytevector-all))) (dyninfo (elf-dynamic-info elf))) (when dyninfo - (let* ((runpath (elf-dynamic-info-runpath dyninfo)) + (let* ((runpath (filter store-file-name? + (elf-dynamic-info-runpath dyninfo))) + (bogus (remove store-file-name? + (elf-dynamic-info-runpath dyninfo))) (needed (remove always-found? (elf-dynamic-info-needed dyninfo))) (not-found (remove (cut search-path runpath <>) needed))) + ;; XXX: $ORIGIN is not supported. + (unless (null? bogus) + (format (current-error-port) + "~a: warning: RUNPATH contains bogus entries: ~s~%" + file bogus)) + (for-each (lambda (lib) (format (current-error-port) - "error: '~a' depends on '~a', which cannot \ + "~a: error: depends on '~a', which cannot \ be found in RUNPATH ~s~%" file lib runpath)) not-found) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 5d229b5f83..fbd5d54da5 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -32,6 +32,7 @@ #:re-export (alist-cons alist-delete) #:export (%store-directory + store-file-name? parallel-job-count directory-exists? @@ -81,6 +82,10 @@ (or (getenv "NIX_STORE") "/gnu/store")) +(define (store-file-name? file) + "Return true if FILE is in the store." + (string-prefix? (%store-directory) file)) + (define parallel-job-count ;; Number of processes to be passed next to GNU Make's `-j' argument. (make-parameter -- cgit v1.2.3 From 26b261ecfed246e4fa7b7c18654430e4f4b0eb1a Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Sun, 5 Apr 2015 21:59:18 +0200 Subject: build-system/gnu: Add 'delete-info-dir-file' phase. * guix/build/gnu-build-system.scm (delete-info-dir-file): New procedure. (%standard-phases): Use it. --- guix/build/gnu-build-system.scm | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 5220bda71f..512d98ae91 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -538,6 +538,15 @@ DOCUMENTATION-COMPRESSOR-FLAGS." (format #t "not compressing documentation~%") #t))) +(define* (delete-info-dir-file #:key outputs #:allow-other-keys) + (for-each (match-lambda + ((output . directory) + (let ((info-dir-file (string-append directory "/share/info/dir"))) + (when (file-exists? info-dir-file) + (delete-file info-dir-file))))) + outputs) + #t) + (define %standard-phases ;; Standard build phases, as a list of symbol/procedure pairs. (let-syntax ((phases (syntax-rules () @@ -549,6 +558,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS." patch-shebangs strip validate-runpath validate-documentation-location + delete-info-dir-file compress-documentation))) -- cgit v1.2.3 From b198545df6f7aa92947b1fb97fd56304dfcda78b Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Mon, 6 Apr 2015 10:47:31 +0200 Subject: build-system/gnu: Add docstring to 'delete-info-dir-file'. * guix/build/gnu-build-system.scm (delete-info-dir-file): Add docstring. --- guix/build/gnu-build-system.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 512d98ae91..c60f8ba162 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -539,6 +539,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS." #t))) (define* (delete-info-dir-file #:key outputs #:allow-other-keys) + "Delete any 'share/info/dir' file from OUTPUTS." (for-each (match-lambda ((output . directory) (let ((info-dir-file (string-append directory "/share/info/dir"))) -- cgit v1.2.3 From 347f54ed33a0b9a4e234d18dadf950f055e16554 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 6 Apr 2015 23:09:54 +0200 Subject: utils: 'find-files' does not follow symlinks by default. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Reported by Tomáš Čech . * guix/build/utils.scm (find-files): Add #:stat parameter. Pass it as last argument to 'file-system-fold'. --- guix/build/utils.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index fbd5d54da5..676a0120e3 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -278,12 +278,14 @@ name matches REGEXP." (lambda (file stat) (regexp-exec file-rx (basename file))))) -(define* (find-files dir #:optional (pred (const #t))) +(define* (find-files dir #:optional (pred (const #t)) + #:key (stat lstat)) "Return the lexicographically sorted list of files under DIR for which PRED returns true. PRED is passed two arguments: the absolute file name, and its stat buffer; the default predicate always returns true. PRED can also be a regular expression, in which case it is equivalent to (file-name-predicate -PRED)." +PRED). STAT is used to obtain file information; using 'lstat' means that +symlinks are not followed." (let ((pred (if (procedure? pred) pred (file-name-predicate pred)))) @@ -304,7 +306,8 @@ PRED)." file (strerror errno)) result) '() - dir) + dir + stat) string Date: Tue, 7 Apr 2015 22:07:25 +0200 Subject: ui: Add 'report-load-error'. * guix/scripts/system.scm (read-operating-system): Replace error handling code by a call to 'report-load-error'. * guix/ui.scm (report-load-error): New procedure. --- guix/scripts/system.scm | 16 +--------------- guix/ui.scm | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 15 deletions(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 1b64e6fb92..1838e89452 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -69,21 +69,7 @@ (set-current-module %user-module) (primitive-load file)))) (lambda args - (match args - (('system-error . _) - (let ((err (system-error-errno args))) - (leave (_ "failed to open operating system file '~a': ~a~%") - file (strerror err)))) - (('syntax-error proc message properties form . rest) - (let ((loc (source-properties->location properties))) - (format (current-error-port) (_ "~a: error: ~a~%") - (location->string loc) message) - (exit 1))) - ((error args ...) - (report-error (_ "failed to load operating system file '~a':~%") - file) - (apply display-error #f (current-error-port) args) - (exit 1)))))) + (report-load-error file args)))) ;;; diff --git a/guix/ui.scm b/guix/ui.scm index 4929f93590..80a4a6338a 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -47,6 +47,7 @@ P_ report-error leave + report-load-error show-version-and-exit show-bug-report-information string->number* @@ -130,6 +131,23 @@ messages." (report-error args ...) (exit 1))) +(define (report-load-error file args) + "Report the failure to load FILE, a user-provided Scheme file, and exit. +ARGS is the list of arguments received by the 'throw' handler." + (match args + (('system-error . _) + (let ((err (system-error-errno args))) + (leave (_ "failed to load '~a': ~a~%") file (strerror err)))) + (('syntax-error proc message properties form . rest) + (let ((loc (source-properties->location properties))) + (format (current-error-port) (_ "~a: error: ~a~%") + (location->string loc) message) + (exit 1))) + ((error args ...) + (report-error (_ "failed to load '~a':~%") file) + (apply display-error #f (current-error-port) args) + (exit 1)))) + (define (install-locale) "Install the current locale settings." (catch 'system-error -- cgit v1.2.3 From 4ae7559fd62c03a800b010c228639f18b9f58006 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 7 Apr 2015 22:27:45 +0200 Subject: gnu: Emit a warning when a package module cannot be loaded. * guix/ui.scm (warn-about-load-error): New procedure. * gnu/packages.scm (package-modules): Wrap 'resolve-interface' call in 'catch #t', and call 'warn-about-load-error' in handler. --- gnu/packages.scm | 12 +++++++++--- guix/ui.scm | 16 ++++++++++++++++ 2 files changed, 25 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/gnu/packages.scm b/gnu/packages.scm index 57a3e21bd6..2216c0df8c 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -160,9 +160,15 @@ Optionally, narrow the search to SUB-DIRECTORY." (string-length directory)) (filter-map (lambda (file) - (let ((file (substring file prefix-len))) - (false-if-exception - (resolve-interface (file-name->module-name file))))) + (let* ((file (substring file prefix-len)) + (module (file-name->module-name file))) + (catch #t + (lambda () + (resolve-interface module)) + (lambda args + ;; Report the error, but keep going. + (warn-about-load-error module args) + #f)))) (scheme-files (if sub-directory (string-append directory "/" sub-directory) directory)))) diff --git a/guix/ui.scm b/guix/ui.scm index 80a4a6338a..9e75a35d16 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -48,6 +48,7 @@ report-error leave report-load-error + warn-about-load-error show-version-and-exit show-bug-report-information string->number* @@ -148,6 +149,21 @@ ARGS is the list of arguments received by the 'throw' handler." (apply display-error #f (current-error-port) args) (exit 1)))) +(define (warn-about-load-error file args) ;FIXME: factorize with ↑ + "Report the failure to load FILE, a user-provided Scheme file, without +exiting. ARGS is the list of arguments received by the 'throw' handler." + (match args + (('system-error . _) + (let ((err (system-error-errno args))) + (warning (_ "failed to load '~a': ~a~%") file (strerror err)))) + (('syntax-error proc message properties form . rest) + (let ((loc (source-properties->location properties))) + (format (current-error-port) (_ "~a: warning: ~a~%") + (location->string loc) message))) + ((error args ...) + (warning (_ "failed to load '~a':~%") file) + (apply display-error #f (current-error-port) args)))) + (define (install-locale) "Install the current locale settings." (catch 'system-error -- cgit v1.2.3 From 56b1b74c903c17b03ef5b0052a1144bb1e55685f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 10 Apr 2015 10:08:49 +0200 Subject: lint: Rename 'check-patches' to 'check-patch-file-names'. * guix/scripts/lint.scm (check-patches): Rename to... (check-patch-file-names): ... this. Rename 'filename' to 'file'. (%checkers): Adjust accordingly. * tests/lint.scm ("patches: file names"): Likewise. --- guix/scripts/lint.scm | 16 ++++++++-------- tests/lint.scm | 2 +- 2 files changed, 9 insertions(+), 9 deletions(-) (limited to 'guix') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index c40d76b558..543b3dd1c5 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -45,7 +45,7 @@ #:export (guix-lint check-description-style check-inputs-should-be-native - check-patches + check-patch-file-names check-synopsis-style check-home-page check-source)) @@ -348,7 +348,7 @@ warning for PACKAGE mentionning the FIELD." (package-home-page package)) 'home-page))))) -(define (check-patches package) +(define (check-patch-file-names package) ;; Emit a warning if the patches requires by PACKAGE are badly named. (let ((patches (and=> (package-source package) origin-patches)) (name (package-name package)) @@ -356,9 +356,9 @@ warning for PACKAGE mentionning the FIELD." (when (and patches (any (match-lambda ((? string? patch) - (let ((filename (basename patch))) - (not (or (eq? (string-contains filename name) 0) - (eq? (string-contains filename full-name) + (let ((file (basename patch))) + (not (or (eq? (string-contains file name) 0) + (eq? (string-contains file full-name) 0))))) (_ ;; This must be an or something like that. @@ -367,7 +367,7 @@ warning for PACKAGE mentionning the FIELD." (emit-warning package (_ "file names of patches should start with \ the package name") - 'patches)))) + 'patch-file-names)))) (define (escape-quotes str) "Replace any quote character in STR by an escaped quote character." @@ -455,9 +455,9 @@ descriptions maintained upstream." (description "Identify inputs that should be native inputs") (check check-inputs-should-be-native)) (lint-checker - (name 'patch-filenames) + (name 'patch-file-names) (description "Validate file names of patches") - (check check-patches)) + (check check-patch-file-names)) (lint-checker (name 'home-page) (description "Validate home-page URLs") diff --git a/tests/lint.scm b/tests/lint.scm index 2312b80934..047f2786e0 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -301,7 +301,7 @@ requests." (uri "someurl") (sha256 "somesha") (patches (list "/path/to/y.patch"))))))) - (check-patches pkg))) + (check-patch-file-names pkg))) "file names of patches should start with the package name"))) (test-assert "home-page: wrong home-page" -- cgit v1.2.3 From b210b35d61e41ab5c3ad923eacc8ecbd58d3edca Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 10 Apr 2015 10:27:26 +0200 Subject: lint: Report patches that cannot be found. * guix/scripts/lint.scm (check-patch-file-names): Wrap body in 'guard'. * tests/lint.scm ("patches: not found"): New test. --- guix/scripts/lint.scm | 44 +++++++++++++++++++++++++------------------- tests/lint.scm | 15 +++++++++++++++ 2 files changed, 40 insertions(+), 19 deletions(-) (limited to 'guix') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 543b3dd1c5..699311a6a9 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -41,6 +41,8 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:export (guix-lint check-description-style @@ -349,25 +351,29 @@ warning for PACKAGE mentionning the FIELD." 'home-page))))) (define (check-patch-file-names package) - ;; Emit a warning if the patches requires by PACKAGE are badly named. - (let ((patches (and=> (package-source package) origin-patches)) - (name (package-name package)) - (full-name (package-full-name package))) - (when (and patches - (any (match-lambda - ((? string? patch) - (let ((file (basename patch))) - (not (or (eq? (string-contains file name) 0) - (eq? (string-contains file full-name) - 0))))) - (_ - ;; This must be an or something like that. - #f)) - patches)) - (emit-warning package - (_ "file names of patches should start with \ + "Emit a warning if the patches requires by PACKAGE are badly named or if the +patch could not be found." + (guard (c ((message-condition? c) ;raised by 'search-patch' + (emit-warning package (condition-message c) + 'patch-file-names))) + (let ((patches (and=> (package-source package) origin-patches)) + (name (package-name package)) + (full-name (package-full-name package))) + (when (and patches + (any (match-lambda + ((? string? patch) + (let ((file (basename patch))) + (not (or (eq? (string-contains file name) 0) + (eq? (string-contains file full-name) + 0))))) + (_ + ;; This must be an or something like that. + #f)) + patches)) + (emit-warning package + (_ "file names of patches should start with \ the package name") - 'patch-file-names)))) + 'patch-file-names))))) (define (escape-quotes str) "Replace any quote character in STR by an escaped quote character." @@ -456,7 +462,7 @@ descriptions maintained upstream." (check check-inputs-should-be-native)) (lint-checker (name 'patch-file-names) - (description "Validate file names of patches") + (description "Validate file names and availability of patches") (check check-patch-file-names)) (lint-checker (name 'home-page) diff --git a/tests/lint.scm b/tests/lint.scm index 047f2786e0..ab89a58ae6 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -304,6 +304,21 @@ requests." (check-patch-file-names pkg))) "file names of patches should start with the package name"))) +(test-assert "patches: not found" + (->bool + (string-contains + (with-warnings + (let ((pkg (dummy-package "x" + (source + (origin + (method url-fetch) + (uri "someurl") + (sha256 "somesha") + (patches + (list (search-patch "this-patch-does-not-exist!")))))))) + (check-patch-file-names pkg))) + "patch not found"))) + (test-assert "home-page: wrong home-page" (->bool (string-contains -- cgit v1.2.3 From cceab87536d0385e406f30dea001d48e9b8f5621 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 11 Apr 2015 12:29:10 +0200 Subject: packages: Add 'bag-direct-inputs'. * guix/packages.scm (bag-direct-inputs): New procedure. (bag-transitive-inputs): Use it. --- guix/packages.scm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 99fbd24cb6..f278db50f1 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -107,6 +107,7 @@ package->bag bag->derivation + bag-direct-inputs bag-transitive-inputs bag-transitive-host-inputs bag-transitive-build-inputs @@ -580,11 +581,15 @@ supported by its dependencies." (package-supported-systems package) (package-direct-inputs package))) +(define (bag-direct-inputs bag) + "Same as 'package-direct-inputs', but applied to a bag." + (append (bag-build-inputs bag) + (bag-host-inputs bag) + (bag-target-inputs bag))) + (define (bag-transitive-inputs bag) "Same as 'package-transitive-inputs', but applied to a bag." - (transitive-inputs (append (bag-build-inputs bag) - (bag-host-inputs bag) - (bag-target-inputs bag)))) + (transitive-inputs (bag-direct-inputs bag))) (define (bag-transitive-build-inputs bag) "Same as 'package-transitive-native-inputs', but applied to a bag." -- cgit v1.2.3 From 9bf3ced06c42700d6c83ce3a0eda244798104618 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 11 Apr 2015 12:41:49 +0200 Subject: packages: 'package-transitive-supported-systems' accounts for implicit inputs. Reported by Federico Beffa. * guix/packages.scm (package-transitive-supported-systems): Use bag-direct-inputs + package->bag rather than package-direct-inputs. * tests/packages.scm ("package-transitive-supported-systems"): Add explicit 'build-system' field to each 'dummy-package' form. ("package-transitive-supported-systems, implicit inputs"): New test. --- guix/packages.scm | 2 +- tests/packages.scm | 41 ++++++++++++++++++++++++++++++++--------- 2 files changed, 33 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index f278db50f1..7d4696fb5e 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -579,7 +579,7 @@ supported by its dependencies." (_ systems))) (package-supported-systems package) - (package-direct-inputs package))) + (bag-direct-inputs (package->bag package)))) (define (bag-direct-inputs bag) "Same as 'package-direct-inputs', but applied to a bag." diff --git a/tests/packages.scm b/tests/packages.scm index b50551e963..a93ee66831 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -128,21 +128,44 @@ ("y") ;c ("y") ;d ("y")) ;e - (let* ((a (dummy-package "a" (supported-systems '("x" "y" "z")))) - (b (dummy-package "b" (supported-systems '("x" "y")) - (inputs `(("a" ,a))))) - (c (dummy-package "c" (supported-systems '("y" "z")) - (inputs `(("b" ,b))))) - (d (dummy-package "d" (supported-systems '("x" "y" "z")) - (inputs `(("b" ,b) ("c" ,c))))) - (e (dummy-package "e" (supported-systems '("x" "y" "z")) - (inputs `(("d" ,d)))))) + ;; Use TRIVIAL-BUILD-SYSTEM because it doesn't add implicit inputs and thus + ;; doesn't restrict the set of supported systems. + (let* ((a (dummy-package "a" + (build-system trivial-build-system) + (supported-systems '("x" "y" "z")))) + (b (dummy-package "b" + (build-system trivial-build-system) + (supported-systems '("x" "y")) + (inputs `(("a" ,a))))) + (c (dummy-package "c" + (build-system trivial-build-system) + (supported-systems '("y" "z")) + (inputs `(("b" ,b))))) + (d (dummy-package "d" + (build-system trivial-build-system) + (supported-systems '("x" "y" "z")) + (inputs `(("b" ,b) ("c" ,c))))) + (e (dummy-package "e" + (build-system trivial-build-system) + (supported-systems '("x" "y" "z")) + (inputs `(("d" ,d)))))) (list (package-transitive-supported-systems a) (package-transitive-supported-systems b) (package-transitive-supported-systems c) (package-transitive-supported-systems d) (package-transitive-supported-systems e)))) +(test-equal "package-transitive-supported-systems, implicit inputs" + %supported-systems + + ;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on + ;; %SUPPORTED-SYSTEMS. Thus the others must be ignored. + (let ((p (dummy-package "foo" + (build-system gnu-build-system) + (supported-systems + `("does-not-exist" "foobar" ,@%supported-systems))))) + (package-transitive-supported-systems p))) + (test-skip (if (not %store) 8 0)) (test-assert "package-source-derivation, file" -- cgit v1.2.3 From 002c57c6f7d51077e4796106177456ebb564e25a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 12 Apr 2015 23:14:19 +0200 Subject: lint: Add a 'derivation' checker. * guix/scripts/lint.scm (check-derivation): New procedure. (%checkers): Add 'derivation' checker. * tests/lint.scm ("derivation: invalid arguments"): New test. --- guix/scripts/lint.scm | 27 +++++++++++++++++++++++++++ tests/lint.scm | 10 ++++++++++ 2 files changed, 37 insertions(+) (limited to 'guix') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 699311a6a9..cced1bda66 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -19,6 +19,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix scripts lint) + #:use-module (guix store) #:use-module (guix base32) #:use-module (guix download) #:use-module (guix ftp-client) @@ -32,6 +33,8 @@ #:use-module (ice-9 regex) #:use-module (ice-9 format) #:use-module (web uri) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module ((guix build download) #:select (maybe-expand-mirrors open-connection-for-uri)) @@ -49,6 +52,7 @@ check-inputs-should-be-native check-patch-file-names check-synopsis-style + check-derivation check-home-page check-source)) @@ -440,6 +444,25 @@ descriptions maintained upstream." (append-map (cut maybe-expand-mirrors <> %mirrors) uris)))))) +(define (check-derivation package) + "Emit a warning if we fail to compile PACKAGE to a derivation." + (catch #t + (lambda () + (guard (c ((nix-protocol-error? c) + (emit-warning package + (format #f (_ "failed to create derivation: ~a") + (nix-protocol-error-message c)))) + ((message-condition? c) + (emit-warning package + (format #f (_ "failed to create derivation: ~a") + (condition-message c))))) + (with-store store + (package-derivation store package)))) + (lambda args + (emit-warning package + (format #f (_ "failed to create derivation: ~s~%") + args))))) + ;;; @@ -472,6 +495,10 @@ descriptions maintained upstream." (name 'source) (description "Validate source URLs") (check check-source)) + (lint-checker + (name 'derivation) + (description "Report failure to compile a package to a derivation") + (check check-derivation)) (lint-checker (name 'synopsis) (description "Validate package synopses") diff --git a/tests/lint.scm b/tests/lint.scm index ab89a58ae6..2807eba1cc 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -319,6 +319,16 @@ requests." (check-patch-file-names pkg))) "patch not found"))) +(test-assert "derivation: invalid arguments" + (->bool + (string-contains + (with-warnings + (let ((pkg (dummy-package "x" + (arguments + '(#:imported-modules (invalid-module)))))) + (check-derivation pkg))) + "failed to create derivation"))) + (test-assert "home-page: wrong home-page" (->bool (string-contains -- cgit v1.2.3 From 1590e8a1dda793a16d9c70a666b0a8b5d41a94f5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Mar 2015 17:56:27 +0100 Subject: packages: Refer to the native tools when handling sources and downloads. * guix/packages.scm (patch-and-repack)[build]: Change most #$ to #+. * guix/cvs-download.scm (cvs-fetch)[build]: Likewise. * guix/download.scm (url-fetch)[builder]: Likewise. * guix/git-download.scm (git-fetch)[build]: Likewise. * guix/svn-download.scm (svn-fetch)[build]: Likewise. --- guix/cvs-download.scm | 2 +- guix/download.scm | 4 ++-- guix/git-download.scm | 4 ++-- guix/packages.scm | 36 ++++++++++++++++++------------------ guix/svn-download.scm | 2 +- 5 files changed, 24 insertions(+), 24 deletions(-) (limited to 'guix') diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm index 8a0d479fa4..72478dd2c2 100644 --- a/guix/cvs-download.scm +++ b/guix/cvs-download.scm @@ -66,7 +66,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." '#$(cvs-reference-module ref) '#$(cvs-reference-revision ref) #$output - #:cvs-command (string-append #$cvs "/bin/cvs")))) + #:cvs-command (string-append #+cvs "/bin/cvs")))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "cvs-checkout") build diff --git a/guix/download.scm b/guix/download.scm index d87d02e2af..3e4024fe1f 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -241,12 +241,12 @@ in the store." (define builder #~(begin - #$(if need-gnutls? + #+(if need-gnutls? ;; Add GnuTLS to the inputs and to the load path. #~(eval-when (load expand eval) (set! %load-path - (cons (string-append #$(gnutls-package) + (cons (string-append #+(gnutls-package) "/share/guile/site/" (effective-version)) %load-path))) diff --git a/guix/git-download.scm b/guix/git-download.scm index 94a1245480..f4b48d7a6b 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -76,7 +76,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." ;; The 'git submodule' commands expects Coreutils, sed, ;; grep, etc. to be in $PATH. (set-path-environment-variable "PATH" '("bin") - (match '#$inputs + (match '#+inputs (((names dirs) ...) dirs))) @@ -84,7 +84,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." '#$(git-reference-commit ref) #$output #:recursive? '#$(git-reference-recursive? ref) - #:git-command (string-append #$git "/bin/git")))) + #:git-command (string-append #+git "/bin/git")))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "git-checkout") build diff --git a/guix/packages.scm b/guix/packages.scm index 7d4696fb5e..8ebe8d06b5 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -436,8 +436,8 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." ;; Use '--force' so that patches that do not apply perfectly are ;; rejected. - (zero? (system* (string-append #$patch "/bin/patch") - "--force" #$@flags "--input" patch))) + (zero? (system* (string-append #+patch "/bin/patch") + "--force" #+@flags "--input" patch))) (define (first-file directory) ;; Return the name of the first file in DIRECTORY. @@ -448,49 +448,49 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." ;; Encoding/decoding errors shouldn't be silent. (fluid-set! %default-port-conversion-strategy 'error) - (when #$locales + (when #+locales ;; First of all, install a UTF-8 locale so that UTF-8 file names ;; are correctly interpreted. During bootstrap, LOCALES is #f. - (setenv "LOCPATH" (string-append #$locales "/lib/locale")) + (setenv "LOCPATH" (string-append #+locales "/lib/locale")) (setlocale LC_ALL "en_US.UTF-8")) - (setenv "PATH" (string-append #$xz "/bin" ":" - #$decomp "/bin")) + (setenv "PATH" (string-append #+xz "/bin" ":" + #+decomp "/bin")) ;; SOURCE may be either a directory or a tarball. - (and (if (file-is-directory? #$source) + (and (if (file-is-directory? #+source) (let* ((store (or (getenv "NIX_STORE") "/gnu/store")) (len (+ 1 (string-length store))) - (base (string-drop #$source len)) + (base (string-drop #+source len)) (dash (string-index base #\-)) (directory (string-drop base (+ 1 dash)))) (mkdir directory) - (copy-recursively #$source directory) + (copy-recursively #+source directory) #t) - #$(if (string=? decompression-type "unzip") - #~(zero? (system* "unzip" #$source)) - #~(zero? (system* (string-append #$tar "/bin/tar") - "xvf" #$source)))) + #+(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 + (and (every apply-patch '#+patches) + #+@(if snippet #~((let ((module (make-fresh-user-module))) (module-use-interfaces! module (map resolve-interface - '#$modules)) + '#+modules)) ((@ (system base compile) compile) - '#$snippet + '#+snippet #:to 'value #:opts %auto-compilation-options #:env module))) #~()) (begin (chdir "..") #t) - (zero? (system* (string-append #$tar "/bin/tar") + (zero? (system* (string-append #+tar "/bin/tar") "cvfa" #$output directory))))))) (let ((name (tarxz-name original-file-name)) diff --git a/guix/svn-download.scm b/guix/svn-download.scm index 92b03d13f3..d6853ca861 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -62,7 +62,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." (svn-fetch '#$(svn-reference-url ref) '#$(svn-reference-revision ref) #$output - #:svn-command (string-append #$svn "/bin/svn")))) + #:svn-command (string-append #+svn "/bin/svn")))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build -- cgit v1.2.3 From cd6c6d60a83fcd081097705ec5f51243d3d701d9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 15 Apr 2015 10:27:19 +0200 Subject: build-system/haskell: Refer to %GNU-BUILD-SYSTEM-MODULES. Fixes a regression whereby haskell-build-system was using an incomplete module list. * guix/build-system/haskell.scm (%haskell-build-system-modules): New variable. (haskell-build): Use it as the default value of #:imported-modules. --- guix/build-system/haskell.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm index 79faa5a09e..0fbf0b8e75 100644 --- a/guix/build-system/haskell.scm +++ b/guix/build-system/haskell.scm @@ -25,7 +25,8 @@ #:use-module (guix build-system gnu) #:use-module (ice-9 match) #:use-module (srfi srfi-26) - #:export (haskell-build + #:export (%haskell-build-system-modules + haskell-build haskell-build-system)) ;; Commentary: @@ -35,6 +36,11 @@ ;; ;; Code: +(define %haskell-build-system-modules + ;; Build-side modules imported by default. + `((guix build haskell-build-system) + ,@%gnu-build-system-modules)) + (define (default-haskell) "Return the default Haskell package." ;; Lazily resolve the binding to avoid a circular dependency. @@ -80,9 +86,7 @@ (search-paths '()) (system (%current-system)) (guile #f) - (imported-modules '((guix build haskell-build-system) - (guix build gnu-build-system) - (guix build utils))) + (imported-modules %haskell-build-system-modules) (modules '((guix build haskell-build-system) (guix build utils)))) "Build SOURCE using HASKELL, and with INPUTS. This assumes that SOURCE -- cgit v1.2.3 From b7615c56a751635fa4db8d0ecfd2bd18f0c3c3df Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Apr 2015 09:51:38 +0200 Subject: build-system/haskell: Adjust to new 'modify-phases' syntax. * guix/build/haskell-build-system.scm (%standard-phases): Add missing quotes, as needed since commit f8503e2. --- guix/build/haskell-build-system.scm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index e17967fb72..d382ee403d 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -196,13 +196,13 @@ generate the cache as it would clash in user profiles." (define %standard-phases (modify-phases gnu:%standard-phases - (add-before configure setup-compiler setup-compiler) - (add-before install haddock haddock) - (add-after install register register) - (replace install install) - (replace check check) - (replace build build) - (replace configure configure))) + (add-before 'configure 'setup-compiler setup-compiler) + (add-before 'install 'haddock haddock) + (add-after 'install 'register register) + (replace 'install install) + (replace 'check check) + (replace 'build build) + (replace 'configure configure))) (define* (haskell-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- cgit v1.2.3 From 4b9b3cbbc45afa3e374889847d4ab8673b8b2db2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Apr 2015 23:13:28 +0200 Subject: refresh: Allow users to refer to specific package versions. * guix/scripts/refresh.scm (guix-refresh): Use 'specification->package' instead of 'find-packages-by-name'. This allows users to specify things like "qt-4.8.6". * doc/guix.texi (Invoking guix refresh): Add an example. --- doc/guix.texi | 2 +- guix/scripts/refresh.scm | 17 +++++++---------- 2 files changed, 8 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 97fa3b6548..6b6604a426 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3285,7 +3285,7 @@ In addition, @command{guix refresh} can be passed one or more package names, as in this example: @example -guix refresh -u emacs idutils +guix refresh -u emacs idutils gcc-4.8.4 @end example @noindent diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 04886499a2..28519d78e2 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Eric Bavier ;;; @@ -207,16 +207,13 @@ update would trigger a complete rebuild." (list-dependent? (assoc-ref opts 'list-dependent?)) (key-download (assoc-ref opts 'key-download)) (packages - (match (concatenate - (filter-map (match-lambda - (('argument . value) - (let ((p (find-packages-by-name value))) - (when (null? p) - (leave (_ "~a: no package by that name~%") - value)) - p)) + (match (filter-map (match-lambda + (('argument . spec) + ;; Take either the specified version or the + ;; latest one. + (specification->package spec)) (_ #f)) - opts)) + opts) (() ; default to all packages (let ((select? (match (assoc-ref opts 'select) ('core core-package?) -- cgit v1.2.3