gnu: vm: Set the right permissions and ownership on directories.

* gnu/system/vm.scm (qemu-image): Change the store's mode to #o1775.
  Support 'populate' clauses that specify a UID and GID.
  (system-qemu-image): Make sure /nix/store has owner 'root' and group
  'guixbuild'.  Set the right owner for /home/guest.  Create
  /var/nix/profiles/per-user/{root,guest}.
This commit is contained in:
Ludovic Courtès 2013-09-27 00:35:50 +02:00
parent fbd1c3e95b
commit 17886b3022

View file

@ -295,7 +295,7 @@ (define (graph-from-file file)
(begin (begin
(display "creating ext3 partition...\n") (display "creating ext3 partition...\n")
(and (zero? (system* mkfs "-F" "/dev/vda1")) (and (zero? (system* mkfs "-F" "/dev/vda1"))
(begin (let ((store (string-append "/fs" ,%store-directory)))
(display "mounting partition...\n") (display "mounting partition...\n")
(mkdir "/fs") (mkdir "/fs")
(mount "/dev/vda1" "/fs" "ext3") (mount "/dev/vda1" "/fs" "ext3")
@ -303,7 +303,8 @@ (define (graph-from-file file)
(symlink grub.cfg "/fs/boot/grub/grub.cfg") (symlink grub.cfg "/fs/boot/grub/grub.cfg")
;; Populate the image's store. ;; Populate the image's store.
(mkdir-p (string-append "/fs" ,%store-directory)) (mkdir-p store)
(chmod store #o1775)
(for-each (lambda (thing) (for-each (lambda (thing)
(copy-recursively thing (copy-recursively thing
(string-append "/fs" (string-append "/fs"
@ -337,6 +338,12 @@ (define (graph-from-file file)
(loop rest (loop rest
(cons `(mkdir-p ,(string-append "/fs" name)) (cons `(mkdir-p ,(string-append "/fs" name))
statements))) statements)))
((('directory name uid gid) rest ...)
(let ((dir (string-append "/fs" name)))
(loop rest
(cons* `(chown ,dir ,uid ,gid)
`(mkdir-p ,dir)
statements))))
(((new '-> old) rest ...) (((new '-> old) rest ...)
(loop rest (loop rest
(cons `(symlink ,old (cons `(symlink ,old
@ -462,8 +469,10 @@ (define %dmd-services
(static-networking-service store "eth0" "10.0.2.10" (static-networking-service store "eth0" "10.0.2.10"
#:gateway "10.0.2.2"))) #:gateway "10.0.2.2")))
(define build-user-gid 30000)
(define build-accounts (define build-accounts
(guix-build-accounts store 10)) (guix-build-accounts store 10 #:gid build-user-gid))
(define resolv.conf (define resolv.conf
;; Name resolution for default QEMU settings. ;; Name resolution for default QEMU settings.
@ -512,7 +521,7 @@ (define etc-rpc
(members '("guest"))) (members '("guest")))
(user-group (user-group
(name "guixbuild") (name "guixbuild")
(id 30000) (id build-user-gid)
(members (map user-account-name (members (map user-account-name
build-accounts)))))) build-accounts))))))
(pam.d-drv (pam-services->directory store %pam-services)) (pam.d-drv (pam-services->directory store %pam-services))
@ -552,7 +561,8 @@ (define etc-rpc
You can log in as 'guest' or 'root' with no password. You can log in as 'guest' or 'root' with no password.
")) "))
(populate `((directory "/etc") (populate `((directory "/nix/store" 0 ,build-user-gid)
(directory "/etc")
(directory "/var/log") ; for dmd (directory "/var/log") ; for dmd
(directory "/var/run/nscd") (directory "/var/run/nscd")
("/etc/shadow" -> ,shadow) ("/etc/shadow" -> ,shadow)
@ -568,7 +578,11 @@ (define etc-rpc
("/etc/rpc" -> ,etc-rpc) ("/etc/rpc" -> ,etc-rpc)
(directory "/var/nix/gcroots") (directory "/var/nix/gcroots")
("/var/nix/gcroots/default-profile" -> ,profile) ("/var/nix/gcroots/default-profile" -> ,profile)
(directory "/home/guest"))) (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)))
(out (derivation->output-path (out (derivation->output-path
(package-derivation store mingetty))) (package-derivation store mingetty)))
(boot (add-text-to-store store "boot" (boot (add-text-to-store store "boot"