diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-02-02 20:41:53 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-02-02 20:41:53 +0100 |
| commit | 682b6599d775d0d6a594d84a38170bbd80fa6306 (patch) | |
| tree | d48bb0a2b0e513ce9ba3313dd7303115988fa429 /gnu/system/vm.scm | |
| parent | ba6f8e423e582ad1fc1b164317d158e3e1c0f6af (diff) | |
| download | gnu-guix-682b6599d775d0d6a594d84a38170bbd80fa6306.tar gnu-guix-682b6599d775d0d6a594d84a38170bbd80fa6306.tar.gz | |
gnu: vm: Create all the user directories.
* gnu/system/vm.scm (operating-system-default-contents)[user-directories]:
New procedure. Use it to create each user's home and GC root
directories.
Diffstat (limited to 'gnu/system/vm.scm')
| -rw-r--r-- | gnu/system/vm.scm | 18 |
1 files changed, 14 insertions, 4 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 00edc8e40b..1bdd2c6e92 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -458,6 +458,16 @@ such as /etc files." (define (operating-system-default-contents os) "Return a list of directives suitable for 'system-qemu-image' describing the basic contents of the root file system of OS." + (define (user-directories user) + (let ((home (user-account-home-directory user)) + ;; XXX: Deal with automatically allocated ids. + (uid (or (user-account-uid user) 0)) + (gid (or (user-account-gid user) 0)) + (root (string-append "/var/nix/profiles/per-user/" + (user-account-name user)))) + `((directory ,root ,uid ,gid) + (directory ,home ,uid ,gid)))) + (mlet* %store-monad ((os-drv (operating-system-derivation os)) (os-dir -> (derivation->output-path os-drv)) (build-gid (operating-system-build-gid os)) @@ -471,12 +481,12 @@ basic contents of the root file system of OS." (directory "/run") ("/run/current-system" -> ,profile) (directory "/bin") - ("/bin/sh" -> "/run/current-system/bin/sh") + ("/bin/sh" -> "/run/current-system/bin/bash") (directory "/tmp") (directory "/var/nix/profiles/per-user/root" 0 0) - (directory "/var/nix/profiles/per-user/guest" - 1000 100) - (directory "/home/guest" 1000 100))))) + + ,@(append-map user-directories + (operating-system-users os)))))) (define* (system-qemu-image #:optional (os %demo-operating-system) #:key (disk-image-size (* 900 (expt 2 20)))) |