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 \
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 \
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 \
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
(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))))
(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")
(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")
;; <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"
#: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'.
;; 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"))
(define-public tzdata
(package
(name "tzdata")
- (version "2014j")
+ (version "2015b")
(source (origin
(method url-fetch)
(uri (string-append
version ".tar.gz"))
(sha256
(base32
- "038fvj6zf51k6z9sbbxbj87ajaf69l3whal2vwshbm4l0qr71n52"))))
+ "0qmdr1yqqn94b5a54axwszfzimyxg27i6xsfmp0sswd3nfjw2sjm"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f
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)
(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")
(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
;; 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
(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
(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
(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
(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"))
"/share/man/man1"))
(mkdir-p (string-append out
"/share/doc")))))
- (replace check
+ (replace 'check
(lambda _
(setenv "HOME" (getcwd))
(setenv "PATH"
(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))
"/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)))))
(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.
(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
,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
#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
,@(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.
;; "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)))))
\f
"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
(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
`(#: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
'(#: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")))
'(#: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
'(#: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
'("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,
,(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'
(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")))
;;; 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.
;;;
(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)
("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
(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")
(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")
'(#: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"))
"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)))
;;; 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.
;;;
(define dbus
(package
(name "dbus")
- (version "1.8.12")
+ (version "1.8.16")
(source (origin
(method url-fetch)
(uri
version ".tar.gz"))
(sha256
(base32
- "07jhcalg00i2rx5zrgk73rg0vm7lzi5q5z2gscrbl999ipr2h569"))
+ "01rba8mp8kqvmy6ibdmi806kjr3m14swnskqk02gyhykxxl54ybz"))
(patches (list (search-patch "dbus-localstatedir.patch")))))
(build-system gnu-build-system)
(arguments
(define glib
(package
(name "glib")
- (version "2.42.1")
+ (version "2.44.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/"
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")
;; 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")
(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"))
(define-public gnutls
(package
(name "gnutls")
- (version "3.3.12")
+ (version "3.3.14")
(source (origin
(method url-fetch)
(uri
"/gnutls-" version ".tar.xz"))
(sha256
(base32
- "16r96bzsfqx1rlqrkggmhhx6zbxj1fmc3mwpp0ik73ylqn93xav7"))))
+ "0lpcgkp8bb1b7f9z935f7h9c0srd4fc52404x70hk2ddz8q01yhd"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
;;; 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>
;;;
(ice-9 ftw)
(ice-9 match)
(srfi srfi-26))
- #:imported-modules ((guix build gnu-build-system)
- (guix build utils))
#:phases
(alist-replace
'configure
(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"))
#: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)
(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)
(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 "/"
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)
(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)))))
;;;
(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
(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 ")
(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"))
# .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>
;; 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.
;; 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))
version "-gnu.tar.xz")))
(define-public linux-libre-headers
- (let* ((version "3.3.8")
+ (let* ((version "3.14.37")
(build-phase
(lambda (arch)
`(lambda _
(uri (linux-libre-urls version))
(sha256
(base32
- "0jkfh0z1s6izvdnc3njm39dhzp1cg8i06jv06izwqz9w9qsprvnl"))))
+ "1blxr2bsvfqi9khj4cpspv434bmx252zak2wsbi2mgl60zh77gza"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)))
(arguments
(("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)
(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")))
`(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
#: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
'(#:phases
(modify-phases %standard-phases
(add-after
- unpack autogen
+ 'unpack 'autogen
(lambda _
(zero? (system* "sh" "autogen.sh")))))
#:configure-flags
".tar.gz"))
(sha256
(base32
- "0jijgzf72659pikms2bc5w31h78xrd1h5zp2r01an2h340y3kdhm"))))
+ "0jijgzf72659pikms2bc5w31h78xrd1h5zp2r01an2h340y3kdhm"))
+ (patches (list (search-patch "openssl-runpath.patch")))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)))
(arguments
--- /dev/null
+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 ------------------------- #
--- /dev/null
+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)
'(#: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
;;; 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.
(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".
(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)
"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")
(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"
`(#: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")
`(#: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
(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
'(#: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.
'(#:phases
(modify-phases %standard-phases
(add-after
- unpack autogen
+ 'unpack 'autogen
(lambda _
(zero? (system* "sh" "autogen.sh")))))))
(home-page "http://www.vapoursynth.com/")
(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
;;; 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.
#: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:
;;
;; 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."
(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
;;; 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>
;;;
#: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:
'((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
%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."
#: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
;;
;; 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)))
(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)
(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)
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
+ #:validate-runpath? ,validate-runpath?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(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
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
+ #:validate-runpath? ,validate-runpath?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories))))
;;; 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.
;;;
#: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:
;;
;; 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."
(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
#: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))
;;
;; 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.
(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
;;; 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.
;;;
#: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.
(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."
#: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:
;;
;; 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))
(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
;; 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)
(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)
(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))
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/'
(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 ()
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)))
\f
(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
(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
;;;
;;; 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."
"libc.so"
"libdl.so"
"libm.so"
+ "libnsl.so" ;NEEDED by nscd
"libpthread.so"
"libresolv.so"
"librt.so"
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
;; 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)
;; '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)
(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)
#:re-export (alist-cons
alist-delete)
#:export (%store-directory
+ store-file-name?
parallel-job-count
directory-exists?
mkdir-p
copy-recursively
delete-file-recursively
+ file-name-predicate
find-files
search-path-as-list
(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
;; 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<?)))
\f
;;;
(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))))
\f
;;;
(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)
#: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)
("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
(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 '())
(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
".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)
(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
(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)))
(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))))
\f
;;;
P_
report-error
leave
+ report-load-error
+ warn-about-load-error
show-version-and-exit
show-bug-report-information
string->number*
(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
(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)
HCoop / jackhill / guix / guix.git / commitdiff