[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/04: guix home: Add 'container' command.
|
From: |
guix-commits |
|
Subject: |
03/04: guix home: Add 'container' command. |
|
Date: |
Sat, 19 Mar 2022 14:21:39 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 094a2cfbe45c104d0da30ff9d975d052ca0c118c
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Mar 13 22:44:54 2022 +0100
guix home: Add 'container' command.
* guix/scripts/home.scm (show-help, %options): Add '--network',
'--share', and '--expose'.
(not-config?, user-shell, spawn-home-container): New procedures.
(%default-system-profile): New variable.
(perform-action): Add #:file-system-mappings, #:container-command,
and #:network?; honor them.
(process-action): Adjust accordingly.
(guix-home)[parse-sub-command]: Add "container".
[parse-args]: New procedure.
Use it instead of 'parse-command-line'.
* tests/guix-home.sh: Add tests.
* doc/guix.texi (Declaring the Home Environment): Mention 'guix home
container' as a way to test configuration.
(Invoking guix home): Document it.
---
doc/guix.texi | 58 +++++++++++
guix/scripts/home.scm | 272 +++++++++++++++++++++++++++++++++++++++++++++-----
tests/guix-home.sh | 57 ++++++++---
3 files changed, 348 insertions(+), 39 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 1ecb3c7e3d..15ab97699c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -38071,6 +38071,21 @@ be confused with Shepherd services (@pxref{Shepherd
Services}). Using this exte
mechanism and some Scheme code that glues things together gives the user
the freedom to declare their own, very custom, home environments.
+@cindex container, for @command{guix home}
+Once the configuration looks good, you can first test it in a throw-away
+``container'':
+
+@example
+guix home container config.scm
+@end example
+
+The command above spawns a shell where your home environment is running.
+The shell runs in a container, meaning it's isolated from the rest of
+the system, so it's a good way to try out your configuration---you can
+see if configuration bits are missing or misbehaving, if daemons get
+started, and so on. Once you exit that shell, you're back to the prompt
+of your original shell ``in the real world''.
+
Once you have a configuration file that suits your needs, you can
reconfigure your home by running:
@@ -38699,6 +38714,49 @@ As for @command{guix search}, the result is written in
@code{recutils} format, which makes it easy to filter the output
(@pxref{Top, GNU recutils databases,, recutils, GNU recutils manual}).
+@cindex container, for @command{guix home}
+@item container
+Spawn a shell in an isolated environment---a
+@dfn{container}---containing your home as specified by @var{file}.
+
+For example, this is how you would start an interactive shell in a
+container with your home:
+
+@example
+guix home container config.scm
+@end example
+
+This is a throw-away container where you can lightheartedly fiddle with
+files; any changes made within the container, any process started---all
+this disappears as soon as you exit that shell.
+
+As with @command{guix shell}, several options control that container:
+
+@table @option
+@item --network
+@itemx -N
+Enable networking within the container (it is disabled by default).
+
+@item --expose=@var{source}[=@var{target}]
+@itemx --share=@var{source}[=@var{target}]
+As with @command{guix shell}, make directory @var{source} of the host
+system available as @var{target} inside the container---read-only if you
+pass @option{--expose}, and writable if you pass @option{--share}
+(@pxref{Invoking guix shell, @option{--expose} and @option{--share}}).
+@end table
+
+Additionally, you can run a command in that container, instead of
+spawning an interactive shell. For instance, here is how you would
+check which Shepherd services are started in a throw-away home
+container:
+
+@example
+guix home container config.scm -- herd status
+@end example
+
+The command to run in the container must come after @code{--} (double
+hyphen).
+
@item reconfigure
Build the home environment described in @var{file}, and switch to it.
Switching means that the activation script will be evaluated and (in
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index e95e4a90e4..1902562f60 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -24,11 +24,24 @@
#:use-module (gnu packages admin)
#:use-module ((gnu services) #:hide (delete))
#:use-module (gnu packages)
+ #:autoload (gnu packages base) (coreutils)
+ #:autoload (gnu packages bash) (bash)
+ #:autoload (gnu packages gnupg) (guile-gcrypt)
+ #:autoload (gnu packages shells) (fish gash zsh)
#:use-module (gnu home)
#:use-module (gnu home services)
#:autoload (gnu home services shepherd) (home-shepherd-service-type
home-shepherd-configuration-services
shepherd-service-requirement)
+ #:autoload (guix modules) (source-module-closure)
+ #:autoload (gnu build linux-container) (call-with-container %namespaces)
+ #:autoload (gnu system linux-container) (eval/container)
+ #:autoload (gnu system file-systems) (file-system-mapping
+ file-system-mapping-source
+ file-system-mapping->bind-mount
+ specification->file-system-mapping
+ %network-file-mappings)
+ #:autoload (guix self) (make-config.scm)
#:use-module (guix channels)
#:use-module (guix derivations)
#:use-module (guix ui)
@@ -55,6 +68,7 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:export (guix-home))
@@ -106,6 +120,16 @@ Some ACTIONS support additional ARGS.\n"))
(display (G_ "
--allow-downgrades for 'reconfigure', allow downgrades to earlier
channel revisions"))
+ (newline)
+ (display (G_ "
+ -N, --network allow containers to access the network"))
+ (display (G_ "
+ --share=SPEC for containers, share writable host file system
+ according to SPEC"))
+ (display (G_ "
+ --expose=SPEC for containers, expose read-only host file system
+ according to SPEC"))
+ (newline)
(display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
(display (G_ "
@@ -154,6 +178,21 @@ Some ACTIONS support additional ARGS.\n"))
(lambda (opt name arg result)
(alist-cons 'graph-backend arg result)))
+ ;; Container options.
+ (option '(#\N "network") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'network? #t result)))
+ (option '("share") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'file-system-mapping
+ (specification->file-system-mapping arg #t)
+ result)))
+ (option '("expose") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'file-system-mapping
+ (specification->file-system-mapping arg #f)
+ result)))
+
%standard-build-options))
(define %default-options
@@ -169,6 +208,146 @@ Some ACTIONS support additional ARGS.\n"))
(graph-backend . "graphviz")))
+;;;
+;;; Container.
+;;;
+
+(define not-config?
+ ;; Select (guix …) and (gnu …) modules, except (guix config).
+ (match-lambda
+ (('guix 'config) #f)
+ (('guix _ ...) #t)
+ (('gnu _ ...) #t)
+ (_ #f)))
+
+(define (user-shell)
+ (match (and=> (or (getenv "SHELL")
+ (passwd:shell (getpwuid (getuid))))
+ basename)
+ ("zsh" (file-append zsh "/bin/zsh"))
+ ("fish" (file-append fish "/bin/fish"))
+ ("gash" (file-append gash "/bin/gash"))
+ (_ (file-append bash "/bin/bash"))))
+
+(define %default-system-profile
+ ;; The "system" profile available when running 'guix home container'. The
+ ;; activation script currently expects to run "env -0" (XXX), so provide
+ ;; Coreutils by default.
+ (delay (profile
+ (name "home-system-profile")
+ (content (packages->manifest (list coreutils))))))
+
+(define* (spawn-home-container home
+ #:key
+ network?
+ (command '())
+ (mappings '())
+ (system-profile
+ (force %default-system-profile)))
+ "Spawn a login shell within a container running HOME, a home environment.
+When COMMAND is a non-empty list, execute it in the container and exit
+immediately. Return the exit status of the process in the container."
+ (define passwd (getpwuid (getuid)))
+ (define home-directory (or (getenv "HOME") (passwd:dir passwd)))
+ (define host (gethostname))
+ (define uid 1000)
+ (define gid 1000)
+ (define user-name (passwd:name passwd))
+ (define user-real-name (passwd:gecos passwd))
+
+ (define (optional-mapping mapping)
+ (and (file-exists? (file-system-mapping-source mapping))
+ mapping))
+
+ (define network-mappings
+ (if network?
+ (filter-map optional-mapping %network-file-mappings)
+ '()))
+
+ (eval/container
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules `(((guix config) => ,(make-config.scm))
+ ,@(source-module-closure
+ '((gnu build accounts)
+ (guix profiles)
+ (guix build utils)
+ (guix build syscalls))
+ #:select? not-config?))
+ #~(begin
+ (use-modules (guix build utils)
+ (gnu build accounts)
+ ((guix build syscalls)
+ #:select (set-network-interface-up)))
+
+ (define shell
+ #$(user-shell))
+
+ (define term
+ #$(getenv "TERM"))
+
+ (define passwd
+ (password-entry
+ (name #$user-name)
+ (real-name #$user-real-name)
+ (uid #$uid) (gid #$gid) (shell shell)
+ (directory #$home-directory)))
+
+ (define groups
+ (list (group-entry (name "users") (gid #$gid))
+ (group-entry (gid 65534) ;the overflow GID
+ (name "overflow"))))
+
+ ;; (guix profiles) loads (guix utils), which calls 'getpw' from the
+ ;; top level. Thus, arrange so that it's loaded after /etc/passwd
+ ;; has been created.
+ (module-autoload! (current-module)
+ '(guix profiles) '(load-profile))
+
+ ;; Create /etc/passwd for applications that need it, such as mcron.
+ (mkdir-p "/etc")
+ (write-passwd (list passwd))
+ (write-group groups)
+
+ (unless #$network?
+ ;; When isolated from the network, provide a minimal /etc/hosts
+ ;; to resolve "localhost".
+ (call-with-output-file "/etc/hosts"
+ (lambda (port)
+ (display "127.0.0.1 localhost\n" port)
+ (chmod port #o444))))
+
+ ;; Set PATH for things that the activation script might expect, such
+ ;; as "env".
+ (load-profile #$system-profile)
+
+ (mkdir-p #$home-directory)
+ (setenv "HOME" #$home-directory)
+ (setenv "GUIX_NEW_HOME" #$home)
+ (primitive-load (string-append #$home "/activate"))
+ (setenv "GUIX_NEW_HOME" #f)
+
+ (when term
+ ;; Preserve TERM for proper interactive use.
+ (setenv "TERM" term))
+
+ (chdir #$home-directory)
+
+ ;; Invoke SHELL with argv[0] starting with "-": that's how shells
+ ;; figure out that they are login shells!
+ (execl shell (string-append "-" (basename shell))
+ #$@(match command
+ (() #~())
+ ((_ ...)
+ #~("-c" #$(string-join command))))))))
+
+ #:namespaces (if network?
+ (delq 'net %namespaces) ; share host network
+ %namespaces)
+ #:mappings (append network-mappings mappings)
+ #:guest-uid uid
+ #:guest-gid gid))
+
+
;;;
;;; Actions.
;;;
@@ -208,7 +387,12 @@ Some ACTIONS support additional ARGS.\n"))
derivations-only?
use-substitutes?
(graph-backend "graphviz")
- (validate-reconfigure ensure-forward-reconfigure))
+ (validate-reconfigure ensure-forward-reconfigure)
+
+ ;; Container options.
+ (file-system-mappings '())
+ (container-command '())
+ network?)
"Perform ACTION for home environment. "
(define println
@@ -237,24 +421,37 @@ Some ACTIONS support additional ARGS.\n"))
(he-out-path -> (derivation->output-path he-drv)))
(if (or dry-run? derivations-only?)
(return #f)
- (begin
- (for-each (compose println derivation->output-path) drvs)
-
- (case action
- ((reconfigure)
- (let* ((number (generation-number %guix-home))
- (generation (generation-file-name
- %guix-home (+ 1 number))))
-
- (switch-symlinks generation he-out-path)
- (switch-symlinks %guix-home generation)
- (setenv "GUIX_NEW_HOME" he-out-path)
- (primitive-load (string-append he-out-path "/activate"))
- (setenv "GUIX_NEW_HOME" #f)
- (return he-out-path)))
- (else
- (newline)
- (return he-out-path)))))))))
+ (case action
+ ((reconfigure)
+ (let* ((number (generation-number %guix-home))
+ (generation (generation-file-name
+ %guix-home (+ 1 number))))
+
+ (switch-symlinks generation he-out-path)
+ (switch-symlinks %guix-home generation)
+ (setenv "GUIX_NEW_HOME" he-out-path)
+ (primitive-load (string-append he-out-path "/activate"))
+ (setenv "GUIX_NEW_HOME" #f)
+ (return he-out-path)))
+ ((container)
+ (mlet %store-monad ((status (spawn-home-container
+ he
+ #:network? network?
+ #:mappings file-system-mappings
+ #:command
+ container-command)))
+ (match (status:exit-val status)
+ (0 (return #t))
+ ((? integer? n) (return (exit n)))
+ (#f
+ (if (status:term-sig status)
+ (leave (G_ "process terminated with signal ~a~%")
+ (status:term-sig status))
+ (leave (G_ "process stopped with signal ~a~%")
+ (status:stop-sig status)))))))
+ (else
+ (for-each (compose println derivation->output-path) drvs)
+ (return he-out-path))))))))
(define (process-action action args opts)
"Process ACTION, a sub-command, with the arguments are listed in ARGS.
@@ -293,6 +490,10 @@ resulting from command-line parsing."
(else
(leave (G_ "no configuration specified~%")))))))
+ (mappings (filter-map (match-lambda
+ (('file-system-mapping . mapping) mapping)
+ (_ #f))
+ opts))
(dry? (assoc-ref opts 'dry-run?)))
(with-store store
@@ -315,7 +516,11 @@ resulting from command-line parsing."
#:validate-reconfigure
(assoc-ref opts 'validate-reconfigure)
#:graph-backend
- (assoc-ref opts 'graph-backend))))))
+ (assoc-ref opts 'graph-backend)
+ #:network? (assoc-ref opts 'network?)
+ #:file-system-mappings mappings
+ #:container-command
+ (or (assoc-ref opts 'container-command) '()))))))
(warn-about-disk-space)))
@@ -404,7 +609,7 @@ deploy the home environment described by these files.\n")
list-generations describe
delete-generations roll-back
switch-generation search
- import)
+ import container)
(alist-cons 'action action result))
(else (leave (G_ "~a: unknown action~%") action))))))
@@ -442,11 +647,28 @@ deploy the home environment described by these files.\n")
(fail))))
args))
+ (define (parse-args args)
+ ;; Parse the list of command line arguments ARGS.
+
+ ;; The '--' token is used to separate the command to run from the rest of
+ ;; the operands.
+ (let* ((args rest (break (cut string=? "--" <>) args))
+ (opts (parse-command-line args %options (list %default-options)
+ #:argument-handler
+ parse-sub-command)))
+ (match rest
+ (() opts)
+ (("--") opts)
+ (("--" command ...)
+ (match (assoc-ref opts 'action)
+ ('container
+ (alist-cons 'container-command command opts))
+ (_
+ (leave (G_ "~a: extraneous command~%")
+ (string-join command))))))))
+
(with-error-handling
- (let* ((opts (parse-command-line args %options
- (list %default-options)
- #:argument-handler
- parse-sub-command))
+ (let* ((opts (parse-args args))
(args (option-arguments opts))
(command (assoc-ref opts 'action)))
(parameterize ((%graft? (assoc-ref opts 'graft?)))
diff --git a/tests/guix-home.sh b/tests/guix-home.sh
index 48dbcbd28f..0f68484ef4 100644
--- a/tests/guix-home.sh
+++ b/tests/guix-home.sh
@@ -26,6 +26,16 @@ set -e
guix home --version
+container_supported ()
+{
+ if guile -c '((@ (guix scripts environment) assert-container-features))'
+ then
+ return 0
+ else
+ return 1
+ fi
+}
+
NIX_STORE_DIR="$(guile -c '(use-modules (guix config))(display %storedir)')"
localstatedir="$(guile -c '(use-modules (guix config))(display
%localstatedir)')"
GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
@@ -47,20 +57,6 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf
"$test_directory"' EXIT
(
cd "$test_directory" || exit 77
- HOME="$test_directory"
- export HOME
-
- #
- # Test 'guix home reconfigure'.
- #
-
- echo "# This file will be overridden and backed up." > "$HOME/.bashrc"
- mkdir "$HOME/.config"
- echo "This file will be overridden too." > "$HOME/.config/test.conf"
- echo "This file will stay around." > "$HOME/.config/random-file"
-
- echo -n "# dot-bashrc test file for guix home" > "dot-bashrc"
-
cat > "home.scm" <<'EOF'
(use-modules (guix gexp)
(gnu home)
@@ -93,6 +89,8 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf
"$test_directory"' EXIT
"# the content of bashrc-test-config.sh"))))))))
EOF
+ echo -n "# dot-bashrc test file for guix home" > "dot-bashrc"
+
# Check whether the graph commands work as expected.
guix home extension-graph "home.scm" | grep 'label = "home-activation"'
guix home extension-graph "home.scm" | grep 'label =
"home-symlink-manager"'
@@ -101,6 +99,37 @@ EOF
# There are no Shepherd services so the one below must fail.
! guix home shepherd-graph "home.scm"
+ if container_supported
+ then
+ # Run the home in a container.
+ guix home container home.scm -- true
+ ! guix home container home.scm -- false
+ test "$(guix home container home.scm -- echo '$HOME')" = "$HOME"
+ guix home container home.scm -- cat '~/.config/test.conf' | \
+ grep "the content of"
+ guix home container home.scm -- test -h '~/.bashrc'
+ test "$(guix home container home.scm -- id -u)" = 1000
+ ! guix home container home.scm -- test -f '$HOME/sample/home.scm'
+ guix home container home.scm --expose="$PWD=$HOME/sample" -- \
+ test -f '$HOME/sample/home.scm'
+ ! guix home container home.scm --expose="$PWD=$HOME/sample" -- \
+ rm -v '$HOME/sample/home.scm'
+ else
+ echo "'guix home container' test SKIPPED" >&2
+ fi
+
+ HOME="$test_directory"
+ export HOME
+
+ #
+ # Test 'guix home reconfigure'.
+ #
+
+ echo "# This file will be overridden and backed up." > "$HOME/.bashrc"
+ mkdir "$HOME/.config"
+ echo "This file will be overridden too." > "$HOME/.config/test.conf"
+ echo "This file will stay around." > "$HOME/.config/random-file"
+
guix home reconfigure "${test_directory}/home.scm"
test -d "${HOME}/.guix-home"
test -h "${HOME}/.bash_profile"