gnu: vm: Make a union of the visible packages; add /etc/profile.

* gnu/system/vm.scm (qemu-image): Add Guix as an input when
  INITIALIZE-STORE?.
  (union): New procedure.
  (system-qemu-image): Use it.  Build /etc/profile.  Pass PROFILE among
  #:inputs-to-copy instead of listing all the individual profiles.
  Remove explicit 'build-derivations' call.
This commit is contained in:
Ludovic Courtès 2013-09-25 17:30:29 +02:00
parent 37c58656eb
commit 0b86a82dc7
1 changed files with 64 additions and 7 deletions

View File

@ -23,6 +23,8 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module ((gnu packages base) #:select (%final-inputs #:use-module ((gnu packages base) #:select (%final-inputs
guile-final guile-final
gcc-final
glibc-final
coreutils)) coreutils))
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
@ -366,6 +368,9 @@ It can be used to provide additional files, such as /etc files."
,@(if populate ,@(if populate
`(("populate" ,populate)) `(("populate" ,populate))
'()) '())
,@(if initialize-store?
`(("guix" ,guix-0.4))
'())
,@inputs-to-copy) ,@inputs-to-copy)
#:make-disk-image? #t #:make-disk-image? #t
@ -379,6 +384,38 @@ It can be used to provide additional files, such as /etc files."
;;; Stand-alone VM image. ;;; Stand-alone VM image.
;;; ;;;
(define* (union store inputs
#:key (guile (%guile-for-build)) (system (%current-system))
(name "union"))
"Return a derivation that builds the union of INPUTS. INPUTS is a list of
input tuples."
(define builder
`(begin
(use-modules (guix build union))
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
(let ((output (assoc-ref %outputs "out"))
(inputs (map cdr %build-inputs)))
(format #t "building union `~a' with ~a packages...~%"
output (length inputs))
(union-build output inputs))))
(build-expression->derivation store name system builder
(map (match-lambda
((name (? package? p))
`(,name ,(package-derivation store p
system)))
((name (? package? p) output)
`(,name ,(package-derivation store p
system)
,output))
(x x))
inputs)
#:modules '((guix build union))
#:guile-for-build guile))
(define (system-qemu-image store) (define (system-qemu-image store)
"Return the derivation of a QEMU image of the GNU system." "Return the derivation of a QEMU image of the GNU system."
(define %pam-services (define %pam-services
@ -410,6 +447,29 @@ It can be used to provide additional files, such as /etc files."
"root:x:0:\n")) "root:x:0:\n"))
(pam.d-drv (pam-services->directory store %pam-services)) (pam.d-drv (pam-services->directory store %pam-services))
(pam.d (derivation->output-path pam.d-drv)) (pam.d (derivation->output-path pam.d-drv))
(packages `(("coreutils" ,coreutils)
("bash" ,bash)
("guile" ,guile-2.0)
("dmd" ,dmd)
("gcc" ,gcc-final)
("libc" ,glibc-final)
("guix" ,guix-0.4)))
;; TODO: Replace with a real profile with a manifest.
;; TODO: Generate bashrc from packages' search-paths.
(profile-drv (union store packages
#:name "default-profile"))
(profile (derivation->output-path profile-drv))
(bashrc (add-text-to-store store "bashrc"
(string-append "
export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin
export CPATH=$HOME/.guix-profile/include:" profile "/include
export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
alias ls='ls -p --color'
alias ll='ls -l'
")))
(populate (populate
(add-text-to-store store "populate-qemu-image" (add-text-to-store store "populate-qemu-image"
(object->string (object->string
@ -422,6 +482,7 @@ It can be used to provide additional files, such as /etc files."
(symlink "/dev/null" (symlink "/dev/null"
"etc/login.defs") "etc/login.defs")
(symlink ,pam.d "etc/pam.d") (symlink ,pam.d "etc/pam.d")
(symlink ,bashrc "etc/profile")
(mkdir-p "var/run"))) (mkdir-p "var/run")))
(list passwd))) (list passwd)))
(out (derivation->output-path (out (derivation->output-path
@ -438,7 +499,6 @@ It can be used to provide additional files, such as /etc files."
,(string-append "--load=" boot))) ,(string-append "--load=" boot)))
(initrd gnu-system-initrd)))) (initrd gnu-system-initrd))))
(grub.cfg (grub-configuration-file store entries))) (grub.cfg (grub-configuration-file store entries)))
(build-derivations store (list pam.d-drv))
(qemu-image store (qemu-image store
#:grub-configuration grub.cfg #:grub-configuration grub.cfg
#:populate populate #:populate populate
@ -447,12 +507,8 @@ It can be used to provide additional files, such as /etc files."
#:inputs-to-copy `(("boot" ,boot) #:inputs-to-copy `(("boot" ,boot)
("linux" ,linux-libre) ("linux" ,linux-libre)
("initrd" ,gnu-system-initrd) ("initrd" ,gnu-system-initrd)
("coreutils" ,coreutils) ("pam.d" ,pam.d-drv)
("bash" ,bash) ("profile" ,profile-drv)
("guile" ,guile-2.0)
("mingetty" ,mingetty)
("dmd" ,dmd)
("guix" ,guix-0.4)
;; Configuration. ;; Configuration.
("dmd.conf" ,dmd-conf) ("dmd.conf" ,dmd-conf)
@ -460,6 +516,7 @@ It can be used to provide additional files, such as /etc files."
("etc-passwd" ,passwd) ("etc-passwd" ,passwd)
("etc-shadow" ,shadow) ("etc-shadow" ,shadow)
("etc-group" ,group) ("etc-group" ,group)
("etc-bashrc" ,bashrc)
,@(append-map service-inputs ,@(append-map service-inputs
%dmd-services)))))) %dmd-services))))))