01/02: system: hurd: Create /hurd symlink during activation.

[guix-commits]

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

commit 41250cd9d0898d2a1efccb61424d836503bdf9b1
Author: Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
AuthorDate: Wed Jun 3 22:11:00 2020 +0200

    system: hurd: Create /hurd symlink during activation.
    
    * gnu/build/hurd-boot.scm (readlink*): New procedure, copied from
    guix/utils.scm.
    (boot-hurd-system): Use it to create /hurd symlink.
    * gnu/packages/hurd.scm (hurd)[arguments]: Substitute "/hurd/" in boot.c,
    console-run.c and startup.c, and partly in paths.h.
---
 gnu/build/hurd-boot.scm | 44 ++++++++++++++++++++++++++++++++++++++++----
 gnu/packages/hurd.scm   | 18 ++++++++++++++++--
 2 files changed, 56 insertions(+), 6 deletions(-)

diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index 20d012f..31260b5 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 9dc03c6..ed2d575 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,11 +423,23 @@ 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")
+                              "utils/fakeroot.sh"
+                              "utils/remap.sh"
+                              "sutils/MAKEDEV.sh"
+                              "sutils/losetup.sh")
                  (("^PATH=.*")
                   (string-append "PATH=" out "/bin"
                                  ":" out "/sbin"