[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/04: HACK system: vm: Move system/hurd.scm hacks here.
|
From: |
guix-commits |
|
Subject: |
04/04: HACK system: vm: Move system/hurd.scm hacks here. |
|
Date: |
Sat, 2 May 2020 05:40:17 -0400 (EDT) |
janneke pushed a commit to branch wip-hurd-vm
in repository guix.
commit ae650e5289a7524082846bb4b807a7a500ed439f
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Sat May 2 11:25:24 2020 +0200
HACK system: vm: Move system/hurd.scm hacks here.
This now works
./pre-inst-env guix system build --target=i586-pc-gnu
gnu/system/examples/bare-hurd.tmpl
./pre-inst-env guix system vm-image --target=i586-pc-gnu
gnu/system/examples/bare-hurd.tmpl
TODO
* Remove build -f gnu/system/hurd.scm hack
* Fix/implement file-systems, loopback, syslogd, user-processes, then
* Remove hurd-shepherd.conf-hack that filters those
* Remove "HACK service: hurd ..." commits
* Break RC -> /boot/activation -> shepherd bootstrap cycle
---
gnu/system/vm.scm | 128 ++++++++++++++++++++++++++++++++++++++++++------------
1 file changed, 101 insertions(+), 27 deletions(-)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 12caec4..d279a1c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -30,6 +30,7 @@
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix modules)
+ #:use-module (guix profiles)
#:use-module (guix utils)
#:use-module (gcrypt hash)
#:use-module (guix base32)
@@ -39,6 +40,7 @@
#:select (qemu-command))
#:use-module (gnu packages base)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages bootstrap)
#:use-module (gnu packages cdrom)
#:use-module (gnu packages compression)
#:use-module (gnu packages guile)
@@ -55,6 +57,7 @@
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
+ #:use-module (gnu system hurd)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
#:use-module (gnu system linux-container)
@@ -362,7 +365,7 @@ INPUTS is a list of inputs (as for packages)."
(define* (qemu-image #:key
(name "qemu-image")
(system (%current-system))
- (target (if (hurd-target?) #f (%current-target-system)))
+ (target (%current-target-system))
(qemu qemu-minimal)
(disk-image-size 'guess)
(disk-image-format "qcow2")
@@ -797,41 +800,112 @@ of the GNU system as described by OS."
'iso9660
'dce)))
+ (define (cross-built thing)
+ (with-parameters ((%current-target-system "i586-pc-gnu"))
+ thing))
+
+ (define (cross-built-entry entry)
+ (manifest-entry
+ (inherit entry)
+ (item (cross-built (manifest-entry-item entry)))
+ (dependencies (map cross-built-entry
+ (manifest-entry-dependencies entry)))))
+
+ (define (cross-bootstrap thing)
+ (with-parameters ((%current-system "i586-gnu"))
+ thing))
+
+ (define (cross-bootstrap-entry entry)
+ (manifest-entry
+ (inherit entry)
+ (item (cross-bootstrap (manifest-entry-item entry)))))
+
+ (define (cross-system os)
+ (concatenate-manifests
+ (list (map-manifest-entries cross-built-entry
+ (packages->manifest
(operating-system-packages os)))
+ (map-manifest-entries cross-bootstrap-entry
+ (packages->manifest (list %bootstrap-gcc
+ %bootstrap-binutils
+
%bootstrap-glibc))))))
(let* ((os (operating-system (inherit os)
- ;; Assume we have an initrd with the whole QEMU shebang.
-
- ;; Force our own root file system. Refer to it by UUID so that
- ;; it works regardless of how the image is used ("qemu -hda",
- ;; Xen, etc.).
- (file-systems (cons (file-system
- (mount-point "/")
- (device root-uuid)
- (type file-system-type))
- file-systems-to-keep))))
+ ;; Assume we have an initrd with the whole QEMU
shebang.
+
+ ;; Force our own root file system. Refer to it
by UUID so that
+ ;; it works regardless of how the image is used
("qemu -hda",
+ ;; Xen, etc.).
+ (file-systems (cons (file-system
+ (mount-point "/")
+ (device root-uuid)
+ (type file-system-type))
+ file-systems-to-keep))))
+ ;; QEMU-IMAGE will run a LINUX-VM for TARGET
+ ;; For TARGET-HURD, have QEMU-IMAGE create a native VM
+ ;; and cross-compile the content ourselves
+ (hurd-cross? (and (%current-target-system) (hurd-target?)))
+ (target (if hurd-cross? #f (%current-target-system)))
+ (bootloader (bootloader-configuration-bootloader
+ (operating-system-bootloader os)))
(bootcfg (operating-system-bootcfg os))
- (hurd (and (hurd-target?)
- (with-parameters ((%current-target-system "i586-pc-gnu"))
hurd))))
+ (boot-activation (and (hurd-target?)
+ (cross-built
+ (operating-system-activation-script os))))
+ (shepherd.conf (and (hurd-target?) (hurd-shepherd.conf-hack os)))
+ (os (if hurd-cross?
+ (with-parameters ((%current-target-system "i586-pc-gnu")) os)
+ os))
+ (bootcfg (if hurd-cross? (cross-built bootcfg) bootcfg))
+ (hurd (and (hurd-target?) (if hurd-cross? (cross-built hurd))))
+ (etc-shepherd.conf (if hurd-cross? (cross-built shepherd.conf)
shepherd.conf))
+ (etc-motd (and hurd (file-append hurd "/etc/motd")))
+ (etc-ttys (and hurd (file-append hurd "/etc/ttys")))
+ (etc-login (and hurd (file-append hurd "/etc/login")))
+ (hurd-directives (if (hurd-target?)
+ `((directory "/servers")
+ ,@(map (lambda (server)
+ `(file ,(string-append "/servers/"
server)))
+ '("startup" "exec" "proc" "password"
+ "default-pager" "crash-dump-core"
+ "kill" "suspend"))
+ ("/hurd" -> ,(file-append hurd "/hurd"))
+ (directory "/boot")
+ ("/boot/activation" -> ,boot-activation)
+ (directory "/etc")
+ ("/etc/shepherd.conf" -> ,etc-shepherd.conf)
+ ("/etc/fstab" -> ,%hurd-boot-fstab)
+ ("/etc/login" -> ,etc-login)
+ ("/etc/motd" -> ,etc-motd)
+ ("/etc/passwd" -> ,%hurd-boot-passwd)
+ ("/etc/group" -> ,%hurd-boot-group)
+ ("/etc/shadow" -> ,%hurd-boot-shadow)
+ ("/etc/ttys" -> ,etc-ttys)
+ (directory "/etc/ssh")
+ (directory "/root"))
+ '())))
(qemu-image #:os os
+ #:target target
#:bootcfg-drv bootcfg
- #:bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os))
+ #:bootloader bootloader
#:disk-image-size disk-image-size
#:file-system-type file-system-type
#:file-system-uuid root-uuid
#:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))
- #:extra-directives
- (if (hurd-target?)
- `((directory "/servers")
- ,@(map (lambda (server)
- `(file ,(string-append "/servers/" server)))
- '("startup" "exec" "proc" "password"
- "default-pager" "crash-dump-core"
- "kill" "suspend"))
- ("/hurd" -> ,(file-append hurd "/hurd")))
- '())
- #:copy-inputs? #t)))
+ ("bootcfg" ,bootcfg)
+ ,@(if boot-activation
+ `(("boot-activation" ,boot-activation)
+ ("fstab" ,%hurd-boot-fstab)
+ ("login" ,etc-login)
+ ("motd" ,etc-motd)
+ ("passwd" ,%hurd-boot-passwd)
+ ("group" ,%hurd-boot-group)
+ ("shadow" ,%hurd-boot-shadow)
+ ("shepherd.conf" ,etc-shepherd.conf)
+ ("ttys" ,etc-ttys))
+ '()))
+ #:extra-directives hurd-directives
+ #:copy-inputs? #t
+ #:register-closures? (not hurd-cross?))))
;;;