ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-27 04:59:27 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

install: 'populate-root-file-system' can be passed extra directives.

Browse source 
* 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:
Ludovic Courtès 2020-04-01 14:59:58 +02:00
parent 8c83069b99
commit 87241947aa
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 14 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
gnu/build/install.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -67,6 +67,13 @@ (define (evaluate-populate-directive directive target)
(('directory name uid gid mode) (('directory name uid gid mode)
(loop `(directory ,name ,uid ,gid)) (loop `(directory ,name ,uid ,gid))
(chmod (string-append target name) mode)) (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) ((new '-> old)
(let try () (let try ()
(catch 'system-error (catch 'system-error
@ -119,11 +126,14 @@ (define (directives store)
(directory "/home" 0 0))) (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 "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) (for-each (cut evaluate-populate-directive <> target)
(directives (%store-directory))) (append (directives (%store-directory)) extras))
;; Add system generation 1. ;; Add system generation 1.
(let ((generation-1 (string-append target (let ((generation-1 (string-append target