nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

pack: Add '--relocatable'. 

* gnu/packages/aux-files/run-in-namespace.c: New file.
* Makefile.am (AUX_FILES): Add it.
* guix/scripts/pack.scm (<c-compiler>): New record type.
(c-compiler, bootstrap-c-compiler, c-compiler-compiler): New procedures.
(self-contained-tarball): Use
'relative-file-name' for the SOURCE -> TARGET symlink.
(docker-image): Add 'defmod' to please Geiser.
(wrapped-package, map-manifest-entries): New procedures.
(%options, show-help): Add --relocatable.
(guix-pack): Honor it.
This commit is contained in:
Ludovic Courtès 2018-05-02 17:08:37 +02:00 committed by Ludovic Courtès
parent 54fd5ad0a5
commit 47a60325ca
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
5 changed files with 488 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile.am
View File

@ -274,7 +274,8 @@ AUX_FILES = \
gnu/packages/aux-files/linux-libre/4.4-i686.conf \
gnu/packages/aux-files/linux-libre/4.4-x86_64.conf \
gnu/packages/aux-files/linux-libre/4.1-i686.conf \
gnu/packages/aux-files/linux-libre/4.1-x86_64.conf
gnu/packages/aux-files/linux-libre/4.1-x86_64.conf \
gnu/packages/aux-files/run-in-namespace.c
# Templates, examples.
EXAMPLES = \

42
doc/guix.texi
View File

@ -2834,6 +2834,15 @@ guix pack -S /opt/gnu/bin=bin guile emacs geiser
@noindent
That way, users can happily type @file{/opt/gnu/bin/guile} and enjoy.
@cindex relocatable binaries, with @command{guix pack}
What if the recipient of your pack does not have root privileges on
their machine, and thus cannot unpack it in the root file system? In
that case, you will want to use the @code{--relocatable} option (see
below). This option produces @dfn{relocatable binaries}, meaning they
they can be placed anywhere in the file system hierarchy: in the example
above, users can unpack your tarball in their home directory and
directly run @file{./opt/gnu/bin/guile}.
Alternatively, you can produce a pack in the Docker image format using
the following command:
@ -2867,6 +2876,39 @@ This produces a tarball that follows the
Docker Image Specification}.
@end table
@item --relocatable
@itemx -R
Produce @dfn{relocatable binaries}---i.e., binaries that can be placed
anywhere in the file system hierarchy and run from there. For example,
if you create a pack containing Bash with:
@example
guix pack -R -S /mybin=bin bash
@end example
@noindent
... you can copy that pack to a machine that lacks Guix, and from your
home directory as a normal user, run:
@example
tar xf pack.tar.gz
./mybin/sh
@end example
@noindent
In that shell, if you type @code{ls /gnu/store}, you'll notice that
@file{/gnu/store} shows up and contains all the dependencies of
@code{bash}, even though the machine actually lacks @file{/gnu/store}
altogether! That is probably the simplest way to deploy Guix-built
software on a non-Guix machine.
There's a gotcha though: this technique relies on the @dfn{user
namespace} feature of the kernel Linux, which allows unprivileged users
to mount or change root. Old versions of Linux did not support it, and
some GNU/Linux distributions turn it off; on these systems, programs
from the pack @emph{will fail to run}, unless they are unpacked in the
root file system.
@item --expression=@var{expr}
@itemx -e @var{expr}
Consider the package @var{expr} evaluates to.

264
gnu/packages/aux-files/run-in-namespace.c Normal file
View File

@ -0,0 +1,264 @@
/* GNU Guix --- Functional package management for GNU
Copyright (C) 2018 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/>. */
/* Make the given @WRAPPED_PROGRAM@ relocatable by executing it in a separate
mount namespace where the store is mounted in its right place.
We would happily do that in Scheme using 'call-with-container'. However,
this very program needs to be relocatable, so it needs to be statically
linked, which complicates things (Guile's modules can hardly be "linked"
into a single executable.) */
#define _GNU_SOURCE
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
#include <sched.h>
#include <sys/mount.h>
#include <errno.h>
#include <libgen.h>
#include <limits.h>
#include <string.h>
#include <assert.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <sys/wait.h>
#include <fcntl.h>
#include <dirent.h>
/* Concatenate DIRECTORY, a slash, and FILE. Return the result, which the
caller must eventually free. */
static char *
concat (const char *directory, const char *file)
{
char *result = malloc (strlen (directory) + 2 + strlen (file));
assert (result != NULL);
strcpy (result, directory);
strcat (result, "/");
strcat (result, file);
return result;
}
static void
mkdir_p (const char *directory)
{
if (strcmp (directory, "/") != 0)
{
char *parent = dirname (strdupa (directory));
mkdir_p (parent);
int err = mkdir (directory, 0700);
if (err < 0 && errno != EEXIST)
assert_perror (errno);
}
}
static void
rm_rf (const char *directory)
{
DIR *stream = opendir (directory);
for (struct dirent *entry = readdir (stream);
entry != NULL;
entry = readdir (stream))
{
if (strcmp (entry->d_name, ".") == 0
|| strcmp (entry->d_name, "..") == 0)
continue;
char *full = concat (directory, entry->d_name);
int err = unlink (full);
if (err < 0)
{
if (errno == EISDIR)
/* Recurse (we expect a shallow directory structure so there's
little risk of stack overflow.) */
rm_rf (full);
else
assert_perror (errno);
}
free (full);
}
closedir (stream);
int err = rmdir (directory);
if (err < 0 && errno != ENOENT)
assert_perror (errno);
}
/* Bind mount all the top-level entries in SOURCE to TARGET. */
static void
bind_mount (const char *source, const char *target)
{
DIR *stream = opendir (source);
for (struct dirent *entry = readdir (stream);
entry != NULL;
entry = readdir (stream))
{
/* XXX: Some file systems may not report a useful 'd_type'. Ignore them
for now. */
assert (entry->d_type != DT_UNKNOWN);
if (strcmp (entry->d_name, ".") == 0
|| strcmp (entry->d_name, "..") == 0)
continue;
char *abs_source = concat (source, entry->d_name);
char *new_entry = concat (target, entry->d_name);
if (entry->d_type == DT_LNK)
{
char target[PATH_MAX];
ssize_t result = readlink (abs_source, target, sizeof target - 1);
if (result > 0)
{
target[result] = '\0';
int err = symlink (target, new_entry);
if (err < 0)
assert_perror (errno);
}
}
else
{
/* Create the mount point. */
if (entry->d_type == DT_DIR)
{
int err = mkdir (new_entry, 0700);
if (err != 0)
assert_perror (errno);
}
else
close (open (new_entry, O_WRONLY | O_CREAT));
int err = mount (abs_source, new_entry, "none",
MS_BIND | MS_REC | MS_RDONLY, NULL);
/* It used to be that only directories could be bind-mounted. Thus,
keep going if we fail to bind-mount a non-directory entry.
That's OK because regular files in the root file system are
usually uninteresting. */
if (err != 0 && entry->d_type != DT_DIR)
assert_perror (errno);
free (new_entry);
free (abs_source);
}
}
closedir (stream);
}
int
main (int argc, char *argv[])
{
ssize_t size;
char self[PATH_MAX];
size = readlink ("/proc/self/exe", self, sizeof self - 1);
assert (size > 0);
/* SELF is something like "/home/ludo/.local/gnu/store/…-foo/bin/ls" and we
want to extract "/home/ludo/.local/gnu/store". */
size_t index = strlen (self)
- strlen ("@WRAPPED_PROGRAM@")
+ strlen ("@STORE_DIRECTORY@");
char *store = strdup (self);
store[index] = '\0';
struct stat statbuf;
/* If STORE is already at the "right" place, we can execute
@WRAPPED_PROGRAM@ right away. This is not just an optimization: it's
needed when running one of these wrappers from within an unshare'd
namespace, because 'unshare' fails with EPERM in that context. */
if (strcmp (store, "@STORE_DIRECTORY@") != 0
&& lstat ("@WRAPPED_PROGRAM@", &statbuf) != 0)
{
/* Spawn @WRAPPED_PROGRAM@ in a separate namespace where STORE is
bind-mounted in the right place. */
int err;
char *new_root = mkdtemp (strdup ("/tmp/guix-exec-XXXXXX"));
char *new_store = concat (new_root, "@STORE_DIRECTORY@");
char *cwd = get_current_dir_name ();
pid_t child = fork ();
switch (child)
{
case 0:
/* Unshare namespaces in the child and set up bind-mounts from
there. That way, bind-mounts automatically disappear when the
child exits, which simplifies cleanup for the parent. */
err = unshare (CLONE_NEWNS | CLONE_NEWUSER);
if (err < 0)
{
fprintf (stderr, "%s: error: 'unshare' failed: %m\n", argv[0]);
fprintf (stderr, "\
This may be because \"user namespaces\" are not supported on this system.\n\
Consequently, we cannot run '@WRAPPED_PROGRAM@',\n\
unless you move it to the '@STORE_DIRECTORY@' directory.\n\
\n\
Please refer to the 'guix pack' documentation for more information.\n");
return EXIT_FAILURE;
}
/* Note: Due to <https://bugzilla.kernel.org/show_bug.cgi?id=183461>
we cannot make NEW_ROOT a tmpfs (which would have saved the need
for 'rm_rf'.) */
bind_mount ("/", new_root);
mkdir_p (new_store);
err = mount (store, new_store, "none", MS_BIND | MS_REC | MS_RDONLY,
NULL);
if (err < 0)
assert_perror (errno);
chdir (new_root);
err = chroot (new_root);
if (err < 0)
assert_perror (errno);
/* Change back to where we were before chroot'ing. */
chdir (cwd);
break;
case -1:
assert_perror (errno);
break;
default:
{
int status;
waitpid (child, &status, 0);
chdir ("/"); /* avoid EBUSY */
rm_rf (new_root);
free (new_root);
exit (status);
}
}
}
/* The executable is available under @STORE_DIRECTORY@, so we can now
execute it. */
int err = execv ("@WRAPPED_PROGRAM@", argv);
if (err < 0)
assert_perror (errno);
return EXIT_FAILURE;
}

180
guix/scripts/pack.scm
View File

@ -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)
(with-imported-modules (source-module-closure
'((guix build utils)
(guix build union)
(guix build store-copy)
(gnu build install))
(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)
@ -119,7 +124,8 @@ added to the pack."
((source '-> target)
(let ((target (string-append #$profile "/" target)))
`((directory ,(dirname source))
(,source -> ,target))))))
(,source
-> ,(relative-file-name (dirname source) target)))))))
(define directives
;; Fully-qualified symlinks.
@ -217,11 +223,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>.
@ -265,6 +273,150 @@ the image."
build
#:references-graphs `(("profile" ,profile))))
;;;
;;; 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 '((guix build utils))
#~(begin
(use-modules (guix build utils)
(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)))
(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 +454,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 +509,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 +574,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 +585,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 +610,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)

10
tests/guix-pack.sh
View File

@ -20,9 +20,9 @@
# Test the `guix pack' command-line utility.
#
# A network connection is required to build %bootstrap-coreutils&co,
# which is required to run these tests with the --bootstrap option.
if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null; then
# The bootstrap binaries are needed to run these tests, which usually requires
# a network connection.
if ! guix build -q guile-bootstrap; then
exit 77
fi
@ -87,6 +87,10 @@ guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
# guile-bootstrap is not intended to be cross-compiled.
guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
# Likewise, 'guix pack -R' requires a full-blown toolchain (because
# 'glibc-bootstrap' lacks 'libc.a'), hence '--dry-run'.
guix pack -R --dry-run --bootstrap -S /mybin=bin guile-bootstrap
# Make sure package transformation options are honored.
mkdir -p "$test_directory"
drv1="`guix pack -n guile 2>&1 | grep pack.*\.drv`"