From 87241947aa2c0148a6f06989057a113c57ea9208 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 1 Apr 2020 14:59:58 +0200 Subject: [PATCH] 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 c0d4d44091..d46b588f53 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 +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2016 Chris Marusich ;;; ;;; 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