environment: Add '--nesting'.

* guix/scripts/environment.scm (show-environment-options-help)
(%options): Add '--nesting'.
(options/resolve-packages): Handle it.
(launch-environment/container): Add #:nesting? and honor it.
[nesting-mappings]: New procedure.
(guix-environment*): Add support for '--nesting'.
* guix/scripts/shell.scm (profile-cached-gc-root): Special-case
'nesting?'.
* tests/guix-environment-container.sh: Test it.
* doc/guix.texi (Invoking guix shell): Document it.
This commit is contained in:
Ludovic Courtès 2023-03-23 17:22:38 +01:00 committed by Ludovic Courtès
parent 58769f9273
commit 57db09aae7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 124 additions and 4 deletions

View File

@ -6357,6 +6357,57 @@ cache (contrary to glibc in regular Guix usage) and set up the
expected FHS directories: @file{/bin}, @file{/etc}, @file{/lib}, and
@file{/usr} from the container's profile.
@cindex nested containers, for @command{guix shell}
@cindex container nesting, for @command{guix shell}
@item --nesting
@itemx -W
When used with @option{--container}, provide Guix @emph{inside} the
container and arrange so that it can interact with the build daemon that
runs outside the container. This is useful if you want, within your
isolated container, to create other containers, as in this sample
session:
@example
$ guix shell -CW coreutils
[env]$ guix shell -C guile -- guile -c '(display "hello!\n")'
hello!
[env]$ exit
@end example
The session above starts a container with @code{coreutils} programs
available in @env{PATH}. From there, we spawn @command{guix shell} to
create a @emph{nested} container that provides nothing but Guile.
Another example is evaluating a @file{guix.scm} file that is untrusted,
as shown here:
@example
guix shell -CW -- guix build -f guix.scm
@end example
The @command{guix build} command as executed above can only access the
current directory.
Under the hood, the @option{-W} option does several things:
@itemize
@item
map the daemon's socket (by default
@file{/var/guix/daemon-socket/socket}) inside the container;
@item
map the whole store (by default @file{/gnu/store}) inside the container
such that store items made available by nested @command{guix}
invocations are visible;
@item
add the currently-used @command{guix} command to the profile in the
container, such that @command{guix describe} returns the same state
inside and outside the container;
@item
share the cache (by default @file{~/.cache/guix}) with the host, to
speed up operations such as @command{guix time-machine} and
@command{guix shell}.
@end itemize
@item --rebuild-cache
@cindex caching, of profiles
@cindex caching, in @command{guix shell}

View File

@ -31,6 +31,8 @@
#:use-module (guix build utils)
#:use-module (guix monads)
#:use-module ((guix gexp) #:select (lower-object))
#:autoload (guix describe) (current-profile current-channels)
#:autoload (guix channels) (guix-channel? channel-commit)
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:autoload (guix scripts pack) (symlink-spec-option-parser)
@ -49,9 +51,11 @@
#:autoload (gnu packages) (specification->package+output)
#:autoload (gnu packages bash) (bash)
#:autoload (gnu packages bootstrap) (bootstrap-executable %bootstrap-guile)
#:autoload (gnu packages package-management) (guix)
#:use-module (ice-9 match)
#:autoload (ice-9 rdelim) (read-line)
#:use-module (ice-9 vlist)
#:autoload (web uri) (string->uri uri-scheme)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@ -108,6 +112,8 @@ shell'."
-P, --link-profile link environment profile to ~/.guix-profile within
an isolated container"))
(display (G_ "
-W, --nesting make Guix available within the container"))
(display (G_ "
-u, --user=USER instead of copying the name and home of the current
user into an isolated container, use the name USER
with home directory /home/USER"))
@ -238,6 +244,9 @@ use '--preserve' instead~%"))
(option '(#\N "network") #f #f
(lambda (opt name arg result)
(alist-cons 'network? #t result)))
(option '(#\W "nesting") #f #f
(lambda (opt name arg result)
(alist-cons 'nesting? #t result)))
(option '(#\P "link-profile") #f #f
(lambda (opt name arg result)
(alist-cons 'link-profile? #t result)))
@ -342,6 +351,26 @@ for the corresponding packages."
(packages->outputs (load* file module) mode)))
(('manifest . file)
(manifest-entries (load-manifest file)))
(('nesting? . #t)
(if (assoc-ref opts 'profile)
'()
(let ((profile (and=> (current-profile) readlink*)))
(if (or (not profile) (not (store-path? profile)))
(begin
(warning (G_ "\
could not add current Guix to the profile~%"))
'())
(list (manifest-entry
(name "guix")
(version
(or (any (lambda (channel)
(and (guix-channel? channel)
(channel-commit channel)))
(current-channels))
"0"))
(item profile)
(search-paths
(package-native-search-paths guix))))))))
(_ '()))
opts)
manifest-entry=?)))
@ -688,7 +717,8 @@ regexps in WHITE-LIST."
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
map-cwd? emulate-fhs? (setup-hook #f)
map-cwd? emulate-fhs? nesting?
(setup-hook #f)
(symlinks '()) (white-list '()))
"Run COMMAND within a container that features the software in PROFILE.
Environment variables are set according to the search paths of MANIFEST. The
@ -704,6 +734,9 @@ Standard and provide a glibc that reads the cache from /etc/ld.so.cache.
SETUP-HOOK is an additional setup procedure to be called, currently only used
with the EMULATE-FHS? option.
When NESTING? is true, share all the store with the container and add Guix to
its profile, allowing its use from within the container.
LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the
environment profile.
@ -731,8 +764,26 @@ WHILE-LIST."
("/libexec" . "/usr/libexec")
("/share" . "/usr/share"))))
(mlet %store-monad ((reqs (inputs->requisites
(list (direct-store-path bash) profile))))
(define (nesting-mappings)
;; Files shared with the host when enabling nesting.
(cons* (file-system-mapping
(source (%store-prefix))
(target source))
(file-system-mapping
(source (cache-directory))
(target source)
(writable? #t))
(let ((uri (string->uri (%daemon-socket-uri))))
(if (or (not uri) (eq? 'file (uri-scheme uri)))
(list (file-system-mapping
(source (%daemon-socket-uri))
(target source)))
'()))))
(mlet %store-monad ((reqs (if nesting?
(return '())
(inputs->requisites
(list (direct-store-path bash) profile)))))
(return
(let* ((cwd (getcwd))
(home (getenv "HOME"))
@ -795,11 +846,14 @@ WHILE-LIST."
(filter-map optional-mapping->fs
%network-file-mappings)
'())
;; Mappings for an FHS container.
(if emulate-fhs?
(filter-map optional-mapping->fs
fhs-mappings)
'())
(if nesting?
(filter-map optional-mapping->fs
(nesting-mappings))
'())
(map file-system-mapping->bind-mount
mappings))))
(exit/status
@ -1013,6 +1067,7 @@ command-line option processing with 'parse-command-line'."
(network? (assoc-ref opts 'network?))
(no-cwd? (assoc-ref opts 'no-cwd?))
(emulate-fhs? (assoc-ref opts 'emulate-fhs?))
(nesting? (assoc-ref opts 'nesting?))
(user (assoc-ref opts 'user))
(bootstrap? (assoc-ref opts 'bootstrap?))
(system (assoc-ref opts 'system))
@ -1059,6 +1114,8 @@ command-line option processing with 'parse-command-line'."
(leave (G_ "--no-cwd cannot be used without '--container'~%")))
(when emulate-fhs?
(leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
(when nesting?
(leave (G_ "'--nesting' cannot be used without '--container~%'")))
(when (pair? symlinks)
(leave (G_ "'--symlink' cannot be used without '--container~%'"))))
@ -1141,6 +1198,7 @@ when using '--container'; doing nothing~%"))
#:network? network?
#:map-cwd? (not no-cwd?)
#:emulate-fhs? emulate-fhs?
#:nesting? nesting?
#:symlinks symlinks
#:setup-hook
(and emulate-fhs?

View File

@ -389,6 +389,8 @@ return #f and #f."
(if (not file)
(loop rest system file (cons spec specs))
(values #f #f)))
((('nesting? . #t) . rest)
(loop rest system file (append specs '("nested guix"))))
((('load . ('package candidate)) . rest)
(if (and (not file) (null? specs))
(loop rest system candidate specs)

View File

@ -264,3 +264,12 @@ guix shell --bootstrap guile-bootstrap --container \
# An invalid symlink spec causes the command to fail.
! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap -- exit
# Check whether '--nesting' works.
guix build hello -d
env="$(type -P pre-inst-env)"
if guix shell -C -D guix -- "$env" guix build hello -d # cannot work
then false; else true; fi
hello_drv="$(guix build hello -d)"
hello_drv_nested="$(cd "$(dirname env)" && guix shell --bootstrap -CW -D guix -- "$env" guix build hello -d)"
test "$hello_drv" = "$hello_drv_nested"