civodul pushed a commit to branch wip-hurd-vm
in repository guix.
commit 218bf04ab0f461ec9c9be0995502e804e64ae3ec
Author: Ludovic Courtès <[email protected]>
AuthorDate: Wed Apr 1 14:59:58 2020 +0200
install: 'populate-root-file-system' can be passed extra directives.
* gnu/build/install.scm (evaluate-populate-directive): Handle 'file'
directives.
(populate-root-file-system): Add #:extras parameter and honor it.
---
gnu/build/install.scm | 18 ++++++++++++++----
1 file changed, 14 insertions(+), 4 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index c0d4d44..d46b588 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès
<[email protected]>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès
<[email protected]>
;;; Copyright © 2016 Chris Marusich <[email protected]>
;;;
;;; This file is part of GNU Guix.
@@ -67,6 +67,13 @@ directory TARGET."
(('directory name uid gid mode)
(loop `(directory ,name ,uid ,gid))
(chmod (string-append target name) mode))
+ (('file name)
+ (call-with-output-file (string-append target name)
+ (const #t)))
+ (('file name (? string? content))
+ (call-with-output-file (string-append target name)
+ (lambda (port)
+ (display content port))))
((new '-> old)
(let try ()
(catch 'system-error
@@ -119,11 +126,14 @@ STORE."
(directory "/home" 0 0)))
-(define (populate-root-file-system system target)
+(define* (populate-root-file-system system target
+ #:key (extras '()))
"Make the essential non-store files and directories on TARGET. This
-includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM."
+includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM.
+EXTRAS is a list of directives appended to the built-in directives to populate
+TARGET."
(for-each (cut evaluate-populate-directive <> target)
- (directives (%store-directory)))
+ (append (directives (%store-directory)) extras))
;; Add system generation 1.
(let ((generation-1 (string-append target
