[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/04: WIP hurd-directives
|
From: |
guix-commits |
|
Subject: |
04/04: WIP hurd-directives |
|
Date: |
Sun, 24 May 2020 07:07:59 -0400 (EDT) |
janneke pushed a commit to branch wip-hurd-vm
in repository guix.
commit b605a3603198fc82b9a422082e5ed645deb876c9
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Thu May 21 08:31:31 2020 +0200
WIP hurd-directives
* gnu/build/image.scm (make-ext-image): Add #:options parameter.
(make-partition-image): Likewise, pass it.
(initialize-root-partition): Add #:make-device-nodes, #:extra-directives
parameters.
* gnu/system/image.scm (system-disk-image): Set mkfs options for the Hurd,
pass them to make-partition-image. Set extra-directives and
make-device-nodes, pass them to initialize.
---
gnu/build/image.scm | 38 +++++++++++++++++++++++---------------
gnu/system/image.scm | 28 +++++++++++++++++++++++++---
2 files changed, 48 insertions(+), 18 deletions(-)
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 087e2c7..9aa81b8 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -66,24 +66,27 @@ take the partition metadata size into account, take a 25%
margin."
(define* (make-ext-image partition target root
#:key
(owner-uid 0)
- (owner-gid 0))
+ (owner-gid 0)
+ (options '()))
"Handle the creation of EXT2/3/4 partition images. See
'make-partition-image'."
(let ((size (partition-size partition))
(fs (partition-file-system partition))
(label (partition-label partition))
(uuid (partition-uuid partition))
- (options "lazy_itable_init=1,lazy_journal_init=1"))
- (invoke "mke2fs" "-t" fs "-d" root
- "-L" label "-U" (uuid->string uuid)
- "-E" (format #f "root_owner=~a:~a,~a"
- owner-uid owner-gid options)
- target
- (format #f "~ak"
- (size-in-kib
- (if (eq? size 'guess)
- (estimate-partition-size root)
- size))))))
+ (journal-options "lazy_itable_init=1,lazy_journal_init=1"))
+ (apply invoke
+ `("mke2fs" "-t" ,fs "-d" ,root
+ "-L" ,label "-U" ,(uuid->string uuid)
+ "-E" ,(format #f "root_owner=~a:~a,~a"
+ owner-uid owner-gid journal-options)
+ ,@options
+ ,target
+ ,(format #f "~ak"
+ (size-in-kib
+ (if (eq? size 'guess)
+ (estimate-partition-size root)
+ size)))))))
(define* (make-vfat-image partition target root)
"Handle the creation of VFAT partition images. See 'make-partition-image'."
@@ -101,14 +104,14 @@ take the partition metadata size into account, take a 25%
margin."
(string-append "::" file))))
(scandir root))))
-(define* (make-partition-image partition-sexp target root)
+(define* (make-partition-image partition-sexp target root #:key (options '()))
"Create and return the image of PARTITION-SEXP as TARGET. Use the given
ROOT directory to populate the image."
(let* ((partition (sexp->partition partition-sexp))
(type (partition-file-system partition)))
(cond
((string-prefix? "ext" type)
- (make-ext-image partition target root))
+ (make-ext-image partition target root #:options options))
((string=? type "vfat")
(make-vfat-image partition target root))
(else
@@ -157,6 +160,8 @@ deduplicates files common to CLOSURE and the rest of
PREFIX."
references-graphs
(register-closures? #t)
system-directory
+ make-device-nodes
+ (extra-directives '())
#:allow-other-keys)
"Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to
install the bootloader configuration.
@@ -165,9 +170,12 @@ If REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS
in the store. If
DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the
rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
of the directory of the 'system' derivation."
- (populate-root-file-system system-directory root)
+ (populate-root-file-system system-directory root #:extras extra-directives)
(populate-store references-graphs root)
+ ;; Populate /dev.
+ (make-device-nodes root)
+
(when register-closures?
(for-each (lambda (closure)
(register-closure root
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 03588f7..328dfe9 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -154,12 +154,14 @@
(with-imported-modules `(,@(source-module-closure
'((gnu build vm)
(gnu build image)
+ (gnu build linux-boot)
(guix store database))
#:select? not-config?)
((guix config) => ,(make-config.scm)))
#~(begin
(use-modules (gnu build vm)
(gnu build image)
+ (gnu build linux-boot)
(guix store database)
(guix build utils))
gexp* ...))))
@@ -188,6 +190,8 @@
bootcfg
bootloader
register-closures?
+ (device-nodes (if (hurd-target?) 'hurd 'linux))
+ (extra-directives '())
(inputs '()))
"Return as a file-like object, the disk-image described by IMAGE. Said
image can be copied on a USB stick as is. BOOTLOADER is the bootloader that
@@ -256,6 +260,11 @@ used in the image."
(and (target-intel?
(or target system))
grub-efi))
+ #:extra-directives '#$extra-directives
+ #:make-device-nodes
+ #$(match device-nodes
+ ('linux #~make-essential-device-nodes)
+ ('hurd #~make-hurd-device-nodes))
#:bootloader-package
#+(bootloader-package bootloader)
#:bootloader-installer
@@ -267,13 +276,15 @@ used in the image."
(computed-file "partition-image-root" root-builder
#:options `(#:references-graphs ,inputs)))
(type (partition-file-system partition))
+ (options (if (hurd-target?) '("-o" "hurd" "-O" "ext_attr") '()))
(image-builder
(with-imported-modules*
(let ((inputs '#+(list e2fsprogs dosfstools mtools)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(make-partition-image #$(partition->gexp partition)
#$output
- #$image-root)))))
+ #$image-root
+ #:options '#$options)))))
(computed-file "partition.img" image-builder)))
(define (partition->config partition)
@@ -515,15 +526,26 @@ image, depending on IMAGE format."
(register-closures? (has-guix-service-type? os))
(bootcfg (operating-system-bootcfg os))
(bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os))))
+ (operating-system-bootloader os)))
+ (hurd (operating-system-hurd os))
+ (boot-activation (and hurd (operating-system-activation-script os)))
+ (hurd-directives (if hurd
+ `(("/hurd" -> ,(file-append hurd "/hurd"))
+ (directory "/boot")
+ ("/boot/activation" -> ,boot-activation))
+ '())))
(case (image-format image)
((disk-image)
(system-disk-image image*
#:bootcfg bootcfg
#:bootloader bootloader
#:register-closures? register-closures?
+ #:extra-directives hurd-directives
#:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))))
+ ("bootcfg" ,bootcfg)
+ ,@(if hurd
+ `(("boot-activation"
,boot-activation))
+ '()))))
((iso9660)
(system-iso9660-image image*
#:bootcfg bootcfg