Merge branch 'master' into 'core-updates'.

21 files changed, 1284 insertions, 77 deletions

diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm
index 51e0c419e3..8091311879 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -122,6 +122,7 @@
                                                   "bin" "sbin"))
                             (phases '(@ (guix build glib-or-gtk-build-system)
                                         %standard-phases))
+                            (glib-or-gtk-wrap-excluded-outputs ''())
                             (system (%current-system))
                             (imported-modules %default-imported-modules)
                             (modules %default-modules)
@@ -153,6 +154,8 @@
                           #:search-paths ',(map search-path-specification->sexp
                                                 search-paths)
                           #:phases ,phases
+                          #:glib-or-gtk-wrap-excluded-outputs
+                           ,glib-or-gtk-wrap-excluded-outputs
                           #:configure-flags ,configure-flags
                           #:make-flags ,make-flags
                           #:out-of-source? ,out-of-source?
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index 78348e9cf7..4bba7167ca 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -86,6 +86,8 @@ prepended to the name."
               arguments)))
       (inputs
         (map rewrite (package-inputs p)))
+      (propagated-inputs
+        (map rewrite (package-propagated-inputs p)))
       (native-inputs
         (map rewrite (package-native-inputs p))))))
 
diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
index 10ef3c8d0f..0cff28b45b 100644
--- a/guix/build/emacs-utils.scm
+++ b/guix/build/emacs-utils.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
   #:export (%emacs
             emacs-batch-eval
             emacs-batch-edit-file
+            emacs-generate-autoloads
             emacs-substitute-sexps
             emacs-substitute-variables))
 
@@ -47,6 +49,14 @@
                           (format #f "--eval=~S" expr)))
     (error "emacs-batch-edit-file failed!" file expr)))
 
+(define (emacs-generate-autoloads name directory)
+  "Generate autoloads for Emacs package NAME placed in DIRECTORY."
+  (let* ((file (string-append directory "/" name "-autoloads.el"))
+         (expr `(let ((backup-inhibited t)
+                      (generated-autoload-file ,file))
+                  (update-directory-autoloads ,directory))))
+    (emacs-batch-eval expr)))
+
 (define-syntax emacs-substitute-sexps
   (syntax-rules ()
     "Substitute the S-expression immediately following the first occurrence of
diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm
index 1d87a4cf27..9351a70a0e 100644
--- a/guix/build/glib-or-gtk-build-system.scm
+++ b/guix/build/glib-or-gtk-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:export (%standard-phases
             glib-or-gtk-build))
 
@@ -36,14 +38,14 @@
 
 (define (directory-included? directory directories-list)
   "Is DIRECTORY included in DIRECTORIES-LIST?"
-  (fold (lambda (s p) (or (string-ci=? s directory) p)) 
+  (fold (lambda (s p) (or (string-ci=? s directory) p))
         #f directories-list))
 
 (define (gtk-module-directories inputs)
   "Check for the existence of \"libdir/gtk-v.0\" in INPUTS.  Return a list
 with all found directories."
-  (let* ((version 
-          (if (string-match "gtk\\+-3" 
+  (let* ((version
+          (if (string-match "gtk\\+-3"
                             (or (assoc-ref inputs "gtk+")
                                 (assoc-ref inputs "source")
                                 "gtk+-3")) ; we default to version 3
@@ -54,7 +56,7 @@ with all found directories."
             (let* ((in (match input
                          ((_ . dir) dir)
                          (_ "")))
-                   (libdir 
+                   (libdir
                     (string-append in "/lib/gtk-" version)))
               (if (and (directory-exists? libdir)
                        (not (directory-included? libdir prev)))
@@ -77,49 +79,68 @@ a list with all found directories."
 
   (fold glib-schemas '() inputs))
 
-(define* (wrap-all-programs #:key inputs outputs #:allow-other-keys)
+(define* (wrap-all-programs #:key inputs outputs
+                            (glib-or-gtk-wrap-excluded-outputs '())
+                            #:allow-other-keys)
   "Implement phase \"glib-or-gtk-wrap\": look for GSettings schemas and
 gtk+-v.0 libraries and create wrappers with suitably set environment variables
-if found."
-  (let* ((out (assoc-ref outputs "out"))
-         (bindir (string-append out "/bin"))
-         (bin-list (find-files bindir ".*"))
-         (schemas (schemas-directories (acons "out" out inputs)))
-         (schemas-env-var 
-          (if (not (null? schemas))
-              `("XDG_DATA_DIRS" ":" prefix ,schemas)
-              #f))
-         (gtk-mod-dirs (gtk-module-directories (acons "out" out inputs)))
-         (gtk-mod-env-var 
-          (if (not (null? gtk-mod-dirs))
-              `("GTK_PATH" ":" prefix ,gtk-mod-dirs)
-              #f)))
-    (cond
-     ((and schemas-env-var gtk-mod-env-var)
-      (map (lambda (prog) 
-             (wrap-program prog schemas-env-var gtk-mod-env-var))
-           bin-list))
-     (schemas-env-var
-      (map (lambda (prog) (wrap-program prog schemas-env-var)) bin-list))
-     (gtk-mod-env-var
-      (map (lambda (prog) (wrap-program prog gtk-mod-env-var)) bin-list)))))
+if found.
 
-(define* (compile-glib-schemas #:key inputs outputs #:allow-other-keys)
+Wrapping is not applied to outputs whose name is listed in
+GLIB-OR-GTK-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
+to contain any GLib or GTK+ binaries, and where wrapping would gratuitously
+add a dependency of that output on GLib and GTK+."
+  (define handle-output
+    (match-lambda
+     ((output . directory)
+      (unless (member output glib-or-gtk-wrap-excluded-outputs)
+        (let* ((bindir       (string-append directory "/bin"))
+               (bin-list     (find-files bindir ".*"))
+               (schemas      (schemas-directories
+                              (alist-cons output directory inputs)))
+               (gtk-mod-dirs (gtk-module-directories
+                              (alist-cons output directory inputs)))
+               (schemas-env-var
+                (if (not (null? schemas))
+                    `("XDG_DATA_DIRS" ":" prefix ,schemas)
+                    #f))
+               (gtk-mod-env-var
+                (if (not (null? gtk-mod-dirs))
+                    `("GTK_PATH" ":" prefix ,gtk-mod-dirs)
+                    #f)))
+          (cond
+           ((and schemas-env-var gtk-mod-env-var)
+            (for-each (cut wrap-program <> schemas-env-var gtk-mod-env-var)
+                      bin-list))
+           (schemas-env-var
+            (for-each (cut wrap-program <> schemas-env-var)
+                      bin-list))
+           (gtk-mod-env-var
+            (for-each (cut wrap-program <> gtk-mod-env-var)
+                      bin-list))))))))
+
+  (for-each handle-output outputs)
+  #t)
+
+(define* (compile-glib-schemas #:key outputs #:allow-other-keys)
   "Implement phase \"glib-or-gtk-compile-schemas\": compile \"glib\" schemas
 if needed."
-  (let* ((out (assoc-ref outputs "out"))
-         (schemasdir (string-append out "/share/glib-2.0/schemas")))
-    (if (and (directory-exists? schemasdir)
-             (not (file-exists? 
-                   (string-append schemasdir "/gschemas.compiled"))))
-        (system* "glib-compile-schemas" schemasdir)
-        #t)))
+  (every (match-lambda
+          ((output . directory)
+           (let ((schemasdir (string-append directory
+                                            "/share/glib-2.0/schemas")))
+             (if (and (directory-exists? schemasdir)
+                      (not (file-exists?
+                            (string-append schemasdir "/gschemas.compiled"))))
+                 (zero? (system* "glib-compile-schemas" schemasdir))
+                 #t))))
+         outputs))
 
 (define %standard-phases
   (alist-cons-after
-   'install 'glib-or-gtk-wrap wrap-all-programs 
-   (alist-cons-after 
-    'install 'glib-or-gtk-compile-schemas compile-glib-schemas 
+   'install 'glib-or-gtk-wrap wrap-all-programs
+   (alist-cons-after
+    'install 'glib-or-gtk-compile-schemas compile-glib-schemas
     gnu:%standard-phases)))
 
 (define* (glib-or-gtk-build #:key inputs (phases %standard-phases)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index b1ba573190..69cef1a4cd 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -37,6 +37,7 @@
             derivation-inputs
             derivation-sources
             derivation-system
+            derivation-builder
             derivation-builder-arguments
             derivation-builder-environment-vars
             derivation-file-name
diff --git a/guix/download.scm b/guix/download.scm
index 947da004ae..4c111dd2b5 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -61,15 +61,23 @@
        ,@(map (cut string-append <> "/gcc") gnu-mirrors))
       (gnupg
        "ftp://gd.tuwien.ac.at/privacy/gnupg/"
-       "ftp://gnupg.x-zone.org/pub/gnupg/"
-       "ftp://ftp.gnupg.cz/pub/gcrypt/"
-       "ftp://sunsite.dk/pub/security/gcrypt/"
-       "http://gnupg.wildyou.net/"
-       "http://ftp.gnupg.zone-h.org/"
-       "ftp://ftp.jyu.fi/pub/crypt/gcrypt/"
-       "ftp://trumpetti.atm.tut.fi/gcrypt/"
+       "ftp://mirrors.dotsrc.org/gcrypt/"
        "ftp://mirror.cict.fr/gnupg/"
-       "ftp://ftp.strasbourg.linuxfr.org/pub/gnupg/")
+       "http://artfiles.org/gnupg.org"
+       "ftp://ftp.franken.de/pub/crypt/mirror/ftp.gnupg.org/gcrypt/"
+       "ftp://ftp.freenet.de/pub/ftp.gnupg.org/gcrypt/"
+       "http://www.crysys.hu/"
+       "ftp://ftp.hi.is/pub/mirrors/gnupg/"
+       "ftp://ftp.heanet.ie/mirrors/ftp.gnupg.org/gcrypt/"
+       "ftp://ftp.bit.nl/mirror/gnupg/"
+       "ftp://ftp.surfnet.nl/pub/security/gnupg/"
+       "ftp://ftp.iasi.roedu.net/pub/mirrors/ftp.gnupg.org/"
+       "ftp://ftp.sunet.se/pub/security/gnupg/"
+       "ftp://mirror.switch.ch/mirror/gnupg/"
+       "ftp://mirror.tje.me.uk/pub/mirrors/ftp.gnupg.org/"
+       "ftp://ftp.mirrorservice.org/sites/ftp.gnupg.org/gcrypt/"
+       "ftp://ftp.ring.gr.jp/pub/net/gnupg/"
+       "ftp://ftp.gnupg.org/gcrypt/")
       (gnome
        "http://ftp.belnet.be/ftp.gnome.org/"
        "http://ftp.linux.org.uk/mirrors/ftp.gnome.org/"
diff --git a/guix/elf.scm b/guix/elf.scm
new file mode 100644
index 0000000000..a4b0e819a5
--- /dev/null
+++ b/guix/elf.scm
@@ -0,0 +1,1045 @@
+;;; Guile ELF reader and writer
+
+;; Copyright (C)  2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+;;;
+;;; This file was taken from the Guile 2.1 branch, where it is known as
+;;; (system vm elf), and renamed to (guix elf).  It will be unneeded when Guix
+;;; switches to Guile 2.1/2.2.
+;;;
+;;; A module to read and write Executable and Linking Format (ELF)
+;;; files.
+;;;
+;;; This module exports a number of record types that represent the
+;;; various parts that make up ELF files.  Fundamentally this is the
+;;; main header, the segment headers (program headers), and the section
+;;; headers.  It also exports bindings for symbolic constants and
+;;; utilities to parse and write special kinds of ELF sections.
+;;;
+;;; See elf(5) for more information on ELF.
+;;;
+;;; Code:
+
+(define-module (guix elf)
+  #:use-module (rnrs bytevectors)
+  #:use-module (system foreign)
+  #:use-module (system base target)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 vlist)
+  #:export (has-elf-header?
+
+            (make-elf* . make-elf)
+            elf?
+            elf-bytes elf-word-size elf-byte-order
+            elf-abi elf-type elf-machine-type
+            elf-entry elf-phoff elf-shoff elf-flags elf-ehsize
+            elf-phentsize elf-phnum elf-shentsize elf-shnum elf-shstrndx
+
+            ELFOSABI_NONE ELFOSABI_HPUX ELFOSABI_NETBSD ELFOSABI_GNU
+            ELFOSABI_SOLARIS ELFOSABI_AIX ELFOSABI_IRIX ELFOSABI_FREEBSD
+            ELFOSABI_TRU64 ELFOSABI_MODESTO ELFOSABI_OPENBSD
+            ELFOSABI_ARM_AEABI ELFOSABI_ARM ELFOSABI_STANDALONE
+
+            ET_NONE ET_REL ET_EXEC ET_DYN ET_CORE
+
+            EM_NONE EM_SPARC EM_386 EM_MIPS EM_PPC EM_PPC64 EM_ARM EM_SH
+            EM_SPARCV9 EM_IA_64 EM_X86_64
+
+            elf-header-len elf-header-shoff-offset
+            write-elf-header
+
+            (make-elf-segment* . make-elf-segment)
+            elf-segment?
+            elf-segment-index
+            elf-segment-type elf-segment-offset elf-segment-vaddr
+            elf-segment-paddr elf-segment-filesz elf-segment-memsz
+            elf-segment-flags elf-segment-align
+
+            elf-program-header-len write-elf-program-header
+
+            PT_NULL PT_LOAD PT_DYNAMIC PT_INTERP PT_NOTE PT_SHLIB
+            PT_PHDR PT_TLS PT_NUM PT_LOOS PT_GNU_EH_FRAME PT_GNU_STACK
+            PT_GNU_RELRO
+
+            PF_R PF_W PF_X
+
+            (make-elf-section* . make-elf-section)
+            elf-section?
+            elf-section-index
+            elf-section-name elf-section-type elf-section-flags
+            elf-section-addr elf-section-offset elf-section-size
+            elf-section-link elf-section-info elf-section-addralign
+            elf-section-entsize
+
+            elf-section-header-len elf-section-header-addr-offset
+            elf-section-header-offset-offset
+            write-elf-section-header
+
+            (make-elf-symbol* . make-elf-symbol)
+            elf-symbol?
+            elf-symbol-name elf-symbol-value elf-symbol-size
+            elf-symbol-info elf-symbol-other elf-symbol-shndx
+            elf-symbol-binding elf-symbol-type elf-symbol-visibility
+
+            elf-symbol-len elf-symbol-value-offset write-elf-symbol
+
+            SHN_UNDEF
+
+            SHT_NULL SHT_PROGBITS SHT_SYMTAB SHT_STRTAB SHT_RELA
+            SHT_HASH SHT_DYNAMIC SHT_NOTE SHT_NOBITS SHT_REL SHT_SHLIB
+            SHT_DYNSYM SHT_INIT_ARRAY SHT_FINI_ARRAY SHT_PREINIT_ARRAY
+            SHT_GROUP SHT_SYMTAB_SHNDX SHT_NUM SHT_LOOS SHT_HIOS
+            SHT_LOPROC SHT_HIPROC SHT_LOUSER SHT_HIUSER
+
+            SHF_WRITE SHF_ALLOC SHF_EXECINSTR SHF_MERGE SHF_STRINGS
+            SHF_INFO_LINK SHF_LINK_ORDER SHF_OS_NONCONFORMING SHF_GROUP
+            SHF_TLS
+
+            DT_NULL DT_NEEDED DT_PLTRELSZ DT_PLTGOT DT_HASH DT_STRTAB
+            DT_SYMTAB DT_RELA DT_RELASZ DT_RELAENT DT_STRSZ DT_SYMENT
+            DT_INIT DT_FINI DT_SONAME DT_RPATH DT_SYMBOLIC DT_REL
+            DT_RELSZ DT_RELENT DT_PLTREL DT_DEBUG DT_TEXTREL DT_JMPREL
+            DT_BIND_NOW DT_INIT_ARRAY DT_FINI_ARRAY DT_INIT_ARRAYSZ
+            DT_FINI_ARRAYSZ DT_RUNPATH DT_FLAGS DT_ENCODING
+            DT_PREINIT_ARRAY DT_PREINIT_ARRAYSZ DT_NUM DT_LOGUILE
+            DT_GUILE_GC_ROOT DT_GUILE_GC_ROOT_SZ DT_GUILE_ENTRY
+            DT_GUILE_VM_VERSION DT_GUILE_FRAME_MAPS DT_HIGUILE
+            DT_LOOS DT_HIOS DT_LOPROC DT_HIPROC
+
+            string-table-ref
+
+            STB_LOCAL STB_GLOBAL STB_WEAK STB_NUM STB_LOOS STB_GNU
+            STB_HIOS STB_LOPROC STB_HIPROC
+
+            STT_NOTYPE STT_OBJECT STT_FUNC STT_SECTION STT_FILE
+            STT_COMMON STT_TLS STT_NUM STT_LOOS STT_GNU STT_HIOS
+            STT_LOPROC STT_HIPROC
+
+            STV_DEFAULT STV_INTERNAL STV_HIDDEN STV_PROTECTED
+
+            NT_GNU_ABI_TAG NT_GNU_HWCAP NT_GNU_BUILD_ID NT_GNU_GOLD_VERSION
+
+            parse-elf
+            elf-segment elf-segments
+            elf-section elf-sections elf-section-by-name elf-sections-by-name
+            elf-symbol-table-len elf-symbol-table-ref
+
+            parse-elf-note
+            elf-note-name elf-note-desc elf-note-type))
+
+;; #define EI_NIDENT 16
+
+;; typedef struct {
+;;     unsigned char e_ident[EI_NIDENT];
+;;     uint16_t      e_type;
+;;     uint16_t      e_machine;
+;;     uint32_t      e_version;
+;;     ElfN_Addr     e_entry;
+;;     ElfN_Off      e_phoff;
+;;     ElfN_Off      e_shoff;
+;;     uint32_t      e_flags;
+;;     uint16_t      e_ehsize;
+;;     uint16_t      e_phentsize;
+;;     uint16_t      e_phnum;
+;;     uint16_t      e_shentsize;
+;;     uint16_t      e_shnum;
+;;     uint16_t      e_shstrndx;
+;; } ElfN_Ehdr;
+
+(define elf32-header-len 52)
+(define elf64-header-len 64)
+(define (elf-header-len word-size)
+  (case word-size
+    ((4) elf32-header-len)
+    ((8) elf64-header-len)
+    (else (error "invalid word size" word-size))))
+(define (elf-header-shoff-offset word-size)
+  (case word-size
+    ((4) 32)
+    ((8) 40)
+    (else (error "bad word size" word-size))))
+
+(define ELFCLASS32      1)              ; 32-bit objects
+(define ELFCLASS64      2)              ; 64-bit objects
+
+(define ELFDATA2LSB     1)              ; 2's complement, little endian
+(define ELFDATA2MSB     2)              ; 2's complement, big endian
+
+(define EV_CURRENT      1)              ; Current version
+
+(define ELFOSABI_NONE		0)	; UNIX System V ABI */
+(define ELFOSABI_HPUX		1)	; HP-UX
+(define ELFOSABI_NETBSD		2)	; NetBSD.
+(define ELFOSABI_GNU		3)	; Object uses GNU ELF extensions.
+(define ELFOSABI_SOLARIS	6)	; Sun Solaris.
+(define ELFOSABI_AIX		7)	; IBM AIX.
+(define ELFOSABI_IRIX		8)	; SGI Irix.
+(define ELFOSABI_FREEBSD	9)	; FreeBSD.
+(define ELFOSABI_TRU64		10)	; Compaq TRU64 UNIX.
+(define ELFOSABI_MODESTO	11)	; Novell Modesto.
+(define ELFOSABI_OPENBSD	12)	; OpenBSD.
+(define ELFOSABI_ARM_AEABI	64)	; ARM EABI
+(define ELFOSABI_ARM		97)	; ARM
+(define ELFOSABI_STANDALONE     255)    ; Standalone (embedded) application
+
+(define ET_NONE		0)		; No file type
+(define ET_REL		1)		; Relocatable file
+(define ET_EXEC		2)		; Executable file
+(define ET_DYN		3)		; Shared object file
+(define ET_CORE		4)		; Core file
+
+;;
+;; Machine types
+;;
+;; Just a sampling of these values.  We could include more, but the
+;; important thing is to recognize architectures for which we have a
+;; native compiler.  Recognizing more common machine types is icing on
+;; the cake.
+;; 
+(define EM_NONE          0)             ; No machine
+(define EM_SPARC         2)             ; SUN SPARC
+(define EM_386           3)             ; Intel 80386
+(define EM_MIPS          8)             ; MIPS R3000 big-endian
+(define EM_PPC          20)             ; PowerPC
+(define EM_PPC64        21)             ; PowerPC 64-bit
+(define EM_ARM          40)             ; ARM
+(define EM_SH           42)             ; Hitachi SH
+(define EM_SPARCV9      43)             ; SPARC v9 64-bit
+(define EM_IA_64        50)             ; Intel Merced
+(define EM_X86_64       62)             ; AMD x86-64 architecture
+
+(define cpu-mapping (make-hash-table))
+(for-each (lambda (pair)
+            (hashq-set! cpu-mapping (car pair) (cdr pair)))
+          `((none . ,EM_NONE)
+            (sparc . ,EM_SPARC) ; FIXME: map 64-bit to SPARCV9 ?
+            (i386 . ,EM_386)
+            (mips . ,EM_MIPS)
+            (ppc . ,EM_PPC)
+            (ppc64 . ,EM_PPC64)
+            (arm . ,EM_ARM) ; FIXME: there are more arm cpu variants
+            (sh . ,EM_SH) ; FIXME: there are more sh cpu variants
+            (ia64 . ,EM_IA_64)
+            (x86_64 . ,EM_X86_64)))
+
+(define SHN_UNDEF 0)
+
+(define host-machine-type
+  (hashq-ref cpu-mapping
+             (string->symbol (car (string-split %host-type #\-)))
+             EM_NONE))
+
+(define host-word-size
+  (sizeof '*))
+
+(define host-byte-order
+  (native-endianness))
+
+(define (has-elf-header? bv)
+  (and
+   ;; e_ident
+   (>= (bytevector-length bv) 16)
+   (= (bytevector-u8-ref bv 0) #x7f)
+   (= (bytevector-u8-ref bv 1) (char->integer #\E))
+   (= (bytevector-u8-ref bv 2) (char->integer #\L))
+   (= (bytevector-u8-ref bv 3) (char->integer #\F))
+   (cond
+    ((= (bytevector-u8-ref bv 4) ELFCLASS32)
+     (>= (bytevector-length bv) elf32-header-len))
+    ((= (bytevector-u8-ref bv 4) ELFCLASS64)
+     (>= (bytevector-length bv) elf64-header-len))
+    (else #f))
+   (or (= (bytevector-u8-ref bv 5) ELFDATA2LSB)
+       (= (bytevector-u8-ref bv 5) ELFDATA2MSB))
+   (= (bytevector-u8-ref bv 6) EV_CURRENT)
+   ;; Look at ABI later.
+   (= (bytevector-u8-ref bv 8) 0)       ; ABI version
+   ;; The rest of the e_ident is padding.
+
+   ;; e_version
+   (let ((byte-order (if (= (bytevector-u8-ref bv 5) ELFDATA2LSB)
+                         (endianness little)
+                         (endianness big))))
+     (= (bytevector-u32-ref bv 20 byte-order) EV_CURRENT))))
+
+(define-record-type <elf>
+  (make-elf bytes word-size byte-order abi type machine-type
+            entry phoff shoff flags ehsize
+            phentsize phnum shentsize shnum shstrndx)
+  elf?
+  (bytes elf-bytes)
+  (word-size elf-word-size)
+  (byte-order elf-byte-order)
+  (abi elf-abi)
+  (type elf-type)
+  (machine-type elf-machine-type)
+  (entry elf-entry)
+  (phoff elf-phoff)
+  (shoff elf-shoff)
+  (flags elf-flags)
+  (ehsize elf-ehsize)
+  (phentsize elf-phentsize)
+  (phnum elf-phnum)
+  (shentsize elf-shentsize)
+  (shnum elf-shnum)
+  (shstrndx elf-shstrndx))
+
+(define* (make-elf* #:key (bytes #f)
+                    (byte-order (target-endianness))
+                    (word-size (target-word-size))
+                    (abi ELFOSABI_STANDALONE)
+                    (type ET_DYN)
+                    (machine-type EM_NONE)
+                    (entry 0)
+                    (phoff (elf-header-len word-size))
+                    (shoff -1)
+                    (flags 0)
+                    (ehsize (elf-header-len word-size))
+                    (phentsize (elf-program-header-len word-size))
+                    (phnum 0)
+                    (shentsize (elf-section-header-len word-size))
+                    (shnum 0)
+                    (shstrndx SHN_UNDEF))
+  (make-elf bytes word-size byte-order abi type machine-type
+            entry phoff shoff flags ehsize
+            phentsize phnum shentsize shnum shstrndx))
+
+(define (parse-elf32 bv byte-order)
+  (make-elf bv 4 byte-order
+            (bytevector-u8-ref bv 7)
+            (bytevector-u16-ref bv 16 byte-order)
+            (bytevector-u16-ref bv 18 byte-order)
+            (bytevector-u32-ref bv 24 byte-order)
+            (bytevector-u32-ref bv 28 byte-order)
+            (bytevector-u32-ref bv 32 byte-order)
+            (bytevector-u32-ref bv 36 byte-order)
+            (bytevector-u16-ref bv 40 byte-order)
+            (bytevector-u16-ref bv 42 byte-order)
+            (bytevector-u16-ref bv 44 byte-order)
+            (bytevector-u16-ref bv 46 byte-order)
+            (bytevector-u16-ref bv 48 byte-order)
+            (bytevector-u16-ref bv 50 byte-order)))
+
+(define (write-elf-ident bv class data abi)
+  (bytevector-u8-set! bv 0 #x7f)
+  (bytevector-u8-set! bv 1 (char->integer #\E))
+  (bytevector-u8-set! bv 2 (char->integer #\L))
+  (bytevector-u8-set! bv 3 (char->integer #\F))
+  (bytevector-u8-set! bv 4 class)
+  (bytevector-u8-set! bv 5 data)
+  (bytevector-u8-set! bv 6 EV_CURRENT)
+  (bytevector-u8-set! bv 7 abi)
+  (bytevector-u8-set! bv 8 0) ; ABI version
+  (bytevector-u8-set! bv 9 0) ; Pad to 16 bytes.
+  (bytevector-u8-set! bv 10 0)
+  (bytevector-u8-set! bv 11 0)
+  (bytevector-u8-set! bv 12 0)
+  (bytevector-u8-set! bv 13 0)
+  (bytevector-u8-set! bv 14 0)
+  (bytevector-u8-set! bv 15 0))
+
+(define (write-elf32-header bv elf)
+  (let ((byte-order (elf-byte-order elf)))
+    (write-elf-ident bv ELFCLASS32
+                     (case byte-order
+                       ((little) ELFDATA2LSB)
+                       ((big) ELFDATA2MSB)
+                       (else (error "unknown endianness" byte-order)))
+                     (elf-abi elf))
+    (bytevector-u16-set! bv 16 (elf-type elf) byte-order)
+    (bytevector-u16-set! bv 18 (elf-machine-type elf) byte-order)
+    (bytevector-u32-set! bv 20 EV_CURRENT byte-order)
+    (bytevector-u32-set! bv 24 (elf-entry elf) byte-order)
+    (bytevector-u32-set! bv 28 (elf-phoff elf) byte-order)
+    (bytevector-u32-set! bv 32 (elf-shoff elf) byte-order)
+    (bytevector-u32-set! bv 36 (elf-flags elf) byte-order)
+    (bytevector-u16-set! bv 40 (elf-ehsize elf) byte-order)
+    (bytevector-u16-set! bv 42 (elf-phentsize elf) byte-order)
+    (bytevector-u16-set! bv 44 (elf-phnum elf) byte-order)
+    (bytevector-u16-set! bv 46 (elf-shentsize elf) byte-order)
+    (bytevector-u16-set! bv 48 (elf-shnum elf) byte-order)
+    (bytevector-u16-set! bv 50 (elf-shstrndx elf) byte-order)))
+
+(define (parse-elf64 bv byte-order)
+  (make-elf bv 8 byte-order
+            (bytevector-u8-ref bv 7)
+            (bytevector-u16-ref bv 16 byte-order)
+            (bytevector-u16-ref bv 18 byte-order)
+            (bytevector-u64-ref bv 24 byte-order)
+            (bytevector-u64-ref bv 32 byte-order)
+            (bytevector-u64-ref bv 40 byte-order)
+            (bytevector-u32-ref bv 48 byte-order)
+            (bytevector-u16-ref bv 52 byte-order)
+            (bytevector-u16-ref bv 54 byte-order)
+            (bytevector-u16-ref bv 56 byte-order)
+            (bytevector-u16-ref bv 58 byte-order)
+            (bytevector-u16-ref bv 60 byte-order)
+            (bytevector-u16-ref bv 62 byte-order)))
+
+(define (write-elf64-header bv elf)
+  (let ((byte-order (elf-byte-order elf)))
+    (write-elf-ident bv ELFCLASS64
+                     (case byte-order
+                       ((little) ELFDATA2LSB)
+                       ((big) ELFDATA2MSB)
+                       (else (error "unknown endianness" byte-order)))
+                     (elf-abi elf))
+    (bytevector-u16-set! bv 16 (elf-type elf) byte-order)
+    (bytevector-u16-set! bv 18 (elf-machine-type elf) byte-order)
+    (bytevector-u32-set! bv 20 EV_CURRENT byte-order)
+    (bytevector-u64-set! bv 24 (elf-entry elf) byte-order)
+    (bytevector-u64-set! bv 32 (elf-phoff elf) byte-order)
+    (bytevector-u64-set! bv 40 (elf-shoff elf) byte-order)
+    (bytevector-u32-set! bv 48 (elf-flags elf) byte-order)
+    (bytevector-u16-set! bv 52 (elf-ehsize elf) byte-order)
+    (bytevector-u16-set! bv 54 (elf-phentsize elf) byte-order)
+    (bytevector-u16-set! bv 56 (elf-phnum elf) byte-order)
+    (bytevector-u16-set! bv 58 (elf-shentsize elf) byte-order)
+    (bytevector-u16-set! bv 60 (elf-shnum elf) byte-order)
+    (bytevector-u16-set! bv 62 (elf-shstrndx elf) byte-order)))
+
+(define (parse-elf bv)
+  (cond
+   ((has-elf-header? bv)
+    (let ((class (bytevector-u8-ref bv 4))
+          (byte-order (let ((data (bytevector-u8-ref bv 5)))
+                        (cond
+                         ((= data ELFDATA2LSB) (endianness little))
+                         ((= data ELFDATA2MSB) (endianness big))
+                         (else (error "unhandled byte order" data))))))
+      (cond
+       ((= class ELFCLASS32) (parse-elf32 bv byte-order))
+       ((= class ELFCLASS64) (parse-elf64 bv byte-order))
+       (else (error "unhandled class" class)))))
+   (else
+    (error "Invalid ELF" bv))))
+
+(define* (write-elf-header bv elf)
+  ((case (elf-word-size elf)
+     ((4) write-elf32-header)
+     ((8) write-elf64-header)
+     (else (error "unknown word size" (elf-word-size elf))))
+   bv elf))
+
+;;
+;; Segment types
+;;
+(define PT_NULL         0)              ; Program header table entry unused
+(define PT_LOAD         1)              ; Loadable program segment
+(define PT_DYNAMIC      2)              ; Dynamic linking information
+(define PT_INTERP       3)              ; Program interpreter
+(define PT_NOTE         4)              ; Auxiliary information
+(define PT_SHLIB        5)              ; Reserved
+(define PT_PHDR         6)              ; Entry for header table itself
+(define PT_TLS          7)              ; Thread-local storage segment
+(define PT_NUM          8)              ; Number of defined types
+(define PT_LOOS         #x60000000)     ; Start of OS-specific
+(define PT_GNU_EH_FRAME #x6474e550)     ; GCC .eh_frame_hdr segment
+(define PT_GNU_STACK    #x6474e551)     ; Indicates stack executability
+(define PT_GNU_RELRO    #x6474e552)     ; Read-only after relocation
+
+;;
+;; Segment flags
+;;
+(define PF_X            (ash 1 0))      ; Segment is executable
+(define PF_W            (ash 1 1))      ; Segment is writable
+(define PF_R            (ash 1 2))      ; Segment is readable
+
+(define-record-type <elf-segment>
+  (make-elf-segment index type offset vaddr paddr filesz memsz flags align)
+  elf-segment?
+  (index elf-segment-index)
+  (type elf-segment-type)
+  (offset elf-segment-offset)
+  (vaddr elf-segment-vaddr)
+  (paddr elf-segment-paddr)
+  (filesz elf-segment-filesz)
+  (memsz elf-segment-memsz)
+  (flags elf-segment-flags)
+  (align elf-segment-align))
+
+(define* (make-elf-segment* #:key (index -1) (type PT_LOAD) (offset 0) (vaddr 0)
+                            (paddr 0) (filesz 0) (memsz filesz)
+                            (flags (logior PF_W PF_R))
+                            (align 8))
+  (make-elf-segment index type offset vaddr paddr filesz memsz flags align))
+
+;; typedef struct {
+;;     uint32_t   p_type;
+;;     Elf32_Off  p_offset;
+;;     Elf32_Addr p_vaddr;
+;;     Elf32_Addr p_paddr;
+;;     uint32_t   p_filesz;
+;;     uint32_t   p_memsz;
+;;     uint32_t   p_flags;
+;;     uint32_t   p_align;
+;; } Elf32_Phdr;
+
+(define (parse-elf32-program-header index bv offset byte-order)
+  (if (<= (+ offset 32) (bytevector-length bv))
+      (make-elf-segment index
+                        (bytevector-u32-ref bv offset byte-order)
+                        (bytevector-u32-ref bv (+ offset 4) byte-order)
+                        (bytevector-u32-ref bv (+ offset 8) byte-order)
+                        (bytevector-u32-ref bv (+ offset 12) byte-order)
+                        (bytevector-u32-ref bv (+ offset 16) byte-order)
+                        (bytevector-u32-ref bv (+ offset 20) byte-order)
+                        (bytevector-u32-ref bv (+ offset 24) byte-order)
+                        (bytevector-u32-ref bv (+ offset 28) byte-order))
+      (error "corrupt ELF (offset out of range)" offset)))
+
+(define (write-elf32-program-header bv offset byte-order seg)
+  (bytevector-u32-set! bv offset (elf-segment-type seg) byte-order)
+  (bytevector-u32-set! bv (+ offset 4) (elf-segment-offset seg) byte-order)
+  (bytevector-u32-set! bv (+ offset 8) (elf-segment-vaddr seg) byte-order)
+  (bytevector-u32-set! bv (+ offset 12) (elf-segment-paddr seg) byte-order)
+  (bytevector-u32-set! bv (+ offset 16) (elf-segment-filesz seg) byte-order)
+  (bytevector-u32-set! bv (+ offset 20) (elf-segment-memsz seg) byte-order)
+  (bytevector-u32-set! bv (+ offset 24) (elf-segment-flags seg) byte-order)
+  (bytevector-u32-set! bv (+ offset 28) (elf-segment-align seg) byte-order))
+
+
+;; typedef struct {
+;;     uint32_t   p_type;
+;;     uint32_t   p_flags;
+;;     Elf64_Off  p_offset;
+;;     Elf64_Addr p_vaddr;
+;;     Elf64_Addr p_paddr;
+;;     uint64_t   p_filesz;
+;;     uint64_t   p_memsz;
+;;     uint64_t   p_align;
+;; } Elf64_Phdr;
+
+;; NB: position of `flags' is different!
+
+(define (parse-elf64-program-header index bv offset byte-order)
+  (if (<= (+ offset 56) (bytevector-length bv))
+      (make-elf-segment index
+                        (bytevector-u32-ref bv offset byte-order)
+                        (bytevector-u64-ref bv (+ offset 8) byte-order)
+                        (bytevector-u64-ref bv (+ offset 16) byte-order)
+                        (bytevector-u64-ref bv (+ offset 24) byte-order)
+                        (bytevector-u64-ref bv (+ offset 32) byte-order)
+                        (bytevector-u64-ref bv (+ offset 40) byte-order)
+                        (bytevector-u32-ref bv (+ offset 4) byte-order)
+                        (bytevector-u64-ref bv (+ offset 48) byte-order))
+      (error "corrupt ELF (offset out of range)" offset)))
+
+(define (write-elf64-program-header bv offset byte-order seg)
+  (bytevector-u32-set! bv offset (elf-segment-type seg) byte-order)
+  (bytevector-u64-set! bv (+ offset 8) (elf-segment-offset seg) byte-order)
+  (bytevector-u64-set! bv (+ offset 16) (elf-segment-vaddr seg) byte-order)
+  (bytevector-u64-set! bv (+ offset 24) (elf-segment-paddr seg) byte-order)
+  (bytevector-u64-set! bv (+ offset 32) (elf-segment-filesz seg) byte-order)
+  (bytevector-u64-set! bv (+ offset 40) (elf-segment-memsz seg) byte-order)
+  (bytevector-u32-set! bv (+ offset 4) (elf-segment-flags seg) byte-order)
+  (bytevector-u64-set! bv (+ offset 48) (elf-segment-align seg) byte-order))
+
+(define (write-elf-program-header bv offset byte-order word-size seg)
+  ((case word-size
+     ((4) write-elf32-program-header)
+     ((8) write-elf64-program-header)
+     (else (error "invalid word size" word-size)))
+   bv offset byte-order seg))
+
+(define (elf-program-header-len word-size)
+  (case word-size
+    ((4) 32)
+    ((8) 56)
+    (else (error "bad word size" word-size))))
+
+(define (elf-segment elf n)
+  (if (not (< -1 n (elf-phnum elf)))
+      (error "bad segment number" n))
+  ((case (elf-word-size elf)
+     ((4) parse-elf32-program-header)
+     ((8) parse-elf64-program-header)
+     (else (error "unhandled pointer size")))
+   (elf-bytes elf)
+   (+ (elf-phoff elf) (* n (elf-phentsize elf)))
+   (elf-byte-order elf)))
+
+(define (elf-segments elf)
+  (let lp ((n (elf-phnum elf)) (out '()))
+    (if (zero? n)
+        out
+        (lp (1- n) (cons (elf-segment elf (1- n)) out)))))
+
+(define-record-type <elf-section>
+  (make-elf-section index name type flags
+                    addr offset size link info addralign entsize)
+  elf-section?
+  (index elf-section-index)
+  (name elf-section-name)
+  (type elf-section-type)
+  (flags elf-section-flags)
+  (addr elf-section-addr)
+  (offset elf-section-offset)
+  (size elf-section-size)
+  (link elf-section-link)
+  (info elf-section-info)
+  (addralign elf-section-addralign)
+  (entsize elf-section-entsize))
+
+(define* (make-elf-section* #:key (index SHN_UNDEF) (name 0) (type SHT_PROGBITS)
+                            (flags SHF_ALLOC) (addr 0) (offset 0) (size 0)
+                            (link 0) (info 0) (addralign 8) (entsize 0))
+  (make-elf-section index name type flags addr offset size link info addralign
+                    entsize))
+
+;; typedef struct {
+;;     uint32_t   sh_name;
+;;     uint32_t   sh_type;
+;;     uint32_t   sh_flags;
+;;     Elf32_Addr sh_addr;
+;;     Elf32_Off  sh_offset;
+;;     uint32_t   sh_size;
+;;     uint32_t   sh_link;
+;;     uint32_t   sh_info;
+;;     uint32_t   sh_addralign;
+;;     uint32_t   sh_entsize;
+;; } Elf32_Shdr;
+
+(define (parse-elf32-section-header index bv offset byte-order)
+  (if (<= (+ offset 40) (bytevector-length bv))
+      (make-elf-section index
+                        (bytevector-u32-ref bv offset byte-order)
+                        (bytevector-u32-ref bv (+ offset 4) byte-order)
+                        (bytevector-u32-ref bv (+ offset 8) byte-order)
+                        (bytevector-u32-ref bv (+ offset 12) byte-order)
+                        (bytevector-u32-ref bv (+ offset 16) byte-order)
+                        (bytevector-u32-ref bv (+ offset 20) byte-order)
+                        (bytevector-u32-ref bv (+ offset 24) byte-order)
+                        (bytevector-u32-ref bv (+ offset 28) byte-order)
+                        (bytevector-u32-ref bv (+ offset 32) byte-order)
+                        (bytevector-u32-ref bv (+ offset 36) byte-order))
+      (error "corrupt ELF (offset out of range)" offset)))
+
+(define (write-elf32-section-header bv offset byte-order sec)
+  (bytevector-u32-set! bv offset (elf-section-name sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 4) (elf-section-type sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 8) (elf-section-flags sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 12) (elf-section-addr sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 16) (elf-section-offset sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 20) (elf-section-size sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 24) (elf-section-link sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 28) (elf-section-info sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 32) (elf-section-addralign sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 36) (elf-section-entsize sec) byte-order))
+
+
+;; typedef struct {
+;;     uint32_t   sh_name;
+;;     uint32_t   sh_type;
+;;     uint64_t   sh_flags;
+;;     Elf64_Addr sh_addr;
+;;     Elf64_Off  sh_offset;
+;;     uint64_t   sh_size;
+;;     uint32_t   sh_link;
+;;     uint32_t   sh_info;
+;;     uint64_t   sh_addralign;
+;;     uint64_t   sh_entsize;
+;; } Elf64_Shdr;
+
+(define (elf-section-header-len word-size)
+  (case word-size
+    ((4) 40)
+    ((8) 64)
+    (else (error "bad word size" word-size))))
+
+(define (elf-section-header-addr-offset word-size)
+  (case word-size
+    ((4) 12)
+    ((8) 16)
+    (else (error "bad word size" word-size))))
+
+(define (elf-section-header-offset-offset word-size)
+  (case word-size
+    ((4) 16)
+    ((8) 24)
+    (else (error "bad word size" word-size))))
+
+(define (parse-elf64-section-header index bv offset byte-order)
+  (if (<= (+ offset 64) (bytevector-length bv))
+      (make-elf-section index
+                        (bytevector-u32-ref bv offset byte-order)
+                        (bytevector-u32-ref bv (+ offset 4) byte-order)
+                        (bytevector-u64-ref bv (+ offset 8) byte-order)
+                        (bytevector-u64-ref bv (+ offset 16) byte-order)
+                        (bytevector-u64-ref bv (+ offset 24) byte-order)
+                        (bytevector-u64-ref bv (+ offset 32) byte-order)
+                        (bytevector-u32-ref bv (+ offset 40) byte-order)
+                        (bytevector-u32-ref bv (+ offset 44) byte-order)
+                        (bytevector-u64-ref bv (+ offset 48) byte-order)
+                        (bytevector-u64-ref bv (+ offset 56) byte-order))
+      (error "corrupt ELF (offset out of range)" offset)))
+
+(define (write-elf64-section-header bv offset byte-order sec)
+  (bytevector-u32-set! bv offset (elf-section-name sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 4) (elf-section-type sec) byte-order)
+  (bytevector-u64-set! bv (+ offset 8) (elf-section-flags sec) byte-order)
+  (bytevector-u64-set! bv (+ offset 16) (elf-section-addr sec) byte-order)
+  (bytevector-u64-set! bv (+ offset 24) (elf-section-offset sec) byte-order)
+  (bytevector-u64-set! bv (+ offset 32) (elf-section-size sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 40) (elf-section-link sec) byte-order)
+  (bytevector-u32-set! bv (+ offset 44) (elf-section-info sec) byte-order)
+  (bytevector-u64-set! bv (+ offset 48) (elf-section-addralign sec) byte-order)
+  (bytevector-u64-set! bv (+ offset 56) (elf-section-entsize sec) byte-order))
+
+(define (elf-section elf n)
+  (if (not (< -1 n (elf-shnum elf)))
+      (error "bad section number" n))
+  ((case (elf-word-size elf)
+     ((4) parse-elf32-section-header)
+     ((8) parse-elf64-section-header)
+     (else (error "unhandled pointer size")))
+   n
+   (elf-bytes elf)
+   (+ (elf-shoff elf) (* n (elf-shentsize elf)))
+   (elf-byte-order elf)))
+
+(define (write-elf-section-header bv offset byte-order word-size sec)
+  ((case word-size
+     ((4) write-elf32-section-header)
+     ((8) write-elf64-section-header)
+     (else (error "invalid word size" word-size)))
+   bv offset byte-order sec))
+
+(define (elf-sections elf)
+  (let lp ((n (elf-shnum elf)) (out '()))
+    (if (zero? n)
+        out
+        (lp (1- n) (cons (elf-section elf (1- n)) out)))))
+
+;;
+;; Section Types
+;;
+(define SHT_NULL          0)            ; Section header table entry unused
+(define SHT_PROGBITS      1)            ; Program data
+(define SHT_SYMTAB        2)            ; Symbol table
+(define SHT_STRTAB        3)            ; String table
+(define SHT_RELA          4)            ; Relocation entries with addends
+(define SHT_HASH          5)            ; Symbol hash table
+(define SHT_DYNAMIC       6)            ; Dynamic linking information
+(define SHT_NOTE          7)            ; Notes
+(define SHT_NOBITS        8)            ; Program space with no data (bss)
+(define SHT_REL           9)            ; Relocation entries, no addends
+(define SHT_SHLIB         10)           ; Reserved
+(define SHT_DYNSYM        11)           ; Dynamic linker symbol table
+(define SHT_INIT_ARRAY    14)           ; Array of constructors
+(define SHT_FINI_ARRAY    15)           ; Array of destructors
+(define SHT_PREINIT_ARRAY 16)           ; Array of pre-constructors
+(define SHT_GROUP         17)           ; Section group
+(define SHT_SYMTAB_SHNDX  18)           ; Extended section indeces
+(define SHT_NUM           19)           ; Number of defined types. 
+(define SHT_LOOS          #x60000000)   ; Start OS-specific. 
+(define SHT_HIOS          #x6fffffff)   ; End OS-specific type
+(define SHT_LOPROC        #x70000000)   ; Start of processor-specific
+(define SHT_HIPROC        #x7fffffff)   ; End of processor-specific
+(define SHT_LOUSER        #x80000000)   ; Start of application-specific
+(define SHT_HIUSER        #x8fffffff)   ; End of application-specific
+
+;;
+;; Section Flags
+;;
+(define SHF_WRITE            (ash 1 0)) ; Writable
+(define SHF_ALLOC            (ash 1 1)) ; Occupies memory during execution
+(define SHF_EXECINSTR        (ash 1 2)) ; Executable
+(define SHF_MERGE            (ash 1 4)) ; Might be merged
+(define SHF_STRINGS          (ash 1 5)) ; Contains nul-terminated strings
+(define SHF_INFO_LINK        (ash 1 6)) ; `sh_info' contains SHT index
+(define SHF_LINK_ORDER       (ash 1 7)) ; Preserve order after combining
+(define SHF_OS_NONCONFORMING (ash 1 8)) ; Non-standard OS specific handling required
+(define SHF_GROUP            (ash 1 9)) ; Section is member of a group. 
+(define SHF_TLS              (ash 1 10)) ; Section hold thread-local data. 
+
+;;
+;; Dynamic entry types.  The DT_GUILE types are non-standard.
+;;
+(define DT_NULL		0)		; Marks end of dynamic section
+(define DT_NEEDED	1)		; Name of needed library
+(define DT_PLTRELSZ	2)		; Size in bytes of PLT relocs
+(define DT_PLTGOT	3)		; Processor defined value
+(define DT_HASH		4)		; Address of symbol hash table
+(define DT_STRTAB	5)		; Address of string table
+(define DT_SYMTAB	6)		; Address of symbol table
+(define DT_RELA		7)		; Address of Rela relocs
+(define DT_RELASZ	8)		; Total size of Rela relocs
+(define DT_RELAENT	9)		; Size of one Rela reloc
+(define DT_STRSZ	10)		; Size of string table
+(define DT_SYMENT	11)		; Size of one symbol table entry
+(define DT_INIT		12)		; Address of init function
+(define DT_FINI		13)		; Address of termination function
+(define DT_SONAME	14)		; Name of shared object
+(define DT_RPATH	15)		; Library search path (deprecated)
+(define DT_SYMBOLIC	16)		; Start symbol search here
+(define DT_REL		17)		; Address of Rel relocs
+(define DT_RELSZ	18)		; Total size of Rel relocs
+(define DT_RELENT	19)		; Size of one Rel reloc
+(define DT_PLTREL	20)		; Type of reloc in PLT
+(define DT_DEBUG	21)		; For debugging ; unspecified
+(define DT_TEXTREL	22)		; Reloc might modify .text
+(define DT_JMPREL	23)		; Address of PLT relocs
+(define	DT_BIND_NOW	24)		; Process relocations of object
+(define	DT_INIT_ARRAY	25)		; Array with addresses of init fct
+(define	DT_FINI_ARRAY	26)		; Array with addresses of fini fct
+(define	DT_INIT_ARRAYSZ	27)		; Size in bytes of DT_INIT_ARRAY
+(define	DT_FINI_ARRAYSZ	28)		; Size in bytes of DT_FINI_ARRAY
+(define DT_RUNPATH	29)		; Library search path
+(define DT_FLAGS	30)		; Flags for the object being loaded
+(define DT_ENCODING	32)		; Start of encoded range
+(define DT_PREINIT_ARRAY 32)		; Array with addresses of preinit fc
+(define DT_PREINIT_ARRAYSZ 33)		; size in bytes of DT_PREINIT_ARRAY
+(define	DT_NUM		34)		; Number used
+(define DT_LOGUILE      #x37146000)     ; Start of Guile-specific
+(define DT_GUILE_GC_ROOT    #x37146000) ; Offset of GC roots
+(define DT_GUILE_GC_ROOT_SZ #x37146001) ; Size in machine words of GC roots
+(define DT_GUILE_ENTRY      #x37146002) ; Address of entry thunk
+(define DT_GUILE_VM_VERSION #x37146003) ; Bytecode version
+(define DT_GUILE_FRAME_MAPS #x37146004) ; Offset of .guile.frame-maps
+(define DT_HIGUILE      #x37146fff)     ; End of Guile-specific
+(define DT_LOOS		#x6000000d)	; Start of OS-specific
+(define DT_HIOS		#x6ffff000)	; End of OS-specific
+(define DT_LOPROC	#x70000000)	; Start of processor-specific
+(define DT_HIPROC	#x7fffffff)	; End of processor-specific
+
+
+(define (string-table-ref bv offset)
+  (let lp ((end offset))
+    (if (zero? (bytevector-u8-ref bv end))
+        (let ((out (make-bytevector (- end offset))))
+          (bytevector-copy! bv offset out 0 (- end offset))
+          (utf8->string out))
+        (lp (1+ end)))))
+
+(define (elf-section-by-name elf name)
+  (let ((off (elf-section-offset (elf-section elf (elf-shstrndx elf)))))
+    (let lp ((n (elf-shnum elf)))
+      (and (> n 0)
+           (let ((section (elf-section elf (1- n))))
+             (if (equal? (string-table-ref (elf-bytes elf)
+                                           (+ off (elf-section-name section)))
+                         name)
+                 section
+                 (lp (1- n))))))))
+
+(define (elf-sections-by-name elf)
+  (let* ((sections (elf-sections elf))
+         (off (elf-section-offset (list-ref sections (elf-shstrndx elf)))))
+    (map (lambda (section)
+           (cons (string-table-ref (elf-bytes elf)
+                                   (+ off (elf-section-name section)))
+                 section))
+         sections)))
+
+(define-record-type <elf-symbol>
+  (make-elf-symbol name value size info other shndx)
+  elf-symbol?
+  (name elf-symbol-name)
+  (value elf-symbol-value)
+  (size elf-symbol-size)
+  (info elf-symbol-info)
+  (other elf-symbol-other)
+  (shndx elf-symbol-shndx))
+
+(define* (make-elf-symbol* #:key (name 0) (value 0) (size 0)
+                           (binding STB_LOCAL) (type STT_NOTYPE)
+                           (info (logior (ash binding 4) type))
+                           (visibility STV_DEFAULT) (other visibility)
+                           (shndx SHN_UNDEF))
+  (make-elf-symbol name value size info other shndx))
+
+;; typedef struct {
+;;     uint32_t      st_name;
+;;     Elf32_Addr    st_value;
+;;     uint32_t      st_size;
+;;     unsigned char st_info;
+;;     unsigned char st_other;
+;;     uint16_t      st_shndx;
+;; } Elf32_Sym;
+
+(define (elf-symbol-len word-size)
+  (case word-size
+    ((4) 16)
+    ((8) 24)
+    (else (error "bad word size" word-size))))
+
+(define (elf-symbol-value-offset word-size)
+  (case word-size
+    ((4) 4)
+    ((8) 8)
+    (else (error "bad word size" word-size))))
+
+(define (parse-elf32-symbol bv offset stroff byte-order)
+  (if (<= (+ offset 16) (bytevector-length bv))
+      (make-elf-symbol (let ((name (bytevector-u32-ref bv offset byte-order)))
+                         (if stroff
+                             (string-table-ref bv (+ stroff name))
+                             name))
+                       (bytevector-u32-ref bv (+ offset 4) byte-order)
+                       (bytevector-u32-ref bv (+ offset 8) byte-order)
+                       (bytevector-u8-ref bv (+ offset 12))
+                       (bytevector-u8-ref bv (+ offset 13))
+                       (bytevector-u16-ref bv (+ offset 14) byte-order))
+      (error "corrupt ELF (offset out of range)" offset)))
+
+(define (write-elf32-symbol bv offset byte-order sym)
+  (bytevector-u32-set! bv offset (elf-symbol-name sym) byte-order)
+  (bytevector-u32-set! bv (+ offset 4) (elf-symbol-value sym) byte-order)
+  (bytevector-u32-set! bv (+ offset 8) (elf-symbol-size sym) byte-order)
+  (bytevector-u8-set! bv (+ offset 12) (elf-symbol-info sym))
+  (bytevector-u8-set! bv (+ offset 13) (elf-symbol-other sym))
+  (bytevector-u16-set! bv (+ offset 14) (elf-symbol-shndx sym) byte-order))
+
+;; typedef struct {
+;;     uint32_t      st_name;
+;;     unsigned char st_info;
+;;     unsigned char st_other;
+;;     uint16_t      st_shndx;
+;;     Elf64_Addr    st_value;
+;;     uint64_t      st_size;
+;; } Elf64_Sym;
+
+(define (parse-elf64-symbol bv offset stroff byte-order)
+  (if (<= (+ offset 24) (bytevector-length bv))
+      (make-elf-symbol (let ((name (bytevector-u32-ref bv offset byte-order)))
+                         (if stroff
+                             (string-table-ref bv (+ stroff name))
+                             name))
+                       (bytevector-u64-ref bv (+ offset 8) byte-order)
+                       (bytevector-u64-ref bv (+ offset 16) byte-order)
+                       (bytevector-u8-ref bv (+ offset 4))
+                       (bytevector-u8-ref bv (+ offset 5))
+                       (bytevector-u16-ref bv (+ offset 6) byte-order))
+      (error "corrupt ELF (offset out of range)" offset)))
+
+(define (write-elf64-symbol bv offset byte-order sym)
+  (bytevector-u32-set! bv offset (elf-symbol-name sym) byte-order)
+  (bytevector-u8-set! bv (+ offset 4) (elf-symbol-info sym))
+  (bytevector-u8-set! bv (+ offset 5) (elf-symbol-other sym))
+  (bytevector-u16-set! bv (+ offset 6) (elf-symbol-shndx sym) byte-order)
+  (bytevector-u64-set! bv (+ offset 8) (elf-symbol-value sym) byte-order)
+  (bytevector-u64-set! bv (+ offset 16) (elf-symbol-size sym) byte-order))
+
+(define (write-elf-symbol bv offset byte-order word-size sym)
+  ((case word-size
+     ((4) write-elf32-symbol)
+     ((8) write-elf64-symbol)
+     (else (error "invalid word size" word-size)))
+   bv offset byte-order sym))
+
+(define (elf-symbol-table-len section)
+  (let ((len (elf-section-size section))
+        (entsize (elf-section-entsize section)))
+    (unless (and (not (zero? entsize)) (zero? (modulo len entsize)))
+      (error "bad symbol table" section))
+    (/ len entsize)))
+
+(define* (elf-symbol-table-ref elf section n #:optional strtab)
+  (let ((bv (elf-bytes elf))
+        (byte-order (elf-byte-order elf))
+        (stroff (and strtab (elf-section-offset strtab)))
+        (base (elf-section-offset section))
+        (len (elf-section-size section))
+        (entsize (elf-section-entsize section)))
+    (unless (<= (* (1+ n) entsize) len)
+      (error "out of range symbol table access" section n))
+    (case (elf-word-size elf)
+      ((4)
+       (unless (<= 16 entsize)
+         (error "bad entsize for symbol table" section))
+       (parse-elf32-symbol bv (+ base (* n entsize)) stroff byte-order))
+      ((8)
+       (unless (<= 24 entsize)
+         (error "bad entsize for symbol table" section))
+       (parse-elf64-symbol bv (+ base (* n entsize)) stroff byte-order))
+      (else (error "bad word size" elf)))))
+
+;; Legal values for ST_BIND subfield of st_info (symbol binding).
+
+(define STB_LOCAL	0)		; Local symbol
+(define STB_GLOBAL	1)		; Global symbol
+(define STB_WEAK	2)		; Weak symbol
+(define STB_NUM		3)		; Number of defined types. 
+(define STB_LOOS	10)		; Start of OS-specific
+(define STB_GNU_UNIQUE	10)		; Unique symbol. 
+(define STB_HIOS	12)		; End of OS-specific
+(define STB_LOPROC	13)		; Start of processor-specific
+(define STB_HIPROC	15)		; End of processor-specific
+
+;; Legal values for ST_TYPE subfield of st_info (symbol type).
+
+(define STT_NOTYPE	0)		; Symbol type is unspecified
+(define STT_OBJECT	1)		; Symbol is a data object
+(define STT_FUNC	2)		; Symbol is a code object
+(define STT_SECTION	3)		; Symbol associated with a section
+(define STT_FILE	4)		; Symbol's name is file name
+(define STT_COMMON	5)		; Symbol is a common data object
+(define STT_TLS		6)		; Symbol is thread-local data objec
+(define STT_NUM		7)		; Number of defined types. 
+(define STT_LOOS	10)		; Start of OS-specific
+(define STT_GNU_IFUNC	10)		; Symbol is indirect code object
+(define STT_HIOS	12)		; End of OS-specific
+(define STT_LOPROC	13)		; Start of processor-specific
+(define STT_HIPROC	15)		; End of processor-specific
+
+;; Symbol visibility specification encoded in the st_other field.
+
+(define STV_DEFAULT	0)		; Default symbol visibility rules
+(define STV_INTERNAL	1)		; Processor specific hidden class
+(define STV_HIDDEN	2)		; Sym unavailable in other modules
+(define STV_PROTECTED	3)		; Not preemptible, not exported
+
+(define (elf-symbol-binding sym)
+  (ash (elf-symbol-info sym) -4))
+
+(define (elf-symbol-type sym)
+  (logand (elf-symbol-info sym) #xf))
+
+(define (elf-symbol-visibility sym)
+  (logand (elf-symbol-other sym) #x3))
+
+(define NT_GNU_ABI_TAG 1)
+(define NT_GNU_HWCAP 2)
+(define NT_GNU_BUILD_ID 3)
+(define NT_GNU_GOLD_VERSION 4)
+
+(define-record-type <elf-note>
+  (make-elf-note name desc type)
+  elf-note?
+  (name elf-note-name)
+  (desc elf-note-desc)
+  (type elf-note-type))
+
+(define (parse-elf-note elf section)
+  (let ((bv (elf-bytes elf))
+        (byte-order (elf-byte-order elf))
+        (offset (elf-section-offset section)))
+    (unless (<= (+ offset 12) (bytevector-length bv))
+      (error "corrupt ELF (offset out of range)" offset))
+    (let ((namesz (bytevector-u32-ref bv offset byte-order))
+          (descsz (bytevector-u32-ref bv (+ offset 4) byte-order))
+          (type (bytevector-u32-ref bv (+ offset 8) byte-order)))
+      (unless (<= (+ offset 12 namesz descsz) (bytevector-length bv))
+        (error "corrupt ELF (offset out of range)" offset))
+      (let ((name (make-bytevector (1- namesz)))
+            (desc (make-bytevector descsz)))
+        (bytevector-copy! bv (+ offset 12) name 0 (1- namesz))
+        (bytevector-copy! bv (+ offset 12 namesz) desc 0 descsz)
+        (make-elf-note (utf8->string name) desc type)))))
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index ee84446549..0528e9f253 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -233,12 +233,14 @@ stored."
      (values "ftp.gnu.org" (string-append "/gnu/" project)))))
 
 (define (sans-extension tarball)
-  "Return TARBALL without its .tar.* extension."
-  (let ((end (string-contains tarball ".tar")))
+  "Return TARBALL without its .tar.* or .zip extension."
+  (let ((end (or (string-contains tarball ".tar")
+                 (string-contains tarball ".zip"))))
     (substring tarball 0 end)))
 
 (define %tarball-rx
-  (make-regexp "^(.+)-([0-9]|[^-])*(-src)?\\.tar\\."))
+  ;; Note: .zip files are notably used for freefont-ttf.
+  (make-regexp "^(.+)-([0-9]|[^-])*(-src)?\\.(tar\\.|zip$)"))
 
 (define %alpha-tarball-rx
   (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
diff --git a/guix/import/gnu.scm b/guix/import/gnu.scm
index 763b8d2a12..1947f489fb 100644
--- a/guix/import/gnu.scm
+++ b/guix/import/gnu.scm
@@ -84,7 +84,7 @@
                                      ,(string-append ".tar." archive-type)))
                  (sha256
                   (base32
-                   ,(bytevector->base32-string (file-sha256 tarball))))))
+                   ,(bytevector->nix-base32-string (file-sha256 tarball))))))
        (build-system gnu-build-system)
        (synopsis ,(gnu-package-doc-summary package))
        (description ,(gnu-package-doc-description package))
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 3a21f4f5cf..86f3ae4e82 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -40,7 +40,8 @@
             ibmpl1.0
             imlib2
             lgpl2.0 lgpl2.0+ lgpl2.1 lgpl2.1+ lgpl3 lgpl3+
-            mpl2.0
+            mpl1.1 mpl2.0
+            ncsa
             openldap2.8 openssl
             psfl public-domain
             qpl
@@ -239,11 +240,21 @@ which may be a file:// URI pointing the package's tree."
            "https://www.gnu.org/licenses/lgpl.html"
            "https://www.gnu.org/licenses/license-list#LGPLv3"))
 
+(define mpl1.1
+  (license "MPL 1.1"
+           "http://directory.fsf.org/wiki/License:MPLv1.1"
+           "https://www.gnu.org/licenses/license-list#MPL"))
+
 (define mpl2.0
   (license "MPL 2.0"
            "http://directory.fsf.org/wiki/License:MPLv2.0"
            "https://www.gnu.org/licenses/license-list#MPL-2.0"))
 
+(define ncsa
+  (license "NCSA/University of Illinois Open Source License"
+           "http://directory.fsf.org/wiki/License:IllinoisNCSA"
+           "https://www.gnu.org/licenses/license-list#NCSA"))
+
 (define openssl
   (license "OpenSSL"
            "http://directory.fsf.org/wiki/License:OpenSSL"
diff --git a/guix/monads.scm b/guix/monads.scm
index b419ba066a..65683e65de 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -39,7 +39,9 @@
             mlet
             mlet*
             mbegin
-            lift1 lift2 lift3 lift4 lift5 lift6 lift7 lift
+            mwhen
+            munless
+            lift0 lift1 lift2 lift3 lift4 lift5 lift6 lift7 lift
             listm
             foldm
             mapm
@@ -173,9 +175,15 @@ form is (VAR -> VAL), bind VAR to the non-monadic value VAL in the same way as
                body ...)))))))
 
 (define-syntax mbegin
-  (syntax-rules ()
+  (syntax-rules (%current-monad)
     "Bind the given monadic expressions in sequence, returning the result of
 the last one."
+    ((_ %current-monad mexp)
+     mexp)
+    ((_ %current-monad mexp rest ...)
+     (>>= mexp
+          (lambda (unused-value)
+            (mbegin %current-monad rest ...))))
     ((_ monad mexp)
      (with-monad monad
        mexp))
@@ -185,6 +193,26 @@ the last one."
             (lambda (unused-value)
               (mbegin monad rest ...)))))))
 
+(define-syntax mwhen
+  (syntax-rules ()
+    "When CONDITION is true, evaluate EXP0..EXP* as in an 'mbegin'.  When
+CONDITION is false, return *unspecified* in the current monad."
+    ((_ condition exp0 exp* ...)
+     (if condition
+         (mbegin %current-monad
+           exp0 exp* ...)
+         (return *unspecified*)))))
+
+(define-syntax munless
+  (syntax-rules ()
+    "When CONDITION is false, evaluate EXP0..EXP* as in an 'mbegin'.  When
+CONDITION is true, return *unspecified* in the current monad."
+    ((_ condition exp0 exp* ...)
+     (if condition
+         (return *unspecified*)
+         (mbegin %current-monad
+           exp0 exp* ...)))))
+
 (define-syntax define-lift
   (syntax-rules ()
     ((_ liftn (args ...))
@@ -194,6 +222,7 @@ the last one."
          (with-monad monad
            (return (proc args ...))))))))
 
+(define-lift lift0 ())
 (define-lift lift1 (a))
 (define-lift lift2 (a b))
 (define-lift lift3 (a b c))
diff --git a/guix/packages.scm b/guix/packages.scm
index 67a767106e..07f6d0ccbc 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -376,7 +376,7 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
                     (add-to-store store (basename patch) #t
                                   "sha256" patch))
                    ((? origin?)
-                    (package-source-derivation store patch)))))
+                    (package-source-derivation store patch system)))))
          (iota (length patches))
 
          patches))
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 84904e29da..781ffc5f58 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -293,6 +293,11 @@ the input port."
 (define (guix-archive . args)
   (define (parse-options)
     ;; Return the alist of option values.
+    (append (parse-options-from args)
+            (parse-options-from (environment-build-options))))
+
+  (define (parse-options-from args)
+    ;; Actual parsing takes place here.
     (args-fold* args %options
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 7b7f419f3a..26e9f42774 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -119,7 +119,9 @@ options handled by 'set-build-options-from-command-line', and listed in
   (display (_ "
       --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (_ "
-  -c, --cores=N          allow the use of up to N CPU cores for the build")))
+  -c, --cores=N          allow the use of up to N CPU cores for the build"))
+  (display (_ "
+  -M, --max-jobs=N       allow at most N build jobs")))
 
 (define (set-build-options-from-command-line store opts)
   "Given OPTS, an alist as returned by 'args-fold' given
@@ -128,6 +130,7 @@ options handled by 'set-build-options-from-command-line', and listed in
   (set-build-options store
                      #:keep-failed? (assoc-ref opts 'keep-failed?)
                      #:build-cores (or (assoc-ref opts 'cores) 0)
+                     #:max-build-jobs (or (assoc-ref opts 'max-jobs) 1)
                      #:fallback? (assoc-ref opts 'fallback?)
                      #:use-substitutes? (assoc-ref opts 'substitutes?)
                      #:use-build-hook? (assoc-ref opts 'build-hook?)
@@ -192,7 +195,15 @@ options handled by 'set-build-options-from-command-line', and listed in
                   (let ((c (false-if-exception (string->number arg))))
                     (if c
                         (apply values (alist-cons 'cores c result) rest)
-                        (leave (_ "~a: not a number~%") arg)))))))
+                        (leave (_ "not a number: '~a' option argument: ~a~%")
+                               name arg)))))
+        (option '(#\M "max-jobs") #t #f
+                (lambda (opt name arg result . rest)
+                  (let ((c (false-if-exception (string->number arg))))
+                    (if c
+                        (apply values (alist-cons 'max-jobs c result) rest)
+                        (leave (_ "not a number: '~a' option argument: ~a~%")
+                               name arg)))))))
 
 
 ;;;
@@ -390,6 +401,11 @@ arguments with packages that use the specified source."
 (define (guix-build . args)
   (define (parse-options)
     ;; Return the alist of option values.
+    (append (parse-options-from args)
+            (parse-options-from (environment-build-options))))
+
+  (define (parse-options-from args)
+    ;; Actual parsing takes place here.
     (args-fold* args %options
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 81bad963f6..c388b0c52c 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -213,6 +213,12 @@ packages."
 ;; Entry point.
 (define (guix-environment . args)
   (define (parse-options)
+    ;; Return the alist of option values.
+    (append (parse-options-from args)
+            (parse-options-from (environment-build-options))))
+
+  (define (parse-options-from args)
+    ;; Actual parsing takes place here.
     (args-fold* args %options
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 3a72053766..21dc66cb75 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -668,6 +668,11 @@ removed from MANIFEST."
 (define (guix-package . args)
   (define (parse-options)
     ;; Return the alist of option values.
+    (append (parse-options-from args)
+            (parse-options-from (environment-build-options))))
+
+  (define (parse-options-from args)
+    ;; Actual parsing takes place here.
     (args-fold* args %options
                 (lambda (opt name arg result arg-handler)
                   (leave (_ "~A: unrecognized option~%") name))
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index ddca76d370..9c96411630 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -175,7 +175,7 @@ to the caller without emitting an error message."
                            %fetch-timeout
                            0)
            (begin
-             (warning (_ "while fetching ~a: server is unresponsive~%")
+             (warning (_ "while fetching ~a: server is somewhat slow~%")
                       (uri->string uri))
              (warning (_ "try `--no-substitutes' if the problem persists~%"))
 
@@ -758,6 +758,10 @@ substituter disabled~%")
                                             progress)))
             ;; Unpack the Nar at INPUT into DESTINATION.
             (restore-file input destination)
+
+            ;; Skip a line after what 'progress-proc' printed.
+            (newline (current-error-port))
+
             (every (compose zero? cdr waitpid) pids))))
        (("--version")
         (show-version-and-exit "guix substitute-binary"))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 398a5a371b..27404772b7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -131,6 +131,27 @@ TARGET, and register them."
               (map (cut copy-item <> target #:log-port log-port)
                    to-copy))))
 
+(define (install-grub* grub.cfg device target)
+  "This is a variant of 'install-grub' with error handling, lifted in
+%STORE-MONAD"
+  (let* ((gc-root      (string-append %gc-roots-directory "/grub.cfg"))
+         (temp-gc-root (string-append gc-root ".new"))
+         (delete-file  (lift1 delete-file %store-monad))
+         (make-symlink (lift2 switch-symlinks %store-monad))
+         (rename       (lift2 rename-file %store-monad)))
+    (mbegin %store-monad
+      ;; Prepare the symlink to GRUB.CFG to make sure that it's a GC root when
+      ;; 'install-grub' completes (being a bit paranoid.)
+      (make-symlink temp-gc-root grub.cfg)
+
+      (munless (false-if-exception (install-grub grub.cfg device target))
+        (delete-file temp-gc-root)
+        (leave (_ "failed to install GRUB on device '~a'~%") device))
+
+      ;; Register GRUB.CFG as a GC root so that its dependencies (background
+      ;; image, font, etc.) are not reclaimed.
+      (rename temp-gc-root gc-root))))
+
 (define* (install os-drv target
                   #:key (log-port (current-output-port))
                   grub? grub.cfg device)
@@ -151,18 +172,19 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
             ;; Copy items to the new store.
             (copy-closure to-copy target #:log-port log-port)))))
 
-  (mlet* %store-monad ((os-dir -> (derivation->output-path os-drv))
-                       (%         (maybe-copy os-dir)))
+  (let ((os-dir   (derivation->output-path os-drv))
+        (format   (lift format %store-monad))
+        (populate (lift2 populate-root-file-system %store-monad)))
 
-    ;; Create a bunch of additional files.
-    (format log-port "populating '~a'...~%" target)
-    (populate-root-file-system os-dir target)
+    (mbegin %store-monad
+      (maybe-copy os-dir)
 
-    (when grub?
-      (unless (false-if-exception (install-grub grub.cfg device target))
-        (leave (_ "failed to install GRUB on device '~a'~%") device)))
+      ;; Create a bunch of additional files.
+      (format log-port "populating '~a'...~%" target)
+      (populate os-dir target)
 
-    (return #t)))
+      (mwhen grub?
+        (install-grub* grub.cfg device target)))))
 
 
 ;;;
@@ -334,14 +356,11 @@ boot directly to the kernel or to the bootloader."
 
           (case action
             ((reconfigure)
-             (mlet %store-monad ((% (switch-to-system os)))
-               (when grub?
-                 (unless (false-if-exception
-                          (install-grub (derivation->output-path grub.cfg)
-                                        device "/"))
-                   (leave (_ "failed to install GRUB on device '~a'~%")
-                          device)))
-               (return #t)))
+             (mbegin %store-monad
+               (switch-to-system os)
+               (mwhen grub?
+                 (install-grub* (derivation->output-path grub.cfg)
+                                device "/"))))
             ((init)
              (newline)
              (format #t (_ "initializing operating system under '~a'...~%")
@@ -467,6 +486,11 @@ Build the operating system declared in FILE according to ACTION.\n"))
 (define (guix-system . args)
   (define (parse-options)
     ;; Return the alist of option values.
+    (append (parse-options-from args)
+            (parse-options-from (environment-build-options))))
+
+  (define (parse-options-from args)
+    ;; Actual parsing takes place here.
     (args-fold* args %options
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
diff --git a/guix/store.scm b/guix/store.scm
index bc4c641583..571cc060d3 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -435,14 +435,14 @@ encoding conversion errors."
 (define* (set-build-options server
                             #:key keep-failed? keep-going? fallback?
                             (verbosity 0)
-                            (max-build-jobs (current-processor-count))
+                            (max-build-jobs 1)
                             timeout
                             (max-silent-time 3600)
                             (use-build-hook? #t)
                             (build-verbosity 0)
                             (log-type 0)
                             (print-build-trace #t)
-                            (build-cores 1)
+                            (build-cores (current-processor-count))
                             (use-substitutes? #t)
                             (binary-caches '())) ; client "untrusted" cache URLs
   ;; Must be called after `open-connection'.
diff --git a/guix/ui.scm b/guix/ui.scm
index 69b073da50..c77e04172e 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -64,6 +64,7 @@
             string->generations
             string->duration
             args-fold*
+            environment-build-options
             run-guix-command
             program-name
             guix-warning-port
@@ -712,6 +713,10 @@ reporting."
       (leave (_ "invalid argument: ~a~%")
              (apply format #f msg args)))))
 
+(define (environment-build-options)
+  "Return additional build options passed as environment variables."
+  (arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
+
 (define (show-guix-usage)
   (format (current-error-port)
           (_ "Try `guix --help' for more information.~%"))
diff --git a/guix/utils.scm b/guix/utils.scm
index 9b802b6fb3..d0d2e8a3d4 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -72,6 +72,7 @@
             package-name->name+version
             string-tokenize*
             string-replace-substring
+            arguments-from-environment-variable
             file-extension
             file-sans-extension
             call-with-temporary-output-file
@@ -627,6 +628,15 @@ REPLACEMENT."
                        (substring str start index)
                        pieces))))))))
 
+(define (arguments-from-environment-variable variable)
+  "Retrieve value of environment variable denoted by string VARIABLE in the
+form of a list of strings (`char-set:graphic' tokens) suitable for consumption
+by `args-fold', if VARIABLE is defined, otherwise return an empty list."
+  (let ((env (getenv variable)))
+    (if env
+        (string-tokenize env char-set:graphic)
+        '())))
+
 (define (call-with-temporary-output-file proc)
   "Call PROC with a name of a temporary file and open output port to that
 file; close the file and delete it when leaving the dynamic extent of this