aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/vm.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r--gnu/system/vm.scm49
1 files changed, 28 insertions, 21 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index d8c2b95d75..a0669ae865 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -211,9 +211,10 @@ INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied
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 @@ It can be used to provide additional files, such as /etc files."
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 @@ It can be used to provide additional files, such as /etc files."
("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 @@ alias ls='ls -p --color'
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"