aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-02-02 20:41:53 +0100
committerLudovic Courtès <ludo@gnu.org>2014-02-02 20:41:53 +0100
commit682b6599d775d0d6a594d84a38170bbd80fa6306 (patch)
treed48bb0a2b0e513ce9ba3313dd7303115988fa429 /gnu
parentba6f8e423e582ad1fc1b164317d158e3e1c0f6af (diff)
downloadguix-682b6599d775d0d6a594d84a38170bbd80fa6306.tar
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')
-rw-r--r--gnu/system/vm.scm18
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))))