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
Ludovic Courtès
parent
54fd5ad0a5
commit
47a60325ca
|
|
@ -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 = \
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -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>.
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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`"
|
||||
|
|
|
|||
Loading…
Reference in New Issue