08/52: DRAFT: Add (gnu system hurd).

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit 7079eb34e5e74240aa383e2ab668c5bcb8696914
Author: Ludovic Courtès <address@hidden>
AuthorDate: Wed Apr 1 16:18:23 2020 +0200

    DRAFT: Add (gnu system hurd).
    
    DRAFT: This needs some more testing.
    
    * gnu/system/hurd.scm: New file.
    * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 gnu/local.mk        |   1 +
 gnu/system/hurd.scm | 111 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 112 insertions(+)

diff --git a/gnu/local.mk b/gnu/local.mk
index b1c8a75..e8409a9 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -598,6 +598,7 @@ GNU_SYSTEM_MODULES =                                \
   %D%/system.scm                               \
   %D%/system/accounts.scm                      \
   %D%/system/file-systems.scm                  \
+  %D%/system/hurd.scm                          \
   %D%/system/install.scm                       \
   %D%/system/keyboard.scm                      \
   %D%/system/linux-container.scm               \
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
new file mode 100644
index 0000000..586bfa0
--- /dev/null
+++ b/gnu/system/hurd.scm
@@ -0,0 +1,111 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Ludovic Courtès <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system hurd)
+  #:use-module (guix gexp)
+  #:use-module (guix utils)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages cross-base)
+  #:use-module (gnu packages hurd)
+  #:use-module (gnu system vm)
+  #:export (cross-hurd-image))
+
+;;; Commentary:
+;;;
+;;; This module provides tools to (cross-)build GNU/Hurd virtual machine
+;;; images.
+;;;
+;;; Code:
+
+(define* (cross-hurd-image #:key (hurd hurd) (gnumach gnumach))
+  "Return a cross-built GNU/Hurd image."
+  (define hurd-os
+    (let-syntax ((for-hurd (syntax-rules ()
+                             ((_ things ...)
+                              (list (with-parameters ((%current-target-system
+                                                       "i586-pc-gnu"))
+                                      things) ...)))))
+      (directory-union "gnu+hurd"
+                       (cons (with-parameters ((%current-system "i686-linux"))
+                               gnumach)
+                             (for-hurd hurd coreutils grep sed)))))
+
+  (define grub.cfg
+    (let ((hurd (with-parameters ((%current-target-system "i586-pc-gnu"))
+                  hurd))
+          (mach (with-parameters ((%current-system "i686-linux"))
+                  gnumach))
+          (libc (cross-libc "i586-pc-gnu")))
+      (computed-file "grub.cfg"
+                     #~(call-with-output-file #$output
+                         (lambda (port)
+                           (format port "
+set timeout=2
+search.file ~a/boot/gnumach
+
+menuentry \"GNU\" {
+  multiboot ~a/boot/gnumach root=device:hd0s1
+  module ~a/hurd/ext2fs.static ext2fs \\
+    --multiboot-command-line='${kernel-command-line}' \\
+    --host-priv-port='${host-port}' \\
+    --device-master-port='${device-port}' \\
+    --exec-server-task='${exec-task}' -T typed '${root}' \\
+    '$(task-create)' '$(task-resume)'
+  module ~a/lib/ld.so.1 exec ~a/hurd/exec '$(exec-task=task-create)'
+}\n"
+                                   #+mach #+mach #+hurd
+                                   #+libc #+hurd))))))
+
+  (define hurd-directives
+    `((directory "/servers")
+      ,@(map (lambda (server)
+               `(file ,(string-append "/servers/" server)))
+             '("startup" "exec" "proc" "password"
+               "default-pager" "crash-dump-core"
+               "kill" "suspend"))
+      ("/servers/crash" -> "crash-dump-core")
+      (directory "/servers/socket")
+      (file "/servers/socket/1")
+      (file "/servers/socket/2")
+      (file "/servers/socket/16")
+      ("/servers/socket/local" -> "1")
+      ("/servers/socket/inet" -> "2")
+      ("/servers/socket/inet6" -> "16")
+      (file "/etc/resolv.conf"
+            "nameserver 10.0.2.3\n")
+      (directory "/boot")
+      ("/boot/grub.cfg" -> ,grub.cfg)  ;XXX: not strictly needed
+      ("/hurd" -> ,(file-append (with-parameters ((%current-target-system
+                                                   "i586-pc-gnu"))
+                                  hurd)
+                                "/hurd"))))
+
+  (qemu-image #:file-system-type "ext2"
+              #:file-system-options '("-o" "hurd")
+              #:inputs `(("system" ,hurd-os)
+                         ("grub.cfg" ,grub.cfg))
+              #:copy-inputs? #t
+              #:os hurd-os
+              #:bootcfg-drv grub.cfg
+              #:bootloader grub-bootloader
+              #:register-closures? #f
+              #:extra-directives hurd-directives))
+
+;; Return this thunk so one can type "guix build -f gnu/system/hurd.scm".
+cross-hurd-image