10/24: system: vm: Initial vm-image support for the Hurd.

[guix-commits]

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

commit 61fea5e6c2469a7636393c2fc02605c282a1c6a5
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Thu Apr 30 15:40:26 2020 +0200

    system: vm: Initial vm-image support for the Hurd.
    
    * gnu/system/vm.scm (system-qemu-image): When building for the Hurd, add
    hurd-directives.
---
 gnu/system/vm.scm | 21 ++++++++++++++++++---
 1 file changed, 18 insertions(+), 3 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a803977..34f967a 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -664,16 +664,31 @@ of the GNU system as described by OS."
                                      (device root-uuid)
                                      (type file-system-type))
                                    file-systems-to-keep))))
-         (bootcfg (operating-system-bootcfg os)))
+         (bootcfg (operating-system-bootcfg os))
+         (bootloader (bootloader-configuration-bootloader
+                      (operating-system-bootloader os)))
+         (hurd (operating-system-hurd os))
+         (hurd-directives (if hurd
+                              `((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"))
+                                ;; XXX remove ttys after adding hurd-getty 
service
+                                (directory "/etc")
+                                ("/etc/ttys" -> ,(file-append hurd 
"/etc/ttys")))
+                              '())))
     (qemu-image  #:os os
                  #: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 hurd-directives
                  #:copy-inputs? #t)))