diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | doc/guix.texi | 42 | ||||
| -rw-r--r-- | gnu/packages/aux-files/run-in-namespace.c | 264 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 182 | ||||
| -rw-r--r-- | tests/guix-pack.sh | 10 |
5 files changed, 488 insertions, 13 deletions
diff --git a/Makefile.am b/Makefile.am index 2110371f7a..38bd54cf4f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 = \ diff --git a/doc/guix.texi b/doc/guix.texi index 8b9f8721ba..6aeb313773 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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. diff --git a/gnu/packages/aux-files/run-in-namespace.c b/gnu/packages/aux-files/run-in-namespace.c new file mode 100644 index 0000000000..d0ab05c5db --- /dev/null +++ b/gnu/packages/aux-files/run-in-namespace.c @@ -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; +} diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 0e09a01496..db5609219f 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) @@ -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>. @@ -267,6 +275,150 @@ 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 '((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) diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index 5584c10e00..130389a7ad 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -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`" |