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.
This commit is contained in:
Ludovic Courtès
parent
cff9fee82a
commit
094a2cfbe4
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -168,6 +207,146 @@ Some ACTIONS support additional ARGS.\n"))
|
|||
(validate-reconfigure . ,ensure-forward-reconfigure)
|
||||
(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))))
|
||||
|
||||
(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)))))))))
|
||||
(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?)))
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Reference in New Issue