diff options
69 files changed, 868 insertions, 477 deletions
diff --git a/gnu-system.am b/gnu-system.am index 2b4f69dc73..199a944b5d 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -163,7 +163,6 @@ GNU_SYSTEM_MODULES = \ gnu/packages/kde.scm \ gnu/packages/key-mon.scm \ gnu/packages/language.scm \ - gnu/packages/ld-wrapper.scm \ gnu/packages/less.scm \ gnu/packages/lesstif.scm \ gnu/packages/libcanberra.scm \ @@ -413,6 +412,7 @@ dist_patch_DATA = \ gnu/packages/patches/flex-bison-tests.patch \ gnu/packages/patches/gawk-shell.patch \ gnu/packages/patches/gcc-cross-environment-variables.patch \ + gnu/packages/patches/ghostscript-runpath.patch \ gnu/packages/patches/glib-tests-desktop.patch \ gnu/packages/patches/glib-tests-homedir.patch \ gnu/packages/patches/glib-tests-prlimit.patch \ @@ -484,6 +484,7 @@ dist_patch_DATA = \ gnu/packages/patches/nvi-dbpagesize-binpower.patch \ gnu/packages/patches/nvi-db4.patch \ gnu/packages/patches/openexr-missing-samples.patch \ + gnu/packages/patches/openssl-runpath.patch \ gnu/packages/patches/orpheus-cast-errors-and-includes.patch \ gnu/packages/patches/ots-no-include-missing-file.patch \ gnu/packages/patches/patchelf-page-size.patch \ @@ -561,6 +562,9 @@ dist_patch_DATA = \ gnu/packages/patches/xmodmap-asprintf.patch \ gnu/packages/patches/zathura-plugindir-environment-variable.patch +MISC_DISTRO_FILES = \ + gnu/packages/ld-wrapper.in + bootstrapdir = $(guilemoduledir)/gnu/packages/bootstrap bootstrap_x86_64_linuxdir = $(bootstrapdir)/x86_64-linux bootstrap_i686_linuxdir = $(bootstrapdir)/i686-linux diff --git a/gnu/packages.scm b/gnu/packages.scm index 13f2d9c803..6ef0fb6de7 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/gnu/packages/base.scm b/gnu/packages/base.scm index ac059870e2..361436157d 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -151,14 +151,14 @@ standard utility.") (define-public patch (package (name "patch") - (version "2.7.4") + (version "2.7.5") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/patch/patch-" version ".tar.xz")) (sha256 (base32 - "02gikxjvcxysr4l65c8vivgz62xmalp0av5ypzff8vqhrq3vpb0f")))) + "16d2r9kpivaak948mxzc0bai45mqfw73m113wrkmbffnalv1b5gx")))) (build-system gnu-build-system) (native-inputs `(("ed", ed))) (synopsis "Apply differences to originals, with optional backups") @@ -358,6 +358,72 @@ included.") (license gpl3+) (home-page "http://www.gnu.org/software/binutils/"))) +(define* (make-ld-wrapper name #:key binutils + (guile (canonical-package guile-2.0)) + (bash (canonical-package bash)) target + (guile-for-build guile)) + "Return a package called NAME that contains a wrapper for the 'ld' program +of BINUTILS, which adds '-rpath' flags to the actual 'ld' command line. When +TARGET is not #f, make a wrapper for the cross-linker for TARGET, called +'TARGET-ld'. The wrapper uses GUILE and BASH." + (package + (name name) + (version "0") + (source #f) + (build-system trivial-build-system) + (inputs `(("binutils" ,binutils) + ("guile" ,guile) + ("bash" ,bash) + ("wrapper" ,(search-path %load-path + "gnu/packages/ld-wrapper.in")))) + (arguments + `(#:guile ,guile-for-build + #:modules ((guix build utils)) + #:builder (begin + (use-modules (guix build utils) + (system base compile)) + + (let* ((out (assoc-ref %outputs "out")) + (bin (string-append out "/bin")) + (ld ,(if target + `(string-append bin "/" ,target "-ld") + '(string-append bin "/ld"))) + (go (string-append ld ".go"))) + + (setvbuf (current-output-port) _IOLBF) + (format #t "building ~s/bin/ld wrapper in ~s~%" + (assoc-ref %build-inputs "binutils") + out) + + (mkdir-p bin) + (copy-file (assoc-ref %build-inputs "wrapper") ld) + (substitute* ld + (("@SELF@") + ld) + (("@GUILE@") + (string-append (assoc-ref %build-inputs "guile") + "/bin/guile")) + (("@BASH@") + (string-append (assoc-ref %build-inputs "bash") + "/bin/bash")) + (("@LD@") + (string-append (assoc-ref %build-inputs "binutils") + ,(if target + (string-append "/bin/" + target "-ld") + "/bin/ld")))) + (chmod ld #o555) + (compile-file ld #:output-file go))))) + (synopsis "The linker wrapper") + (description + "The linker wrapper (or 'ld-wrapper') wraps the linker to add any +missing '-rpath' flags, and to detect any misuse of libraries outside of the +store.") + (home-page "http://www.gnu.org/software/guix/") + (license gpl3+))) + +(export make-ld-wrapper) + (define-public glibc (package (name "glibc") @@ -393,6 +459,12 @@ included.") ;; <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00709.html>. #: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" @@ -431,7 +503,8 @@ included.") #:tests? #f ; XXX #:phases (alist-cons-before 'configure 'pre-configure - (lambda* (#:key inputs outputs #:allow-other-keys) + (lambda* (#:key inputs native-inputs outputs + #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin"))) ;; Use `pwd', not `/bin/pwd'. @@ -455,8 +528,13 @@ included.") ;; Copy a statically-linked Bash in the output, with ;; no references to other store paths. + ;; FIXME: Normally we would look it up only in INPUTS but + ;; cross-base uses it as a native input. (mkdir-p bin) - (copy-file (string-append (assoc-ref inputs "static-bash") + (copy-file (string-append (or (assoc-ref inputs + "static-bash") + (assoc-ref native-inputs + "static-bash")) "/bin/bash") (string-append bin "/bash")) (remove-store-references (string-append bin "/bash")) @@ -611,7 +689,7 @@ command.") (define-public tzdata (package (name "tzdata") - (version "2014j") + (version "2015b") (source (origin (method url-fetch) (uri (string-append @@ -619,7 +697,7 @@ command.") version ".tar.gz")) (sha256 (base32 - "038fvj6zf51k6z9sbbxbj87ajaf69l3whal2vwshbm4l0qr71n52")))) + "0qmdr1yqqn94b5a54axwszfzimyxg27i6xsfmp0sswd3nfjw2sjm")))) (build-system gnu-build-system) (arguments '(#:tests? #f @@ -666,7 +744,7 @@ command.") version ".tar.gz")) (sha256 (base32 - "1qpd12imy7q5hb5fhk48mfw65s0xlrkmms0zr2gk0mj88qjn3m3z")))))) + "0xjxlgzva13y8qi3vfbb3nq5pii8ax9wi4yc7vj9134rbciz2s76")))))) (home-page "http://www.iana.org/time-zones") (synopsis "Database of current and historical time zones") (description "The Time Zone Database (often called tz or zoneinfo) diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm index 361eb475d6..02cb45c955 100644 --- a/gnu/packages/bash.scm +++ b/gnu/packages/bash.scm @@ -128,6 +128,26 @@ number/base32-hash tuples, directly usable in the 'patch-series' form." (let ((out (assoc-ref outputs "out"))) (with-directory-excursion (string-append out "/bin") (symlink "bash" "sh"))))) + (install-headers-phase + '(lambda* (#:key outputs #:allow-other-keys) + ;; Install Bash headers so that packages that provide extensions + ;; can use them. We install them in include/bash; that's what + ;; Debian does and what Bash extensions like recutils or + ;; guile-bash expect. + (let ((include (string-append (assoc-ref outputs "include") + "/include/bash")) + (headers "^\\./(builtins/|lib/glob/|lib/tilde/|)[^/]+\\.h$")) + (mkdir-p include) + (for-each (lambda (file) + (when ((@ (ice-9 regex) string-match) headers file) + (let ((directory (string-append include "/" + (dirname file)))) + (mkdir-p directory) + (copy-file file + (string-append directory "/" + (basename file)))))) + (find-files "." "\\.h$")) + #t))) (version "4.3")) (package (name "bash") @@ -148,6 +168,9 @@ number/base32-hash tuples, directly usable in the 'patch-series' form." (version (string-append version "." (number->string (length %patch-series-4.3)))) (build-system gnu-build-system) + + (outputs '("out" + "include")) ;headers used by extensions (native-inputs `(("bison" ,bison))) ;to rebuild the parser (inputs `(("readline" ,readline) ("ncurses" ,ncurses))) ;TODO: add texinfo @@ -169,9 +192,10 @@ number/base32-hash tuples, directly usable in the 'patch-series' form." ;; for now. #:tests? #f - #:phases (alist-cons-after 'install 'post-install - ,post-install-phase - %standard-phases))) + #:phases (modify-phases %standard-phases + (add-after 'install 'post-install ,post-install-phase) + (add-after 'install 'install-headers + ,install-headers-phase)))) (synopsis "The GNU Bourne-Again SHell") (description "Bash is the shell, or command-line interpreter, of the GNU system. It diff --git a/gnu/packages/bootstrap/i686-linux/bash b/gnu/packages/bootstrap/i686-linux/bash Binary files differindex 9882d4adc7..4b99d7eb4a 100755 --- a/gnu/packages/bootstrap/i686-linux/bash +++ b/gnu/packages/bootstrap/i686-linux/bash diff --git a/gnu/packages/bootstrap/i686-linux/mkdir b/gnu/packages/bootstrap/i686-linux/mkdir Binary files differindex 0ddab232b7..6623a38404 100755 --- a/gnu/packages/bootstrap/i686-linux/mkdir +++ b/gnu/packages/bootstrap/i686-linux/mkdir diff --git a/gnu/packages/bootstrap/i686-linux/tar b/gnu/packages/bootstrap/i686-linux/tar Binary files differindex 6bee702cf5..d33cd391f1 100755 --- a/gnu/packages/bootstrap/i686-linux/tar +++ b/gnu/packages/bootstrap/i686-linux/tar diff --git a/gnu/packages/bootstrap/i686-linux/xz b/gnu/packages/bootstrap/i686-linux/xz Binary files differindex 5a126e4fc5..f94dbde77c 100755 --- a/gnu/packages/bootstrap/i686-linux/xz +++ b/gnu/packages/bootstrap/i686-linux/xz diff --git a/gnu/packages/bootstrap/x86_64-linux/bash b/gnu/packages/bootstrap/x86_64-linux/bash Binary files differindex 3b0227fbb1..b9c410b7cf 100755 --- a/gnu/packages/bootstrap/x86_64-linux/bash +++ b/gnu/packages/bootstrap/x86_64-linux/bash diff --git a/gnu/packages/bootstrap/x86_64-linux/mkdir b/gnu/packages/bootstrap/x86_64-linux/mkdir Binary files differindex 7207ad8a46..f8250ae693 100755 --- a/gnu/packages/bootstrap/x86_64-linux/mkdir +++ b/gnu/packages/bootstrap/x86_64-linux/mkdir diff --git a/gnu/packages/bootstrap/x86_64-linux/tar b/gnu/packages/bootstrap/x86_64-linux/tar Binary files differindex 9104da7b53..90e492f89d 100755 --- a/gnu/packages/bootstrap/x86_64-linux/tar +++ b/gnu/packages/bootstrap/x86_64-linux/tar diff --git a/gnu/packages/bootstrap/x86_64-linux/xz b/gnu/packages/bootstrap/x86_64-linux/xz Binary files differindex 488e319b37..6bfe3c6d96 100755 --- a/gnu/packages/bootstrap/x86_64-linux/xz +++ b/gnu/packages/bootstrap/x86_64-linux/xz diff --git a/gnu/packages/cdrom.scm b/gnu/packages/cdrom.scm index 9af0ea7b09..e93503f25a 100644 --- a/gnu/packages/cdrom.scm +++ b/gnu/packages/cdrom.scm @@ -169,8 +169,7 @@ files.") (guix build utils) (guix build rpath) (srfi srfi-26)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils) + #:imported-modules (,@%gnu-build-system-modules (guix build rpath)) #:phases (alist-cons-after diff --git a/gnu/packages/certs.scm b/gnu/packages/certs.scm index db89466328..947d2b53f1 100644 --- a/gnu/packages/certs.scm +++ b/gnu/packages/certs.scm @@ -85,8 +85,6 @@ (rnrs io ports) (srfi srfi-26) (ice-9 regex)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils)) #:phases (alist-cons-after 'unpack 'install 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/commencement.scm b/gnu/packages/commencement.scm index 11d370905c..4342dc56d1 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -157,6 +157,8 @@ (srfi srfi-1) (srfi srfi-26)) ,@(substitute-keyword-arguments (package-arguments gcc-4.8) + ((#:validate-runpath? _) + #t) ((#:configure-flags flags) `(append (list ,(string-append "--target=" (boot-triplet)) @@ -523,6 +525,11 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%" "/lib") flag)) ,flags))) + ((#:validate-runpath? _) + ;; Things like libasan.so and libstdc++.so NEED ld.so and/or + ;; libgcc_s.so but RUNPATH is empty. This is a false positive, so + ;; turn it off. + #f) ((#:phases phases) `(alist-delete 'symlink-libgcc_eh ,phases))))) @@ -539,54 +546,10 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%" (define ld-wrapper-boot3 ;; A linker wrapper that uses the bootstrap Guile. - (package - (name "ld-wrapper-boot3") - (version "0") - (source #f) - (build-system trivial-build-system) - (inputs `(("binutils" ,binutils-final) - ("guile" ,%bootstrap-guile) - ("bash" ,@(assoc-ref %boot2-inputs "bash")) - ("wrapper" ,(search-path %load-path - "gnu/packages/ld-wrapper.scm")))) - (arguments - `(#:guile ,%bootstrap-guile - #:modules ((guix build utils)) - #:builder (begin - (use-modules (guix build utils) - (system base compile)) - - (let* ((out (assoc-ref %outputs "out")) - (bin (string-append out "/bin")) - (ld (string-append bin "/ld")) - (go (string-append bin "/ld.go"))) - - (setvbuf (current-output-port) _IOLBF) - (format #t "building ~s/bin/ld wrapper in ~s~%" - (assoc-ref %build-inputs "binutils") - out) - - (mkdir-p bin) - (copy-file (assoc-ref %build-inputs "wrapper") ld) - (substitute* ld - (("@GUILE@") - (string-append (assoc-ref %build-inputs "guile") - "/bin/guile")) - (("@BASH@") - (string-append (assoc-ref %build-inputs "bash") - "/bin/bash")) - (("@LD@") - (string-append (assoc-ref %build-inputs "binutils") - "/bin/ld"))) - (chmod ld #o555) - (compile-file ld #:output-file go))))) - (synopsis "The linker wrapper") - (description - "The linker wrapper (or `ld-wrapper') wraps the linker to add any -missing `-rpath' flags, and to detect any misuse of libraries outside of the -store.") - (home-page #f) - (license gpl3+))) + (make-ld-wrapper "ld-wrapper-boot3" + #:binutils binutils-final + #:guile %bootstrap-guile + #:bash (car (assoc-ref %boot2-inputs "bash")))) (define %boot3-inputs ;; 4th stage inputs. @@ -615,7 +578,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/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm index 5a67d4b6ac..0f15a0aaec 100644 --- a/gnu/packages/cross-base.scm +++ b/gnu/packages/cross-base.scm @@ -130,12 +130,16 @@ may be either a libc package or #f.)" ,target)) (binutils (string-append (assoc-ref inputs "binutils-cross") - "/bin/" ,target "-"))) + "/bin/" ,target "-")) + (wrapper (string-append + (assoc-ref inputs "ld-wrapper-cross") + "/bin/" ,target "-ld"))) (for-each (lambda (file) (symlink (string-append binutils file) (string-append libexec "/" file))) - '("as" "ld" "nm")) + '("as" "nm")) + (symlink wrapper (string-append libexec "/ld")) #t)) ,phases))) (if libc @@ -171,6 +175,8 @@ may be either a libc package or #f.)" #t))) ,phases) phases))) + ((#:validate-runpath? _) + #t) ((#:strip-binaries? _) ;; Disable stripping as this can break binaries, with object files of ;; libgcc.a showing up as having an unknown architecture. See @@ -214,7 +220,11 @@ GCC that does not target a libc; otherwise, target that libc." ,@(cross-gcc-arguments target libc))) (native-inputs - `(("binutils-cross" ,xbinutils) + `(("ld-wrapper-cross" ,(make-ld-wrapper + (string-append "ld-wrapper-" target) + #:target target + #:binutils xbinutils)) + ("binutils-cross" ,xbinutils) ;; Call it differently so that the builder can check whether the "libc" ;; input is #f. @@ -298,8 +308,13 @@ XBINUTILS and the cross tool chain." ;; "linux-headers" input to point to the right thing. (propagated-inputs `(("linux-headers" ,xlinux-headers))) + ;; FIXME: 'static-bash' should really be an input, not a native input, but + ;; to do that will require building an intermediate cross libc. + (inputs '()) + (native-inputs `(("cross-gcc" ,xgcc) ("cross-binutils" ,xbinutils) + ,@(package-inputs glibc) ;FIXME: static-bash ,@(package-native-inputs glibc))))) diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index ee97977777..6498091aaf 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -238,9 +238,12 @@ types are supported, as is encryption.") "04dl53iv5q0srv4jcgjfzsrdzkq6dg1sgmlmpw9lrd4xrmj6jmvl")))) (build-system gnu-build-system) (inputs `(("readline" ,readline))) - ;; Add -DSQLITE_SECURE_DELETE. GNU Icecat will refuse to use the system - ;; SQLite unless this option is enabled. - (arguments `(#:configure-flags '("CFLAGS=-O2 -DSQLITE_SECURE_DELETE"))) + (arguments + `(#:configure-flags + ;; Add -DSQLITE_SECURE_DELETE and -DSQLITE_ENABLE_UNLOCK_NOTIFY to + ;; CFLAGS. GNU Icecat will refuse to use the system SQLite unless these + ;; options are enabled. + '("CFLAGS=-O2 -DSQLITE_SECURE_DELETE -DSQLITE_ENABLE_UNLOCK_NOTIFY"))) (home-page "http://www.sqlite.org/") (synopsis "The SQLite database management system") (description diff --git a/gnu/packages/ed.scm b/gnu/packages/ed.scm index c2b19292f0..0d2b24cf8d 100644 --- a/gnu/packages/ed.scm +++ b/gnu/packages/ed.scm @@ -27,14 +27,14 @@ (define-public ed (package (name "ed") - (version "1.10") + (version "1.11") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/ed/ed-" version ".tar.lz")) (sha256 (base32 - "16kycdm5fcvpdr41hxb2da8da6jzs9dqznsg5552z6rh28n0jh4m")))) + "0d518yhs3kpdpv9fbpa1rhxk2fbry2yzcknrdaa20pi2bzg6w55x")))) (build-system gnu-build-system) (native-inputs `(("lzip" ,lzip))) (arguments diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm index f328cede28..3b9b7cf3f8 100644 --- a/gnu/packages/emacs.scm +++ b/gnu/packages/emacs.scm @@ -249,8 +249,7 @@ when typing parentheses directly or commenting out code line by line.") `(#:modules ((guix build gnu-build-system) (guix build utils) (guix build emacs-utils)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils) + #:imported-modules (,@%gnu-build-system-modules (guix build emacs-utils)) #:tests? #f ; no check target #:phases @@ -310,8 +309,7 @@ operations.") '(#:modules ((guix build gnu-build-system) (guix build utils) (guix build emacs-utils)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils) + #:imported-modules (,@%gnu-build-system-modules (guix build emacs-utils)) #:configure-flags (let ((out (assoc-ref %outputs "out"))) @@ -378,8 +376,7 @@ operations.") '(#:modules ((guix build gnu-build-system) (guix build utils) (guix build emacs-utils)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils) + #:imported-modules (,%gnu-build-system-modules (guix build emacs-utils)) #:tests? #f ; no check target #:phases @@ -446,8 +443,7 @@ operations.") '(#:modules ((guix build gnu-build-system) (guix build utils) (guix build emacs-utils)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils) + #:imported-modules (,%gnu-build-system-modules (guix build emacs-utils)) #:phases (alist-replace diff --git a/gnu/packages/gcc.scm b/gnu/packages/gcc.scm index 27e40f2f66..4c06f84155 100644 --- a/gnu/packages/gcc.scm +++ b/gnu/packages/gcc.scm @@ -85,6 +85,14 @@ where the OS part is overloaded to denote a specific ABI---into GCC '("CC" "CXX" "LD" "AR" "NM" "RANLIB" "STRIP") '("gcc" "g++" "ld" "ar" "nm" "ranlib" "strip")) '())))) + (libdir + (let ((base '(or (assoc-ref outputs "lib") + (assoc-ref outputs "out")))) + (lambda () + ;; Return the directory that contains lib/libgcc_s.so et al. + (if (%current-target-system) + `(string-append ,base "/" ,(%current-target-system)) + base)))) (configure-flags (lambda () ;; This is terrible. Since we have two levels of quasiquotation, @@ -181,12 +189,16 @@ where the OS part is overloaded to denote a specific ABI---into GCC ,(if stripped? "-g0" "-g"))))) #:tests? #f + + ;; libstdc++.so NEEDs libgcc_s.so but somehow it doesn't get + ;; $(libdir) in its RUNPATH, so turn it off. + #:validate-runpath? #f + #:phases (alist-cons-before 'configure 'pre-configure (lambda* (#:key inputs outputs #:allow-other-keys) - (let ((libdir (or (assoc-ref outputs "lib") - (assoc-ref outputs "out"))) + (let ((libdir ,(libdir)) (libc (assoc-ref inputs "libc"))) (when libc ;; The following is not performed for `--without-headers' diff --git a/gnu/packages/gettext.scm b/gnu/packages/gettext.scm index 27b5fb5f55..3a96cd613c 100644 --- a/gnu/packages/gettext.scm +++ b/gnu/packages/gettext.scm @@ -70,7 +70,15 @@ (substitute* "gettext-tools/src/project-id" (("/bin/pwd") "pwd"))))) - %standard-phases) + (alist-cons-before + 'configure 'link-expat + (lambda _ + ;; Gettext defaults to opening expat via dlopen on + ;; "Linux". Change to link directly. + (substitute* "gettext-tools/configure" + (("LIBEXPAT=\"-ldl\"") "LIBEXPAT=\"-ldl -lexpat\"") + (("LTLIBEXPAT=\"-ldl\"") "LTLIBEXPAT=\"-ldl -lexpat\""))) + %standard-phases)) ;; When tests fail, we want to know the details. #:make-flags '("VERBOSE=yes"))) diff --git a/gnu/packages/ghostscript.scm b/gnu/packages/ghostscript.scm index c63e0415b4..f9026704da 100644 --- a/gnu/packages/ghostscript.scm +++ b/gnu/packages/ghostscript.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -125,8 +126,10 @@ printing, and psresize, for adjusting page sizes.") (method url-fetch) (uri (string-append "mirror://gnu/ghostscript/gnu-ghostscript-" version ".tar.xz")) - (sha256 (base32 - "0q4jj41p0qbr4mgcc9q78f5zs8cm1g57wgryhsm2yq4lfslm3ib1")))) + (sha256 + (base32 + "0q4jj41p0qbr4mgcc9q78f5zs8cm1g57wgryhsm2yq4lfslm3ib1")) + (patches (list (search-patch "ghostscript-runpath.patch"))))) (build-system gnu-build-system) (inputs `(("freetype" ,freetype) ("lcms" ,lcms) @@ -142,20 +145,19 @@ printing, and psresize, for adjusting page sizes.") ("tcl" ,tcl))) (arguments `(#:phases - (alist-cons-after - 'configure 'patch-config-files - (lambda _ - (substitute* "base/all-arch.mak" - (("/bin/sh") (which "bash"))) - (substitute* "base/unixhead.mak" - (("/bin/sh") (which "bash")))) - (alist-cons-after - 'build 'build-so - (lambda _ (system* "make" "so")) - (alist-cons-after - 'install 'install-so - (lambda _ (system* "make" "install-so")) - %standard-phases))))) + (modify-phases %standard-phases + (add-after 'configure 'patch-config-files + (lambda _ + (substitute* "base/all-arch.mak" + (("/bin/sh") (which "bash"))) + (substitute* "base/unixhead.mak" + (("/bin/sh") (which "bash"))))) + (add-after 'build 'build-so + (lambda _ + (zero? (system* "make" "so")))) + (add-after 'install 'install-so + (lambda _ + (zero? (system* "make" "install-so"))))))) (synopsis "PostScript and PDF interpreter") (description "Ghostscript is an interpreter for the PostScript language and the PDF diff --git a/gnu/packages/gl.scm b/gnu/packages/gl.scm index dc90a1231d..f3e63180c6 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")) @@ -418,3 +418,50 @@ extension functionality is exposed in a single header file.") "Guile-OpenGL is a library for Guile that provides bindings to the OpenGL graphics API.") (license l:lgpl3+))) + +(define-public libepoxy + (package + (name "libepoxy") + (version "1.2") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/anholt/libepoxy/archive/v" + version + ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1xp8g6b7xlbym2rj4vkbl6xpb7ijq7glpv656mc7k9b01x22ihs2")))) + (arguments + '(#:phases + (alist-cons-after + 'unpack 'autoreconf + (lambda _ + (zero? (system* "autoreconf" "-vif"))) + (alist-cons-before + 'configure 'patch-paths + (lambda* (#:key inputs #:allow-other-keys) + (let ((python (assoc-ref inputs "python")) + (mesa (assoc-ref inputs "mesa"))) + (substitute* "src/gen_dispatch.py" + (("/usr/bin/env python") python)) + (substitute* (find-files "." "\\.[ch]$") + (("libGL.so.1") (string-append mesa "/lib/libGL.so.1")) + (("libEGL.so.1") (string-append mesa "/lib/libEGL.so.1"))) + #t)) + %standard-phases)))) + (build-system gnu-build-system) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("libtool" ,libtool) + ("pkg-config" ,pkg-config) + ("python" ,python))) + (inputs + `(("mesa" ,mesa))) + (home-page "http://github.com/anholt/libepoxy/") + (synopsis "A library for handling OpenGL function pointer management") + (description + "A library for handling OpenGL function pointer management.") + (license l:x11))) diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index 3c68d86c96..ab789b2d0e 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> -;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,7 +57,7 @@ (define dbus (package (name "dbus") - (version "1.8.12") + (version "1.8.16") (source (origin (method url-fetch) (uri @@ -65,7 +65,7 @@ version ".tar.gz")) (sha256 (base32 - "07jhcalg00i2rx5zrgk73rg0vm7lzi5q5z2gscrbl999ipr2h569")) + "01rba8mp8kqvmy6ibdmi806kjr3m14swnskqk02gyhykxxl54ybz")) (patches (list (search-patch "dbus-localstatedir.patch"))))) (build-system gnu-build-system) (arguments @@ -119,7 +119,7 @@ shared NFS home directories.") (define glib (package (name "glib") - (version "2.42.1") + (version "2.44.0") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" @@ -127,7 +127,7 @@ shared NFS home directories.") name "-" version ".tar.xz")) (sha256 (base32 - "16pqvikrps1fvwwqvk0qi4a13mfg7gw6w5qfhk7bhi8f51jhhgwg")) + "1fgmjv3yzxgbks31h42201x2izpw0sd84h8dfw0si3x00sqn5lzj")) (patches (list (search-patch "glib-tests-homedir.patch") (search-patch "glib-tests-desktop.patch") (search-patch "glib-tests-prlimit.patch") @@ -189,7 +189,11 @@ shared NFS home directories.") ;; by 'glib-compile-schemas'. (list (search-path-specification (variable "XDG_DATA_DIRS") - (files '("share"))))) + (files '("share"))) + ;; To load extra gio modules from glib-networking, etc. + (search-path-specification + (variable "GIO_EXTRA_MODULES") + (files '("lib/gio/modules"))))) (search-paths native-search-paths) (synopsis "Thread-safe general utility library; basis of GTK+ and GNOME") diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 1a42bffd7a..78fd0f0107 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -1751,11 +1751,11 @@ and the GLib main loop, to integrate well with GNOME applications.") (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/gnutls.scm b/gnu/packages/gnutls.scm index 0ae660bf5d..b2176ec191 100644 --- a/gnu/packages/gnutls.scm +++ b/gnu/packages/gnutls.scm @@ -103,7 +103,7 @@ living in the same process.") (define-public gnutls (package (name "gnutls") - (version "3.3.12") + (version "3.3.14") (source (origin (method url-fetch) (uri @@ -114,7 +114,7 @@ living in the same process.") "/gnutls-" version ".tar.xz")) (sha256 (base32 - "16r96bzsfqx1rlqrkggmhhx6zbxj1fmc3mwpp0ik73ylqn93xav7")))) + "0lpcgkp8bb1b7f9z935f7h9c0srd4fc52404x70hk2ddz8q01yhd")))) (build-system gnu-build-system) (arguments '(#:configure-flags diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index fc2b41d38b..887bace423 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr> -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; @@ -157,8 +157,6 @@ in the Mozilla clients.") (ice-9 ftw) (ice-9 match) (srfi srfi-26)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils)) #:phases (alist-replace 'configure 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/gtk.scm b/gnu/packages/gtk.scm index 0dd3b37b3c..bb30f6f8fa 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -35,6 +35,7 @@ #:use-module (gnu packages compression) #:use-module (gnu packages fontutils) #:use-module (gnu packages ghostscript) + #:use-module (gnu packages gl) #:use-module (gnu packages glib) #:use-module (gnu packages gnome) #:use-module (gnu packages icu4c) @@ -84,14 +85,14 @@ tools have full access to view and control running applications.") (define-public cairo (package (name "cairo") - (version "1.12.18") + (version "1.14.2") (source (origin (method url-fetch) (uri (string-append "http://cairographics.org/releases/cairo-" version ".tar.xz")) (sha256 (base32 - "1dpmlxmmigpiyv0jchjsn2l1a29655x24g5073hy8p4lmjvz0nfw")))) + "1sycbq0agbwmg1bj9lhkgsf0glmblaf2jrdy9g6vxfxivncxj6f9")))) (build-system gnu-build-system) (propagated-inputs `(("fontconfig" ,fontconfig) @@ -474,7 +475,7 @@ application suites.") (define-public gtk+ (package (inherit gtk+-2) (name "gtk+") - (version "3.14.7") + (version "3.16.0") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -482,11 +483,12 @@ application suites.") name "-" version ".tar.xz")) (sha256 (base32 - "0vm40n6nf0w3vv54wqy67jcxddka7hplksi093xim3119yq196gv")))) + "1si6ihl1wlvag8qq3166skr9fnm9i33dimbfry1j628qzqc76qff")))) (propagated-inputs `(("at-spi2-atk" ,at-spi2-atk) ("atk" ,atk) ("gdk-pixbuf" ,gdk-pixbuf) + ("libepoxy" ,libepoxy) ("libxi" ,libxi) ("libxinerama" ,libxinerama) ("libxdamage" ,libxdamage) @@ -497,25 +499,28 @@ application suites.") (native-inputs `(("perl" ,perl) ("glib" ,glib "bin") + ("gettext" ,gnu-gettext) ("pkg-config" ,pkg-config) ("gobject-introspection" ,gobject-introspection) ("python-wrapper" ,python-wrapper) ("xorg-server" ,xorg-server))) (arguments `(#:phases - (alist-replace - 'configure - (lambda* (#:key inputs #:allow-other-keys #:rest args) - (let ((configure (assoc-ref %standard-phases 'configure))) - ;; Disable most tests, failing in the chroot with the message: - ;; D-Bus library appears to be incorrectly set up; failed to read - ;; machine uuid: Failed to open "/etc/machine-id": No such file or - ;; directory. - ;; See the manual page for dbus-uuidgen to correct this issue. - (substitute* "testsuite/Makefile.in" - (("SUBDIRS = gdk gtk a11y css reftests") - "SUBDIRS = gdk")) - (apply configure args))) + (alist-cons-before + 'configure 'pre-configure + (lambda _ + ;; Disable most tests, failing in the chroot with the message: + ;; D-Bus library appears to be incorrectly set up; failed to read + ;; machine uuid: Failed to open "/etc/machine-id": No such file or + ;; directory. + ;; See the manual page for dbus-uuidgen to correct this issue. + (substitute* "testsuite/Makefile.in" + (("SUBDIRS = gdk gtk a11y css reftests") + "SUBDIRS = gdk")) + (substitute* '("demos/widget-factory/Makefile.in" + "demos/gtk-demo/Makefile.in") + (("gtk-update-icon-cache") "$(bindir)/gtk-update-icon-cache")) + #t) %standard-phases))))) ;;; diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm index beecccb3bf..05622ca068 100644 --- a/gnu/packages/haskell.scm +++ b/gnu/packages/haskell.scm @@ -114,8 +114,7 @@ (guix build rpath) (srfi srfi-26) (srfi srfi-1)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils) + #:imported-modules (,%gnu-build-system-modules (guix build rpath)) #:configure-flags (list 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/ld-wrapper.scm b/gnu/packages/ld-wrapper.in index 4fa2962bb9..094018de3d 100644 --- a/gnu/packages/ld-wrapper.scm +++ b/gnu/packages/ld-wrapper.in @@ -8,7 +8,7 @@ # .go file (see <http://bugs.gnu.org/12519>). main="(@ (gnu build-support ld-wrapper) ld-wrapper)" -exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" "$@" +exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line)))" "$@" !# ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> @@ -82,27 +82,53 @@ exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" " ;; Whether to emit debugging output. (getenv "GUIX_LD_WRAPPER_DEBUG")) -(define (pure-file-name? file) - ;; Return #t when FILE is the name of a file either within the store - ;; (possibly via a symlink) or within the build directory. +(define %disable-rpath? + ;; Whether to disable automatic '-rpath' addition. + (getenv "GUIX_LD_WRAPPER_DISABLE_RPATH")) + +(define (readlink* file) + ;; Call 'readlink' until the result is not a symlink. (define %max-symlink-depth 50) (let loop ((file file) (depth 0)) + (catch 'system-error + (lambda () + (if (>= depth %max-symlink-depth) + file + (loop (readlink file) (+ depth 1)))) + (lambda args + (if (= EINVAL (system-error-errno args)) + file + (apply throw args)))))) + +(define (dereference-symlinks file) + ;; Same as 'readlink*' but return FILE if the symlink target is invalid or + ;; FILE does not exist. + (catch 'system-error + (lambda () + ;; When used from a user environment, FILE may refer to + ;; ~/.guix-profile/lib/libfoo.so, which is itself a symlink to the + ;; store. Check whether this is the case. + (readlink* file)) + (lambda args + (if (= ENOENT (system-error-errno args)) + file + (apply throw args))))) + +(define (pure-file-name? file) + ;; Return #t when FILE is the name of a file either within the store + ;; (possibly via a symlink) or within the build directory. + (let ((file (dereference-symlinks file))) (or (not (string-prefix? "/" file)) (string-prefix? %store-directory file) (string-prefix? %temporary-directory file) - (if %build-directory - (string-prefix? %build-directory file) - - ;; When used from a user environment, FILE may refer to - ;; ~/.guix-profile/lib/libfoo.so, which is itself a symlink to the - ;; store. Check whether this is the case. - (let ((s (false-if-exception (lstat file)))) - (and s - (eq? 'symlink (stat:type s)) - (< depth %max-symlink-depth) - (loop (readlink file) (+ 1 depth)))))))) + (and %build-directory + (string-prefix? %build-directory file))))) + +(define (store-file-name? file) + ;; Return #t when FILE is a store file, possibly indirectly. + (string-prefix? %store-directory (dereference-symlinks file))) (define (shared-library? file) ;; Return #t when FILE denotes a shared library. @@ -150,14 +176,23 @@ exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" " ;; Return the `-rpath' argument list for each of LIBRARY-FILES, a list of ;; absolute file names. (fold-right (lambda (file args) - (if (or %allow-impurities? - (pure-file-name? file)) - (cons* "-rpath" (dirname file) args) - (begin - (format (current-error-port) - "ld-wrapper: error: attempt to use impure library ~s~%" - file) - (exit 1)))) + ;; Add '-rpath' if and only if FILE is in the store; we don't + ;; want to add '-rpath' for files under %BUILD-DIRECTORY or + ;; %TEMPORARY-DIRECTORY because that could leak to installed + ;; files. + (cond ((and (not %disable-rpath?) + (store-file-name? file)) + (cons* "-rpath" (dirname file) args)) + ((or %allow-impurities? + (pure-file-name? file)) + args) + (else + (begin + (format (current-error-port) + "ld-wrapper: error: attempt to use \ +impure library ~s~%" + file) + (exit 1))))) '() library-files)) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 4dc543d8a4..e2b8301fef 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -91,7 +91,7 @@ version "-gnu.tar.xz"))) (define-public linux-libre-headers - (let* ((version "3.3.8") + (let* ((version "3.14.37") (build-phase (lambda (arch) `(lambda _ @@ -120,7 +120,7 @@ (uri (linux-libre-urls version)) (sha256 (base32 - "0jkfh0z1s6izvdnc3njm39dhzp1cg8i06jv06izwqz9w9qsprvnl")))) + "1blxr2bsvfqi9khj4cpspv434bmx252zak2wsbi2mgl60zh77gza")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl))) (arguments @@ -405,8 +405,14 @@ providing the system administrator with some help in common tasks.") (("build_kill=yes") "build_kill=no"))))) (build-system gnu-build-system) (arguments - `(#:configure-flags '("--disable-use-tty-group" - "--enable-ddate") + `(#:configure-flags (list "--disable-use-tty-group" + "--enable-ddate" + + ;; Install completions where our + ;; bash-completion package expects them. + (string-append "--with-bashcompletiondir=" + (assoc-ref %outputs "out") + "/etc/bash_completion.d")) #:phases (alist-cons-before 'check 'pre-check (lambda* (#:key inputs outputs #:allow-other-keys) diff --git a/gnu/packages/ncurses.scm b/gnu/packages/ncurses.scm index 0dbc583f79..180cdde19f 100644 --- a/gnu/packages/ncurses.scm +++ b/gnu/packages/ncurses.scm @@ -43,14 +43,6 @@ (string-append "CONFIG_SHELL=" bash) (string-append "--prefix=" out) configure-flags))))) - (cross-pre-install-phase - '(lambda _ - ;; Run the native `tic' program, not the cross-built one. - (substitute* "misc/run_tic.sh" - (("\\{TIC_PATH:=.*\\}") - "{TIC_PATH:=true}") - (("cross_compiling:=no") - "cross_compiling:=yes")))) (post-install-phase '(lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) @@ -116,12 +108,9 @@ `(alist-cons-before ; cross build 'configure 'patch-makefile-SHELL ,patch-makefile-phase - (alist-cons-before - 'install 'pre-install - ,cross-pre-install-phase - (alist-cons-after - 'install 'post-install ,post-install-phase - %standard-phases))) + (alist-cons-after + 'install 'post-install ,post-install-phase + %standard-phases)) `(alist-cons-after ; native build 'install 'post-install ,post-install-phase diff --git a/gnu/packages/node.scm b/gnu/packages/node.scm index 8d9a0f5be9..0b65843183 100644 --- a/gnu/packages/node.scm +++ b/gnu/packages/node.scm @@ -29,7 +29,6 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix download) - #:use-module (guix build gnu-build-system) #:use-module (guix build-system gnu)) (define-public node 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/openssl.scm b/gnu/packages/openssl.scm index 6acbb12737..1ed7a7a1f2 100644 --- a/gnu/packages/openssl.scm +++ b/gnu/packages/openssl.scm @@ -36,7 +36,8 @@ ".tar.gz")) (sha256 (base32 - "0jijgzf72659pikms2bc5w31h78xrd1h5zp2r01an2h340y3kdhm")))) + "0jijgzf72659pikms2bc5w31h78xrd1h5zp2r01an2h340y3kdhm")) + (patches (list (search-patch "openssl-runpath.patch"))))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl))) (arguments diff --git a/gnu/packages/patches/ghostscript-runpath.patch b/gnu/packages/patches/ghostscript-runpath.patch new file mode 100644 index 0000000000..c7dcfd4529 --- /dev/null +++ b/gnu/packages/patches/ghostscript-runpath.patch @@ -0,0 +1,17 @@ +This patch adds $(libdir) to the RUNPATH of 'gsc' and 'gsx'. + +--- gnu-ghostscript-9.14.0/base/unix-dll.mak 2015-04-05 15:12:45.386957927 +0200 ++++ gnu-ghostscript-9.14.0/base/unix-dll.mak 2015-04-05 15:12:49.222982359 +0200 +@@ -91,11 +91,11 @@ $(GS_SO_MAJOR): $(GS_SO_MAJOR_MINOR) + # Build the small Ghostscript loaders, with Gtk+ and without + $(GSSOC_XE): $(GS_SO) $(PSSRC)$(SOC_LOADER) + $(GLCC) -g -o $(GSSOC_XE) $(PSSRC)dxmainc.c \ +- -L$(BINDIR) -l$(GS_SO_BASE) ++ -L$(BINDIR) -l$(GS_SO_BASE) -Wl,-rpath=$(libdir) + + $(GSSOX_XE): $(GS_SO) $(PSSRC)$(SOC_LOADER) + $(GLCC) -g $(SOC_CFLAGS) -o $(GSSOX_XE) $(PSSRC)$(SOC_LOADER) \ +- -L$(BINDIR) -l$(GS_SO_BASE) $(SOC_LIBS) ++ -L$(BINDIR) -l$(GS_SO_BASE) $(SOC_LIBS) -Wl,-rpath=$(libdir) + + # ------------------------- Recursive make targets ------------------------- # diff --git a/gnu/packages/patches/openssl-runpath.patch b/gnu/packages/patches/openssl-runpath.patch new file mode 100644 index 0000000000..fa7c0b9962 --- /dev/null +++ b/gnu/packages/patches/openssl-runpath.patch @@ -0,0 +1,15 @@ +This patch makes the build system pass -Wl,-rpath=$out/lib even for +libraries (it already does so for executables, thanks to 'DO_GNU_APP' +in 'Makefile.shared'.) + +--- openssl-1.0.2a/Makefile.shared 2015-04-05 01:07:35.357602454 +0200 ++++ openssl-1.0.2a/Makefile.shared 2015-04-05 01:09:50.474513303 +0200 +@@ -106,7 +106,7 @@ LINK_SO= \ + LIBPATH=`for x in $$LIBDEPS; do echo $$x; done | sed -e 's/^ *-L//;t' -e d | uniq`; \ + LIBPATH=`echo $$LIBPATH | sed -e 's/ /:/g'`; \ + LD_LIBRARY_PATH=$$LIBPATH:$$LD_LIBRARY_PATH \ +- $${SHAREDCMD} $${SHAREDFLAGS} \ ++ $${SHAREDCMD} $${SHAREDFLAGS} -Wl,-rpath,$(LIBRPATH) \ + -o $$SHLIB$$SHLIB_SOVER$$SHLIB_SUFFIX \ + $$ALLSYMSFLAGS $$SHOBJECTS $$NOALLSYMSFLAGS $$LIBDEPS \ + ) && $(SYMLINK_SO) 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/samba.scm b/gnu/packages/samba.scm index c147abcaab..d26d2d7789 100644 --- a/gnu/packages/samba.scm +++ b/gnu/packages/samba.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -127,8 +127,7 @@ anywhere.") (guix build utils) (guix build rpath) (srfi srfi-26)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils) + #:imported-modules (,%gnu-build-system-modules (guix build rpath)) ;; This flag is required to allow for "make test". diff --git a/gnu/packages/sdl.scm b/gnu/packages/sdl.scm index 9a3b3898d8..4e9ebfb034 100644 --- a/gnu/packages/sdl.scm +++ b/gnu/packages/sdl.scm @@ -20,12 +20,12 @@ (define-module (gnu packages sdl) #:use-module (gnu packages) - #:use-module (guix licenses) + #:use-module ((guix licenses) #:hide (freetype)) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (guix build-system trivial) - #:use-module ((gnu packages fontutils) #:prefix font:) + #:use-module (gnu packages fontutils) #:use-module (gnu packages guile) #:use-module (gnu packages image) #:use-module (gnu packages linux) @@ -260,7 +260,7 @@ SDL.") "1dydxd4f5kb1288i5n5568kdk2q7f8mqjr7i7sd33nplxjaxhk3j")))) (build-system gnu-build-system) (propagated-inputs `(("sdl" ,sdl))) - (inputs `(("freetype" ,font:freetype) + (inputs `(("freetype" ,freetype) ("mesa" ,mesa))) (native-inputs `(("pkg-config" ,pkg-config))) (synopsis "SDL TrueType font library") 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/texlive.scm b/gnu/packages/texlive.scm index 56149ab58e..14ee9c37ad 100644 --- a/gnu/packages/texlive.scm +++ b/gnu/packages/texlive.scm @@ -176,8 +176,6 @@ This package contains the binaries.") `(#:modules ((guix build gnu-build-system) (guix build utils) (srfi srfi-26)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils)) #:phases (alist-cons-before 'texmf-config 'install diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index 8ded42ce96..661ef91386 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -320,8 +320,7 @@ standards (MPEG-2, MPEG-4 ASP/H.263, MPEG-4 AVC/H.264, and VC-1/VMW3).") (guix build utils) (guix build rpath) (srfi srfi-26)) - #:imported-modules ((guix build gnu-build-system) - (guix build utils) + #:imported-modules (,@%gnu-build-system-modules (guix build rpath)) #:phases (alist-replace @@ -775,12 +774,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. @@ -1256,7 +1255,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/gnu/packages/xfce.scm b/gnu/packages/xfce.scm index a08f004119..b39b903e9b 100644 --- a/gnu/packages/xfce.scm +++ b/gnu/packages/xfce.scm @@ -569,9 +569,6 @@ on your desktop.") (guix build glib-or-gtk-build-system) (guix build utils) (srfi srfi-26)) - #:imported-modules ((guix build gnu-build-system) - (guix build glib-or-gtk-build-system) - (guix build utils)) #:phases (alist-replace 'install 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 <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; ;;; 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 <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch> ;;; @@ -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..3ccdef1328 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,9 +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) + (guix build gremlin) + (guix elf))) + +(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 @@ -182,7 +190,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) @@ -277,10 +285,11 @@ 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)) - (imported-modules %default-modules) + (imported-modules %gnu-build-system-modules) (modules %default-modules) (substitutable? #t) allowed-references) @@ -339,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))) @@ -411,13 +421,12 @@ 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)) - (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 @@ -486,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-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 <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; 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 <davet@gnu.org> -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; 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 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 40f1bb85fa..15d7de2236 100644 --- a/guix/build/glib-or-gtk-build-system.scm +++ b/guix/build/glib-or-gtk-build-system.scm @@ -242,9 +242,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-build-system.scm b/guix/build/gnu-build-system.scm index 5ae537150f..c60f8ba162 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/' @@ -477,6 +538,16 @@ DOCUMENTATION-COMPRESSOR-FLAGS." (format #t "not compressing documentation~%") #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"))) + (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 () @@ -486,7 +557,9 @@ DOCUMENTATION-COMPRESSOR-FLAGS." patch-source-shebangs configure patch-generated-file-shebangs build check install patch-shebangs strip + validate-runpath validate-documentation-location + delete-info-dir-file compress-documentation))) 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/gremlin.scm b/guix/build/gremlin.scm index e8429129e1..30b06034dd 100644 --- a/guix/build/gremlin.scm +++ b/guix/build/gremlin.scm @@ -18,14 +18,22 @@ (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) #: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 +49,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." @@ -197,6 +224,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" @@ -214,23 +242,42 @@ 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 (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) + "~a: error: 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 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..676a0120e3 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? @@ -44,6 +45,7 @@ mkdir-p copy-recursively delete-file-recursively + file-name-predicate find-files search-path-as-list @@ -80,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 @@ -263,33 +269,46 @@ 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<?)) +(define (file-name-predicate regexp) + "Return a predicate that returns true when passed a file name whose base +name matches REGEXP." + (let ((file-rx (if (regexp? regexp) + regexp + (make-regexp regexp)))) + (lambda (file stat) + (regexp-exec file-rx (basename file))))) + +(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). 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)))) + ;; Sort the result to get deterministic results. + (sort (file-system-fold (const #t) + (lambda (file stat result) ; leaf + (if (pred file stat) + (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 + stat) + string<?))) ;;; @@ -446,13 +465,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) diff --git a/guix/packages.scm b/guix/packages.scm index ec0e79d08b..99fbd24cb6 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) @@ -334,8 +335,10 @@ 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 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 @@ -349,10 +352,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 (snippet #f) (flags '("-p1")) (modules '()) @@ -370,10 +372,20 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." (derivation->output-path source) source)) + (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") ((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 @@ -398,115 +410,95 @@ 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) + #$(if (string=? decompression-type "unzip") + #~(zero? (system* "unzip" #$source)) + #~(zero? (system* (string-append #$tar "/bin/tar") + "xvf" #$source)))) + (let ((directory (first-file "."))) + (format (current-error-port) + "source is under '~a'~%" directory) + (chdir directory) + + (and (every apply-patch '#$patches) + #$@(if snippet + #~((let ((module (make-fresh-user-module))) + (module-use-interfaces! module + (map resolve-interface + '#$modules)) + ((@ (system base compile) compile) + '#$snippet + #:to 'value + #:opts %auto-compilation-options + #:env module))) + #~()) + + (begin (chdir "..") #t) + (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 +946,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 <origin> object, return its derivation for SYSTEM. When @@ -976,14 +965,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))) 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 67c65aa14d..5ca5afe457 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -47,6 +47,8 @@ P_ report-error leave + report-load-error + warn-about-load-error show-version-and-exit show-bug-report-information string->number* @@ -130,6 +132,38 @@ 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 (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 diff --git a/tests/packages.scm b/tests/packages.scm index c9dd5d859a..a181b1b08a 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -205,10 +205,7 @@ (chmod "." #o777) (symlink "guile" "guile-rocks") (copy-recursively "../share/guile/2.0/scripts" - "scripts") - - ;; These variables must exist. - (pk %build-inputs %outputs)))))) + "scripts")))))) (package (package (inherit (dummy-package "with-snippet")) (source source) (build-system trivial-build-system) |