mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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:
parent
ba6f8e423e
commit
682b6599d7
1 changed files with 14 additions and 4 deletions
|
@ -458,6 +458,16 @@ (define (operating-system-build-gid os)
|
|||
(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 @@ (define (operating-system-default-contents 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))))
|
||||
|
|
Loading…
Reference in a new issue