mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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.
This commit is contained in:
parent
8c83069b99
commit
87241947aa
1 changed files with 14 additions and 4 deletions
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
|
@ -67,6 +67,13 @@ (define (evaluate-populate-directive directive 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 @@ (define (directives 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
|
||||
|
|
Loading…
Reference in a new issue