ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: vm: Change #:populate to a list of directives.

Browse source 
* gnu/system/vm.scm (qemu-image): Change 'populate' parameter to be a
  list of directives.
  (system-qemu-image): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2013-09-25 18:01:44 +02:00
parent 25eb16bf3b
commit d5d0f286a2
1 changed files with 28 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
gnu/system/vm.scm
View file

@ -211,9 +211,10 @@ (define* (qemu-image store #:key
into the image being built. When INITIALIZE-STORE? is true, initialize the
store database in the image so that Guix can be used in the image.
When POPULATE is true, it must be the store file name of a Guile script to run
in the disk image partition once it has been populated with INPUTS-TO-COPY.
It can be used to provide additional files, such as /etc files."
POPULATE is a list of directives stating directories or symlinks to be created
in the disk image partition. It is evaluated once the image has been
populated with INPUTS-TO-COPY. It can be used to provide additional files,
such as /etc files."
(define input->name+derivation
(match-lambda
((name (? package? package))
@ -326,6 +327,22 @@ (define (graph-from-file file)
graph-files)))
'(#f)))
;; Evaluate the POPULATE directives.
,@(let loop ((directives populate)
(statements '()))
(match directives
(()
(reverse statements))
((('directory name) rest ...)
(loop rest
(cons `(mkdir-p ,(string-append "/fs" name))
statements)))
(((new '-> old) rest ...)
(loop rest
(cons `(symlink ,old
,(string-append "/fs" new))
statements)))))
(and=> (assoc-ref %build-inputs "populate")
(lambda (populate)
(chdir "/fs")
@ -365,9 +382,6 @@ (define (graph-from-file file)
("gawk" ,(car (assoc-ref %final-inputs "gawk")))
("util-linux" ,util-linux)
,@(if populate
`(("populate" ,populate))
'())
,@(if initialize-store?
`(("guix" ,guix-0.4))
'())
@ -473,21 +487,14 @@ (define %dmd-services
alias ll='ls -l'
")))
(populate
(add-text-to-store store "populate-qemu-image"
(object->string
`(begin
(mkdir-p "etc")
(mkdir-p "var/log") ; for dmd
(symlink ,shadow "etc/shadow")
(symlink ,passwd "etc/passwd")
(symlink ,group "etc/group")
(symlink "/dev/null"
"etc/login.defs")
(symlink ,pam.d "etc/pam.d")
(symlink ,bashrc "etc/profile")
(mkdir-p "var/run")))
(list passwd)))
(populate `((directory "/etc")
(directory "/var/log")
(directory "/var/run")
("/etc/shadow" -> ,shadow)
("/etc/passwd" -> ,passwd)
("/etc/login.defs" -> "/dev/null")
("/etc/pam.d" -> ,pam.d)
("/etc/profile" -> ,bashrc)))
(out (derivation->output-path
(package-derivation store mingetty)))
(boot (add-text-to-store store "boot"