nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2014-02-02 20:41:53 +01:00
parent ba6f8e423e
commit 682b6599d7
1 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gnu/system/vm.scm
View File

@ -458,6 +458,16 @@ such as /etc files."
(define (operating-system-default-contents os) (define (operating-system-default-contents os)
"Return a list of directives suitable for 'system-qemu-image' describing the "Return a list of directives suitable for 'system-qemu-image' describing the
basic contents of the root file system of OS." 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)) (mlet* %store-monad ((os-drv (operating-system-derivation os))
(os-dir -> (derivation->output-path os-drv)) (os-dir -> (derivation->output-path os-drv))
(build-gid (operating-system-build-gid os)) (build-gid (operating-system-build-gid os))
@ -471,12 +481,12 @@ basic contents of the root file system of OS."
(directory "/run") (directory "/run")
("/run/current-system" -> ,profile) ("/run/current-system" -> ,profile)
(directory "/bin") (directory "/bin")
("/bin/sh" -> "/run/current-system/bin/sh") ("/bin/sh" -> "/run/current-system/bin/bash")
(directory "/tmp") (directory "/tmp")
(directory "/var/nix/profiles/per-user/root" 0 0) (directory "/var/nix/profiles/per-user/root" 0 0)
(directory "/var/nix/profiles/per-user/guest"
1000 100) ,@(append-map user-directories
(directory "/home/guest" 1000 100))))) (operating-system-users os))))))
(define* (system-qemu-image #:optional (os %demo-operating-system) (define* (system-qemu-image #:optional (os %demo-operating-system)
#:key (disk-image-size (* 900 (expt 2 20)))) #:key (disk-image-size (* 900 (expt 2 20))))