diff options
| -rw-r--r-- | doc/guix.texi | 58 | ||||
| -rw-r--r-- | guix/scripts/home.scm | 272 | ||||
| -rw-r--r-- | 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 @@ -170,6 +209,146 @@ Some ACTIONS support additional ARGS.\n")) ;;; +;;; 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" |