summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2023-03-23 17:22:38 +0100
committerLudovic Courtès <ludo@gnu.org>2023-04-06 18:34:15 +0200
commit57db09aae73e3713a10c5253758d84e1046f80dc (patch)
treee55165d2dc5149e4200a7a854b428bb4d6ec8a46 /guix/scripts
parent58769f92732434cadda565093f5951a1957ccd13 (diff)
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.
Diffstat (limited to 'guix/scripts')
-rw-r--r--guix/scripts/environment.scm66
-rw-r--r--guix/scripts/shell.scm2
2 files changed, 64 insertions, 4 deletions
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index a4939ea63c..ebfc05731c 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -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?
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 92bbfb04d0..1b42cc2af0 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -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)