bug#41541: merge wip-hurd-vm

[Jan Nieuwenhuizen <janneke@gnu.org>]

Mathieu Othacehe writes:

Hi!

>> Legend (in order of merge'ability / is there a convention for this?):
>>
>>   [M] Mathieu
>>   [L] Ludo
>>    g  good to go LGTM'd
>>    t  trivial (self-LGTM :-)
>>    .  direct dependency of/partially superseded by a LGTM
>>
>>       ack or review needed
>>    !  troublesome
>
> Hehe, nice one :)
>
>>    !  ee81319934 image: Support extra-directives, add hurd-directives.
>
> This one now only contains the hurd symlink, that you could be done at
> activation I guess.

I never believed that could work, but to my own eh, ..., I found a way
to make it work.  We "only" need to make sure that /hurd/startup etc.
are found by substitute*'ing some more, and create the symlink.

Reverting that patch and using this diff

--8<---------------cut here---------------start------------->8---
diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index 20d012fbfa..31260b52a1 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -45,6 +45,35 @@ Return the value associated with OPTION, or #f on failure."
            (lambda (arg)
              (substring arg (+ 1 (string-index arg #\=)))))))
 
+;; XXX FIXME c&p from guix/utils.scm
+(define (readlink* file)
+  "Call 'readlink' until the result is not a symlink."
+  (define %max-symlink-depth 50)
+
+  (let loop ((file  file)
+             (depth 0))
+    (define (absolute target)
+      (if (absolute-file-name? target)
+          target
+          (string-append (dirname file) "/" target)))
+
+    (if (>= depth %max-symlink-depth)
+        file
+        (call-with-values
+            (lambda ()
+              (catch 'system-error
+                (lambda ()
+                  (values #t (readlink file)))
+                (lambda args
+                  (let ((errno (system-error-errno args)))
+                    (if (or (= errno EINVAL))
+                        (values #f file)
+                        (apply throw args))))))
+          (lambda (success? target)
+            (if success?
+                (loop (absolute target) (+ depth 1))
+                file))))))
+
 (define* (make-hurd-device-nodes #:optional (root "/"))
   "Make some of the nodes needed on GNU/Hurd."
   (define (scope dir)
@@ -199,18 +228,25 @@ XXX TODO: use Linux xattr/setxattr to remove (settrans in) /libexec/RUNSYSTEM
      (format #t "Setting-up essential translators...\n")
      (set-hurd-device-translators)
 
-     (format #t "Starting pager...\n")
-     (unless (zero? (system* "/hurd/mach-defpager"))
-       (format #t "FAILED...Good luck!\n"))
-
      (let* ((args    (command-line))
             (system  (find-long-option "--system" args))
             (to-load (find-long-option "--load" args)))
+
        (false-if-exception (delete-file "/run/current-system"))
        (format #t "Setting current system...~a\n" system)
        (mkdir-p "/run")
        (symlink system "/run/current-system")
+
+       (false-if-exception (delete-file "/hurd"))
+       (let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
+         (symlink hurd/hurd "/hurd"))
+
+       (format #t "Starting pager...\n")
+       (unless (zero? (system* "/hurd/mach-defpager"))
+         (format #t "FAILED...Good luck!\n"))
+
        (cond ((member "--repl" args)
+              (format #t "Starting repl...\n")
               (start-repl))
              (to-load
               (format #t "loading '~a'...\n" to-load)
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index 9dc03c6c9c..087574cd61 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -390,6 +390,8 @@ PATH=@PATH@
 
 fsck --yes --force /
 fsysopts / --writable
+
+# Note: this /hurd/ gets substituted
 settrans -c /servers/socket/1 /hurd/pflocal
 
 # parse multiboot arguments
@@ -421,9 +423,18 @@ exec ${system}/rc \"$@\"
                (substitute* '("utils/uptime.sh")
                  (("/bin/w")
                   (string-append out "/bin/w")))
-               (substitute* "daemons/console-run.c"
+               (substitute* '("boot/boot.c"
+                              "daemons/console-run.c"
+                              "startup/startup.c")
                  (("/hurd/")
                   (string-append out "/hurd/")))
+               (substitute* "hurd/paths.h"
+                 (("_HURD_STARTUP\t")
+                  (string-append "_HURD_STARTUP\t\"" out "\" "))
+                 (("_HURD_PROC\t")
+                  (string-append "_HURD_PROC\t\"" out "\" "))
+                 (("_HURD_AUTH\t")
+                  (string-append "_HURD_AUTH\t\"" out "\" ")))
                (substitute* '("daemons/runsystem.sh"
                               "sutils/MAKEDEV.sh")
                  (("^PATH=.*")
--8<---------------cut here---------------end--------------->8---

produces a bootable VM.  So...this could be great or maybe...well, what
do you think?

>>    t  4479c1c1e3 linux-boot: Update 'make-hurd-device-nodes'.
>>   [M] a17f91bd50 image: Add Hurd support.
>>    t  7359403993 gnu: hurd: Update to upstream Hurd-reserved xattr index.
>>   [L] 68a8a26a57 gnu: guile-static: Disable JIT on ARMv7.
>>   [L] 220243a2c6 vm: Shared-store script runs that native QEMU and Bash.
>>   [L] e3b6c5dce2 vm: <virtual-machine> compiler honors system and target.
>>   [L] d43423f074 vm: 'qemu-image' preserves the cross-compilation target of the OS.
>>   [L] c6ee3a059b vm: 'qemu-image' uses the native partitioning tools and bootloader.
>>   [L] ab06638f57 vm: 'expression->derivation-in-linux-vm' always returns a native build.
>>   [L] 113ba9d7a9 system: 'system-linux-image-file-name' takes an optional parameter.
>
> For the rest, maybe you could send a patch serie by email with all the
> patch that are tagged ' ' or '!'. This way we could proceed to a last
> review round?

Sure, that makes sense.  I'll need some time to move this diff down the
tree and do some testing.

Greetings,
Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com