pack: Add relocation via ld.so and fakechroot.

* gnu/packages/aux-files/run-in-namespace.c (HAVE_EXEC_WITH_LOADER): New
macro.
(bind_mount): Rename to...
(mirror_directory): ... this.  Add 'firmlink' argument and use it
instead of calling mkdir/open/close/mount directly.
(bind_mount, make_symlink): New functions.
(exec_in_user_namespace): Adjust accordingly.
(exec_with_loader) [HAVE_EXEC_WITH_LOADER]: New function.
(exec_performance): New function.
(engines): Add them.
* guix/scripts/pack.scm (wrapped-package)[fakechroot-library]
[audit-module]: New procedures.
[audit-source]: New variable.
[build](elf-interpreter, elf-loader-compile-flags): New procedures.
(build-wrapper): Use them.
* tests/guix-pack-relocatable.sh: Test with
'GUIX_EXECUTION_ENGINE=fakechroot'.
* doc/guix.texi (Invoking guix pack): Document the 'performance' and
'fakechroot' engines.
* gnu/packages/aux-files/pack-audit.c: New file.
* Makefile.am (AUX_FILES): Add it.

1 files changed, 85 insertions, 0 deletions

diff --git a/gnu/packages/aux-files/pack-audit.c b/gnu/packages/aux-files/pack-audit.c
new file mode 100644
index 0000000000..374787e8b9
--- /dev/null
+++ b/gnu/packages/aux-files/pack-audit.c
@@ -0,0 +1,85 @@
+/* GNU Guix --- Functional package management for GNU
+   Copyright (C) 2020 Ludovic Courtès <ludo@gnu.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/>.  */
+
+/* This file implements part of the GNU ld.so audit interface.  It is used by
+   the "fakechroot" engine of the 'guix pack -RR' wrappers to make sure the
+   loader looks for shared objects under the "fake" root directory.  */
+
+#define _GNU_SOURCE 1
+
+#include <link.h>
+
+#include <error.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+
+/* The pseudo root directory and store that we are relocating to.  */
+static const char *root_directory;
+static char *store;
+
+/* The original store, "/gnu/store" by default.  */
+static const char original_store[] = "@STORE_DIRECTORY@";
+
+/* Like 'malloc', but abort if 'malloc' returns NULL.  */
+static void *
+xmalloc (size_t size)
+{
+  void *result = malloc (size);
+  assert (result != NULL);
+  return result;
+}
+
+unsigned int
+la_version (unsigned int v)
+{
+  if (v != LAV_CURRENT)
+    error (1, 0, "cannot handle interface version %u", v);
+
+  root_directory = getenv ("FAKECHROOT_BASE");
+  if (root_directory == NULL)
+    error (1, 0, "'FAKECHROOT_BASE' is not set");
+
+  store = xmalloc (strlen (root_directory) + sizeof original_store);
+  strcpy (store, root_directory);
+  strcat (store, original_store);
+
+  return v;
+}
+
+/* Return NAME, a shared object file name, relocated under STORE.  This
+   function is called by the loader whenever it looks for a shared object.  */
+char *
+la_objsearch (const char *name, uintptr_t *cookie, unsigned int flag)
+{
+  char *result;
+
+  if (strncmp (name, original_store,
+	       sizeof original_store - 1) == 0)
+    {
+      size_t len = strlen (name) - sizeof original_store
+	+ strlen (store) + 1;
+      result = xmalloc (len);
+      strcpy (result, store);
+      strcat (result, name + sizeof original_store - 1);
+    }
+  else
+    result = strdup (name);
+
+  return result;
+}