Merge branch 'master' into core-updates

11 files changed, 568 insertions, 37 deletions

diff --git a/guix/build-system/android-ndk.scm b/guix/build-system/android-ndk.scm
new file mode 100644
index 0000000000..dbfa626a19
--- /dev/null
+++ b/guix/build-system/android-ndk.scm
@@ -0,0 +1,127 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build-system android-ndk)
+  #:use-module (guix search-paths)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system gnu)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-26)
+  #:export (android-ndk-build-system))
+
+(define %android-ndk-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build android-ndk-build-system)
+    (guix build syscalls)
+    ,@%gnu-build-system-modules))
+
+(define* (android-ndk-build store name inputs
+                      #:key
+                      (tests? #t)
+                      (test-target #f)
+                      (phases '(@ (guix build android-ndk-build-system)
+                                  %standard-phases))
+                      (outputs '("out"))
+                      (make-flags ''())
+                      (search-paths '())
+                      (system (%current-system))
+                      (guile #f)
+                      (imported-modules %android-ndk-build-system-modules)
+                      (modules '((guix build android-ndk-build-system)
+                                 (guix build utils))))
+  "Build SOURCE using Android NDK, and with INPUTS."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (android-ndk-build #:name ,name
+                    #:source ,(match (assoc-ref inputs "source")
+                                (((? derivation? source))
+                                 (derivation->output-path source))
+                                ((source)
+                                 source)
+                                (source
+                                 source))
+                    #:system ,system
+                    #:test-target ,test-target
+                    #:tests? ,tests?
+                    #:phases ,phases
+                    #:make-flags (cons* "-f"
+                                         ,(string-append
+                                          (derivation->output-path
+                                           (car (assoc-ref inputs "android-build")))
+                                          "/share/android/build/core/main.mk")
+                                         ,make-flags)
+                    #:outputs %outputs
+                    #:search-paths ',(map search-path-specification->sexp
+                                          search-paths)
+                    #:inputs %build-inputs)))
+
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system #:graft? #f))
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(gnu packages commencement)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system #:graft? #f)))))
+
+  (build-expression->derivation store name builder
+                                #:inputs inputs
+                                #:system system
+                                #:modules imported-modules
+                                #:outputs outputs
+                                #:guile-for-build guile-for-build))
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+
+  (define private-keywords
+    '(#:source #:target #:inputs #:native-inputs #:outputs))
+
+  (and (not target) ;; TODO: support cross-compilation
+       (bag
+         (name name)
+         (system system)
+         (target target)
+         (host-inputs `(,@(if source
+                              `(("source" ,source))
+                              '())
+                        ,@inputs
+
+                        ;; Keep the standard inputs of 'gnu-build-system'
+                        ,@(standard-packages)))
+         (build-inputs `(("android-build" ,(module-ref (resolve-interface '(gnu packages android)) 'android-make-stub))
+                         ("android-googletest" ,(module-ref (resolve-interface '(gnu packages android)) 'android-googletest))
+                         ,@native-inputs))
+         (outputs outputs)
+         (build android-ndk-build)
+         (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define android-ndk-build-system
+  (build-system
+    (name 'android-ndk)
+    (description
+     "Android NDK build system, to build Android NDK packages")
+    (lower lower)))
diff --git a/guix/build/android-ndk-build-system.scm b/guix/build/android-ndk-build-system.scm
new file mode 100644
index 0000000000..3c8f726d1d
--- /dev/null
+++ b/guix/build/android-ndk-build-system.scm
@@ -0,0 +1,88 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build android-ndk-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build syscalls)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (%standard-phases
+            android-ndk-build))
+
+;; Commentary:
+;;
+;; Builder-side code of the Android NDK build system.
+;;
+;; Code:
+
+(define* (configure #:key inputs outputs #:allow-other-keys)
+  (let ((library-directories (filter-map (match-lambda
+                                          ((name . path)
+                                           (if (eq? 'directory (stat:type (stat path)))
+                                               path
+                                               #f)))
+                                         inputs)))
+    (setenv "CC" "gcc")
+    (setenv "CXX" "g++")
+    (setenv "CPPFLAGS"
+     (string-join
+      (map (cut string-append "-I " <> "/include") library-directories)
+      " "))
+    (setenv "LDFLAGS"
+     (string-append "-L . "
+                    (string-join
+                     (map (lambda (x)
+                            (string-append "-L " x "/lib" " -Wl,-rpath=" x "/lib"))
+                          library-directories)
+                     " ")))
+    #t))
+
+(define* (install #:key inputs outputs (make-flags '()) #:allow-other-keys)
+  (let ((out (assoc-ref outputs "out")))
+    (apply invoke "make" "install"
+           (string-append "prefix=" out)
+           make-flags)
+    #t))
+
+(define* (check #:key target inputs outputs (tests? (not target)) (make-flags '()) #:allow-other-keys)
+  (if tests?
+      (begin
+        (apply invoke "make" "check" make-flags)
+        (when (and (file-exists? "tests") tests?)
+          (with-directory-excursion "tests"
+            (apply invoke "make" "check" make-flags))))
+      (format #t "test suite not run~%"))
+  #t)
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (replace 'configure configure)
+    (replace 'install install)
+    (replace 'check check)))
+
+(define* (android-ndk-build #:key inputs (phases %standard-phases)
+                            #:allow-other-keys #:rest args)
+  "Build the given Android NDK package, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index b4160fba1b..819688a913 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +24,7 @@
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 pretty-print)
+  #:re-export (symlink-relative)                  ;for convenience
   #:export (ensure-writable-directory
             build-profile))
 
@@ -129,12 +130,15 @@ instead make DIRECTORY a \"real\" directory containing symlinks."
             (apply throw args))))))
 
 (define* (build-profile output inputs
-                        #:key manifest search-paths)
-  "Build a user profile from INPUTS in directory OUTPUT.  Write MANIFEST, an
-sexp, to OUTPUT/manifest.  Create OUTPUT/etc/profile with Bash definitions for
--all the variables listed in SEARCH-PATHS."
+                        #:key manifest search-paths
+                        (symlink symlink))
+  "Build a user profile from INPUTS in directory OUTPUT, using SYMLINK to
+create symlinks.  Write MANIFEST, an sexp, to OUTPUT/manifest.  Create
+OUTPUT/etc/profile with Bash definitions for -all the variables listed in
+SEARCH-PATHS."
   ;; Make the symlinks.
   (union-build output inputs
+               #:symlink symlink
                #:log-port (%make-void-port "w"))
 
   ;; Store meta-data.
diff --git a/guix/build/union.scm b/guix/build/union.scm
index 1179f1234b..24b366af45 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -27,7 +27,10 @@
   #:use-module (rnrs io ports)
   #:export (union-build
 
-            warn-about-collision))
+            warn-about-collision
+
+            relative-file-name
+            symlink-relative))
 
 ;;; Commentary:
 ;;;
@@ -174,4 +177,47 @@ returns #f, skip the faulty file altogether."
 
   (union-of-directories output (delete-duplicates inputs)))
 
+
+;;;
+;;; Relative symlinks.
+;;;
+
+(define %not-slash
+  (char-set-complement (char-set #\/)))
+
+(define (relative-file-name reference file)
+  "Given REFERENCE and FILE, both of which are absolute file names, return the
+file name of FILE relative to REFERENCE.
+
+  (relative-file-name \"/gnu/store/foo\" \"/gnu/store/bin/bar\")
+  => \"../bin/bar\"
+
+Note that this is from a purely lexical standpoint; conversely, \"..\" is
+*not* resolved lexically on POSIX in the presence of symlinks."
+  (if (and (string-prefix? "/" file) (string-prefix? "/" reference))
+      (let loop ((reference (string-tokenize reference %not-slash))
+                 (file      (string-tokenize file %not-slash)))
+        (define (finish)
+          (string-join (append (make-list (length reference) "..") file)
+                       "/"))
+
+        (match reference
+          (()
+           (finish))
+          ((head . tail)
+           (match file
+             (()
+              (finish))
+             ((head* . tail*)
+              (if (string=? head head*)
+                  (loop tail tail*)
+                  (finish)))))))
+      file))
+
+(define (symlink-relative old new)
+  "Assuming both OLD and NEW are absolute file names, make NEW a symlink to
+OLD, but using a relative file name."
+  (symlink (relative-file-name (dirname new) old)
+           new))
+
 ;;; union.scm ends here
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 5ffe505be1..c6d70e4e36 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -664,7 +664,9 @@ The other arguments are as for 'derivation'."
                                      (imported-modules %modules
                                                        #:system system
                                                        #:module-path module-path
-                                                       #:guile guile-for-build)
+                                                       #:guile guile-for-build
+                                                       #:deprecation-warnings
+                                                       deprecation-warnings)
                                      (return #f)))
                        (compiled (if (pair? %modules)
                                      (compiled-modules %modules
@@ -974,7 +976,15 @@ environment."
 (define* (imported-files files
                          #:key (name "file-import")
                          (system (%current-system))
-                         (guile (%guile-for-build)))
+                         (guile (%guile-for-build))
+
+                         ;; XXX: The only reason we have
+                         ;; #:deprecation-warnings is because (guix build
+                         ;; utils), which we use here, relies on _IO*, which
+                         ;; is deprecated in 2.2.  On the next full-rebuild
+                         ;; cycle, we should disable such warnings
+                         ;; unconditionally.
+                         (deprecation-warnings #f))
   "Return a derivation that imports FILES into STORE.  FILES must be a list
 of (FINAL-PATH . FILE) pairs.  Each FILE is mapped to FINAL-PATH in the
 resulting store path.  FILE can be either a file name, or a file-like object,
@@ -1010,13 +1020,25 @@ as returned by 'local-file' for example."
     (gexp->derivation name build
                       #:system system
                       #:guile-for-build guile
-                      #:local-build? #t)))
+                      #:local-build? #t
+
+                      ;; TODO: On the next rebuild cycle, set to "no"
+                      ;; unconditionally.
+                      #:env-vars
+                      (case deprecation-warnings
+                        ((#f)
+                         '(("GUILE_WARN_DEPRECATED" . "no")))
+                        ((detailed)
+                         '(("GUILE_WARN_DEPRECATED" . "detailed")))
+                        (else
+                         '())))))
 
 (define* (imported-modules modules
                            #:key (name "module-import")
                            (system (%current-system))
                            (guile (%guile-for-build))
-                           (module-path %load-path))
+                           (module-path %load-path)
+                           (deprecation-warnings #f))
   "Return a derivation that contains the source files of MODULES, a list of
 module names such as `(ice-9 q)'.  All of MODULES must be either names of
 modules to be found in the MODULE-PATH search path, or a module name followed
@@ -1041,7 +1063,8 @@ last one is created from the given <scheme-file> object."
                                    (cons f (search-path* module-path f))))))
                              modules)))
     (imported-files files #:name name #:system system
-                    #:guile guile)))
+                    #:guile guile
+                    #:deprecation-warnings deprecation-warnings)))
 
 (define* (compiled-modules modules
                            #:key (name "module-import-compiled")
@@ -1058,7 +1081,9 @@ they can refer to each other."
                                                  #:system system
                                                  #:guile guile
                                                  #:module-path
-                                                 module-path)))
+                                                 module-path
+                                                 #:deprecation-warnings
+                                                 deprecation-warnings)))
     (define build
       (gexp
        (begin
diff --git a/guix/packages.scm b/guix/packages.scm
index ab4b6278d6..a6f9936d63 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -388,10 +388,11 @@ object."
 (define-condition-type &package-cross-build-system-error &package-error
   package-cross-build-system-error?)
 
-
-(define (package-full-name package)
-  "Return the full name of PACKAGE--i.e., `NAME-VERSION'."
-  (string-append (package-name package) "-" (package-version package)))
+(define* (package-full-name package #:optional (delimiter "@"))
+  "Return the full name of PACKAGE--i.e., `NAME@VERSION'.  By specifying
+DELIMITER (a string), you can customize what will appear between the name and
+the version.  By default, DELIMITER is \"@\"."
+  (string-append (package-name package) delimiter (package-version package)))
 
 (define (%standard-patch-inputs)
   (let* ((canonical (module-ref (resolve-interface '(gnu packages base))
@@ -945,6 +946,10 @@ and return it."
               (($ <package> name version source build-system
                             args inputs propagated-inputs native-inputs
                             self-native-input? outputs)
+               ;; Even though we prefer to use "@" to separate the package
+               ;; name from the package version in various user-facing parts
+               ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
+               ;; prohibits the use of "@", so use "-" instead.
                (or (make-bag build-system (string-append name "-" version)
                              #:system system
                              #:target target
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 95dc9746bd..dca2479769 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -168,7 +168,7 @@
   (version      manifest-entry-version)           ; string
   (output       manifest-entry-output             ; string
                 (default "out"))
-  (item         manifest-entry-item)              ; package | store path
+  (item         manifest-entry-item)              ; package | file-like | store path
   (dependencies manifest-entry-dependencies       ; <manifest-entry>*
                 (default '()))
   (search-paths manifest-entry-search-paths       ; search-path-specification*
@@ -318,7 +318,7 @@ denoting a specific output of a package."
                  (propagated-inputs #$(map entry->gexp deps))
                  (search-paths #$(map search-path-specification->sexp
                                       search-paths))))
-      (($ <manifest-entry> name version output (? package? package)
+      (($ <manifest-entry> name version output package
                            (deps ...) (search-paths ...))
        #~(#$name #$version #$output
                  (ungexp package (or output "out"))
@@ -671,7 +671,13 @@ if not found."
             (return (find-among-inputs inputs)))))
         ((? string? item)
          (mlet %store-monad ((refs (references* item)))
-           (return (find-among-store-items refs)))))))
+           (return (find-among-store-items refs))))
+        (item
+         ;; XXX: ITEM might be a 'computed-file' or anything like that, in
+         ;; which case we don't know what to do.  The fix may be to check
+         ;; references once ITEM is compiled, as proposed at
+         ;; <https://bugs.gnu.org/29927>.
+         (return #f)))))
 
   (anym %store-monad
         entry-lookup-package (manifest-entries manifest)))
@@ -1202,6 +1208,7 @@ the entries in MANIFEST."
                              (hooks %default-profile-hooks)
                              (locales? #t)
                              (allow-collisions? #f)
+                             (relative-symlinks? #f)
                              system target)
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST.  The profile includes additional derivations returned by
@@ -1213,6 +1220,9 @@ with a different version number.)
 When LOCALES? is true, the build is performed under a UTF-8 locale; this adds
 a dependency on the 'glibc-utf8-locales' package.
 
+When RELATIVE-SYMLINKS? is true, use relative file names for symlink targets.
+This is one of the things to do for the result to be relocatable.
+
 When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST
 are cross-built for TARGET."
   (mlet* %store-monad ((system (if system
@@ -1275,6 +1285,9 @@ are cross-built for TARGET."
                                         (manifest-entries manifest))))))
 
             (build-profile #$output '#$inputs
+                           #:symlink #$(if relative-symlinks?
+                                           #~symlink-relative
+                                           #~symlink)
                            #:manifest '#$(manifest->gexp manifest)
                            #:search-paths search-paths))))
 
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 4ec3267007..cd802985dc 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -1037,7 +1037,7 @@ them for PACKAGE."
      (check       check-inputs-should-be-native))
    (lint-checker
      (name        'inputs-should-not-be-input)
-     (description "Identify inputs that should be inputs at all")
+     (description "Identify inputs that shouldn't be inputs at all")
      (check       check-inputs-should-not-be-an-input-at-all))
    (lint-checker
      (name        'patch-file-names)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 0e09a01496..1e84459e78 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -32,6 +32,8 @@
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module (guix derivations)
+  #:use-module (guix search-paths)
+  #:use-module (guix build-system gnu)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
@@ -100,11 +102,14 @@ with a properly initialized store database.
 SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
 added to the pack."
   (define build
-    (with-imported-modules '((guix build utils)
-                             (guix build store-copy)
-                             (gnu build install))
+    (with-imported-modules (source-module-closure
+                            '((guix build utils)
+                              (guix build union)
+                              (guix build store-copy)
+                              (gnu build install)))
       #~(begin
           (use-modules (guix build utils)
+                       ((guix build union) #:select (relative-file-name))
                        (gnu build install)
                        (srfi srfi-1)
                        (srfi srfi-26)
@@ -117,9 +122,17 @@ added to the pack."
             ;; parent directories.
             (match-lambda
               ((source '-> target)
-               (let ((target (string-append #$profile "/" target)))
-                 `((directory ,(dirname source))
-                   (,source -> ,target))))))
+               (let ((target (string-append #$profile "/" target))
+                     (parent (dirname source)))
+                 ;; Never add a 'directory' directive for "/" so as to
+                 ;; preserve its ownnership when extracting the archive (see
+                 ;; below), and also because this would lead to adding the
+                 ;; same entries twice in the tarball.
+                 `(,@(if (string=? parent "/")
+                         '()
+                         `((directory ,parent)))
+                   (,source
+                    -> ,(relative-file-name parent target)))))))
 
           (define directives
             ;; Fully-qualified symlinks.
@@ -140,9 +153,11 @@ added to the pack."
                                        "")
                                  #$tar "/bin"))
 
-          ;; Note: there is not much to gain here with deduplication and
-          ;; there is the overhead of the '.links' directory, so turn it
-          ;; off.
+          ;; Note: there is not much to gain here with deduplication and there
+          ;; is the overhead of the '.links' directory, so turn it off.
+          ;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs
+          ;; with hard links:
+          ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>.
           (populate-single-profile-directory %root
                                              #:profile #$profile
                                              #:closure "profile"
@@ -189,6 +204,8 @@ added to the pack."
                             (filter-map (match-lambda
                                           (('directory directory)
                                            (string-append "." directory))
+                                          ((source '-> _)
+                                           (string-append "." source))
                                           (_ #f))
                                         directives)))))))))
 
@@ -217,11 +234,13 @@ the image."
       (('gnu rest ...) #t)
       (rest #f)))
 
+  (define defmod 'define-module)                  ;trick Geiser
+
   (define config
     ;; (guix config) module for consumption by (guix gcrypt).
     (scheme-file "gcrypt-config.scm"
                  #~(begin
-                     (define-module (guix config)
+                     (#$defmod (guix config)
                        #:export (%libgcrypt))
 
                      ;; XXX: Work around <http://bugs.gnu.org/15602>.
@@ -267,6 +286,165 @@ the image."
 
 
 ;;;
+;;; Compiling C programs.
+;;;
+
+;; A C compiler.  That lowers to a single program that can be passed typical C
+;; compiler flags, and it makes sure the whole toolchain is available.
+(define-record-type <c-compiler>
+  (%c-compiler toolchain guile)
+  c-compiler?
+  (toolchain c-compiler-toolchain)
+  (guile     c-compiler-guile))
+
+(define* (c-compiler #:optional inputs
+                     #:key (guile (default-guile)))
+  (%c-compiler inputs guile))
+
+(define (bootstrap-c-compiler)
+  "Return the C compiler that uses the bootstrap toolchain.  This is used only
+by '--bootstrap', for testing purposes."
+  (define bootstrap-toolchain
+    (list (first (assoc-ref %bootstrap-inputs "gcc"))
+          (first (assoc-ref %bootstrap-inputs "binutils"))
+          (first (assoc-ref %bootstrap-inputs "libc"))))
+
+  (c-compiler bootstrap-toolchain
+              #:guile %bootstrap-guile))
+
+(define-gexp-compiler (c-compiler-compiler (compiler <c-compiler>) system target)
+  "Lower COMPILER to a single script that does the right thing."
+  (define toolchain
+    (or (c-compiler-toolchain compiler)
+        (list (first (assoc-ref (standard-packages) "gcc"))
+              (first (assoc-ref (standard-packages) "ld-wrapper"))
+              (first (assoc-ref (standard-packages) "binutils"))
+              (first (assoc-ref (standard-packages) "libc"))
+              (gexp-input (first (assoc-ref (standard-packages) "libc"))
+                          "static"))))
+
+  (define inputs
+    (match (append-map package-propagated-inputs
+                       (filter package? toolchain))
+      (((labels things . _) ...)
+       (append toolchain things))))
+
+  (define search-paths
+    (cons $PATH
+          (append-map package-native-search-paths
+                      (filter package? inputs))))
+
+  (define run
+    (with-imported-modules (source-module-closure
+                            '((guix build utils)
+                              (guix search-paths)))
+      #~(begin
+          (use-modules (guix build utils) (guix search-paths)
+                       (ice-9 match))
+
+          (define (output-file args)
+            (let loop ((args args))
+              (match args
+                (() "a.out")
+                (("-o" file _ ...) file)
+                ((head rest ...) (loop rest)))))
+
+          (set-search-paths (map sexp->search-path-specification
+                                 '#$(map search-path-specification->sexp
+                                         search-paths))
+                            '#$inputs)
+
+          (let ((output (output-file (command-line))))
+            (apply invoke "gcc" (cdr (command-line)))
+            (invoke "strip" output)))))
+
+  (when target
+    ;; TODO: Yep, we'll have to do it someday!
+    (leave (G_ "cross-compilation not implemented here;
+please email '~a'~%")
+           (@ (guix config) %guix-bug-report-address)))
+
+  (gexp->script "c-compiler" run
+                #:guile (c-compiler-guile compiler)))
+
+
+;;;
+;;; Wrapped package.
+;;;
+
+(define* (wrapped-package package
+                          #:optional (compiler (c-compiler)))
+  (define runner
+    (local-file (search-auxiliary-file "run-in-namespace.c")))
+
+  (define build
+    (with-imported-modules (source-module-closure
+                            '((guix build utils)
+                              (guix build union)))
+      #~(begin
+          (use-modules (guix build utils)
+                       ((guix build union) #:select (relative-file-name))
+                       (ice-9 ftw)
+                       (ice-9 match))
+
+          (define (strip-store-prefix file)
+            ;; Given a file name like "/gnu/store/…-foo-1.2/bin/foo", return
+            ;; "/bin/foo".
+            (let* ((len  (string-length (%store-directory)))
+                   (base (string-drop file (+ 1 len))))
+              (match (string-index base #\/)
+                (#f    base)
+                (index (string-drop base index)))))
+
+          (define (build-wrapper program)
+            ;; Build a user-namespace wrapper for PROGRAM.
+            (format #t "building wrapper for '~a'...~%" program)
+            (copy-file #$runner "run.c")
+
+            (substitute* "run.c"
+              (("@WRAPPED_PROGRAM@") program)
+              (("@STORE_DIRECTORY@") (%store-directory)))
+
+            (let* ((base   (strip-store-prefix program))
+                   (result (string-append #$output "/" base)))
+              (mkdir-p (dirname result))
+              (invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
+                      "run.c" "-o" result)
+              (delete-file "run.c")))
+
+          (setvbuf (current-output-port)
+                   (cond-expand (guile-2.2 'line)
+                                (else      _IOLBF)))
+
+          ;; Link the top-level files of PACKAGE so that search paths are
+          ;; properly defined in PROFILE/etc/profile.
+          (mkdir #$output)
+          (for-each (lambda (file)
+                      (unless (member file '("." ".." "bin" "sbin" "libexec"))
+                        (let ((file* (string-append #$package "/" file)))
+                          (symlink (relative-file-name #$output file*)
+                                   (string-append #$output "/" file)))))
+                    (scandir #$package))
+
+          (for-each build-wrapper
+                    (append (find-files #$(file-append package "/bin"))
+                            (find-files #$(file-append package "/sbin"))
+                            (find-files #$(file-append package "/libexec")))))))
+
+  (computed-file (string-append (package-full-name package "-") "R")
+                 build))
+
+(define (map-manifest-entries proc manifest)
+  "Apply PROC to all the entries of MANIFEST and return a new manifest."
+  (make-manifest
+   (map (lambda (entry)
+          (manifest-entry
+            (inherit entry)
+            (item (proc (manifest-entry-item entry)))))
+        (manifest-entries manifest))))
+
+
+;;;
 ;;; Command-line options.
 ;;;
 
@@ -302,6 +480,9 @@ the image."
          (option '(#\f "format") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'format (string->symbol arg) result)))
+         (option '(#\R "relocatable") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'relocatable? #t result)))
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
@@ -354,6 +535,8 @@ Create a bundle of PACKAGE.\n"))
   (display (G_ "
   -f, --format=FORMAT    build a pack in the given FORMAT"))
   (display (G_ "
+  -R, --relocatable      produce relocatable executables"))
+  (display (G_ "
   -e, --expression=EXPR  consider the package EXPR evaluates to"))
   (display (G_ "
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
@@ -417,6 +600,9 @@ Create a bundle of PACKAGE.\n"))
 
   (with-error-handling
     (with-store store
+      ;; Set the build options before we do anything else.
+      (set-build-options-from-command-line store opts)
+
       (parameterize ((%graft? (assoc-ref opts 'graft?))
                      (%guile-for-build (package-derivation
                                         store
@@ -425,7 +611,13 @@ Create a bundle of PACKAGE.\n"))
                                             (canonical-package guile-2.2))
                                         #:graft? (assoc-ref opts 'graft?))))
         (let* ((dry-run?    (assoc-ref opts 'dry-run?))
-               (manifest    (manifest-from-args store opts))
+               (relocatable? (assoc-ref opts 'relocatable?))
+               (manifest    (let ((manifest (manifest-from-args store opts)))
+                              ;; Note: We cannot honor '--bootstrap' here because
+                              ;; 'glibc-bootstrap' lacks 'libc.a'.
+                              (if relocatable?
+                                  (map-manifest-entries wrapped-package manifest)
+                                  manifest)))
                (pack-format (assoc-ref opts 'format))
                (name        (string-append (symbol->string pack-format)
                                            "-pack"))
@@ -444,12 +636,10 @@ Create a bundle of PACKAGE.\n"))
                                (leave (G_ "~a: unknown pack format")
                                       format))))
                (localstatedir? (assoc-ref opts 'localstatedir?)))
-          ;; Set the build options before we do anything else.
-          (set-build-options-from-command-line store opts)
-
           (run-with-store store
             (mlet* %store-monad ((profile (profile-derivation
                                            manifest
+                                           #:relative-symlinks? relocatable?
                                            #:hooks (if bootstrap?
                                                        '()
                                                        %default-profile-hooks)
diff --git a/guix/search-paths.scm b/guix/search-paths.scm
index 4bf0e44389..002e6342bb 100644
--- a/guix/search-paths.scm
+++ b/guix/search-paths.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,7 +38,8 @@
             string-tokenize*
             evaluate-search-paths
             environment-variable-definition
-            search-path-definition))
+            search-path-definition
+            set-search-paths))
 
 ;;; Commentary:
 ;;;
@@ -196,4 +197,14 @@ prefix/suffix."
                                       #:kind kind
                                       #:separator separator))))
 
+(define* (set-search-paths search-paths directories
+                           #:key (setenv setenv))
+  "Set the search path environment variables specified by SEARCH-PATHS for the
+given directories."
+  (for-each (match-lambda
+              ((spec . value)
+               (setenv (search-path-specification-variable spec)
+                       value)))
+            (evaluate-search-paths search-paths directories)))
+
 ;;; search-paths.scm ends here
diff --git a/guix/utils.scm b/guix/utils.scm
index 92e45de616..e9efea5866 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
@@ -84,6 +84,7 @@
             version-major+minor
             version-major
             guile-version>?
+            version-prefix?
             string-replace-substring
             arguments-from-environment-variable
             file-extension
@@ -521,6 +522,27 @@ minor version numbers from version-string."
                             (micro-version))
              str))
 
+(define version-prefix?
+  (let ((not-dot (char-set-complement (char-set #\.))))
+    (lambda (v1 v2)
+      "Return true if V1 is a version prefix of V2:
+
+  (version-prefix? \"4.1\" \"4.16.2\") => #f
+  (version-prefix? \"4.1\" \"4.1.2\") => #t
+"
+      (define (list-prefix? lst1 lst2)
+        (match lst1
+          (() #t)
+          ((head1 tail1 ...)
+           (match lst2
+             (() #f)
+             ((head2 tail2 ...)
+              (and (equal? head1 head2)
+                   (list-prefix? tail1 tail2)))))))
+
+      (list-prefix? (string-tokenize v1 not-dot)
+                    (string-tokenize v2 not-dot)))))
+
 (define (file-extension file)
   "Return the extension of FILE or #f if there is none."
   (let ((dot (string-rindex file #\.)))