14/24: gnu: hurd: Create minimal "runsystem" script to invoke "rc".

[guix-commits]

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

commit 329744a288aaaa2a6ab8a5a45d445603398b2cee
Author: Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
AuthorDate: Wed May 6 08:22:41 2020 +0200

    gnu: hurd: Create minimal "runsystem" script to invoke "rc".
    
    This moves towards a regular Guix startup, loading SYSTEM/boot to activate 
the
    system and start the shepherd.
    
    * gnu/packages/hurd.scm (hurd-rc-script): Update to handle "runsystem" 
tasks.
    Load system/boot to activate the system and start the shepherd.  Create 
/hurd
    symlink.
    (hurd)[arguments]: Add 'create-runsystem' phase.  Do not substitute now 
unused
    init.c, runsystem.hurd.  Substitute "/hurd/" for the fixed 'out + "/hurd/"' 
in
    boot.c, console-run.c and startup.c.  Also substitute
    _HURD_STARTUP ("/hurd/startup") to the fixed 'out + "/hurd/startup"' in
    libdiskfs/boot-start.c and libdiskfs/opts-std-startup.c.
---
 gnu/packages/hurd.scm | 153 +++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 114 insertions(+), 39 deletions(-)

diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index 278568b..8c1375f 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -329,10 +329,26 @@ boot, since this cannot be done from GNU/Linux."
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils)
-                       (ice-9 match))
-
-          ;; "@HURD@" is a placeholder.
-          (setenv "PATH" "@HURD@/bin")
+                       (ice-9 match)
+                       (system repl repl)
+                       (srfi srfi-1)
+                       (srfi srfi-26))
+
+          (display "Welcome, this is GNU's early boot Guile.\n")
+          (display "Use '--repl' for an initrd REPL.\n\n")
+
+          ;; "@HURD@" and "@COREUTILS@" are a placeholders.
+          (setenv "PATH" "@HURD@/bin:@HURD@/sbin:@COREUTILS@/bin")
+
+          ;; XXX FIXME c&p from linux-boot.scm
+          (define (find-long-option option arguments)
+            "Find OPTION among ARGUMENTS, where OPTION is something like 
\"--load\".
+Return the value associated with OPTION, or #f on failure."
+            (let ((opt (string-append option "=")))
+              (and=> (find (cut string-prefix? opt <>)
+                           arguments)
+                     (lambda (arg)
+                       (substring arg (+ 1 (string-index arg #\=)))))))
 
           (define (translated? node)
             ;; Return true if a translator is installed on NODE.
@@ -349,10 +365,54 @@ boot, since this cannot be done from GNU/Linux."
                          (apply invoke "settrans" "-c" node command))))
                     '#$translators)
 
-          ;; Start the oh-so-fancy console client.
-          (mkdir-p "/var/run")                    ;for the PID file
-          (invoke "console" "--daemonize" "-c" "/dev/vcs"
-                  "-d" "vga" "-d" "pc_kbd" "-d" "generic_speaker"))))
+          (format #t "Creating essential device nodes...\n")
+          (with-directory-excursion "/dev"
+            (invoke "MAKEDEV" "--devdir=/dev" "std")
+            (invoke "MAKEDEV" "--devdir=/dev" "vcs")
+            (invoke "MAKEDEV" "--devdir=/dev" "tty1""tty2" "tty3" "tty4" 
"tty5" "tty6")
+            (invoke "MAKEDEV" "--devdir=/dev" "ptyp0" "ptyp1" "ptyp2")
+            (invoke "MAKEDEV" "--devdir=/dev" "console"))
+
+          (let* ((args    (command-line))
+                 (system  (find-long-option "--system" args))
+                 (to-load (find-long-option "--load" args)))
+
+            (false-if-exception (delete-file "/hurd"))
+            (let ((hurd/hurd (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)
+                   (primitive-load to-load)
+                   (format (current-error-port)
+                           "boot program '~a' terminated, rebooting~%"
+                           to-load)
+                   (let ((shepherd.conf
+                          (if (file-exists? "/etc/shepherd.conf")
+                              "/etc/shepherd.conf"
+                              (let ((files (find-files "/gnu/store" 
".*-shepherd.conf")))
+                                (and (pair? files) (car files))))))
+                     (unless shepherd.conf
+                       (format #t "No shepherd.conf found, dropping to a 
shell...\n")
+                       (invoke "/run/current-system/profile/bin/bash")
+                       (reboot))
+                     (false-if-exception (delete-file 
"/var/run/shepherd/socket"))
+                     (format #t "Starting the Shepherd... ~a\n" shepherd.conf)
+                     (execl "/run/current-system/profile/bin/shepherd" 
"shepherd"
+                            "--config" shepherd.conf))
+                   (sleep 2)
+                   (reboot))
+                  (else
+                   (display "no boot file passed via '--load'\n")
+                   (display "entering a warm and cozy REPL\n")
+                   (start-repl)))))))
 
   ;; FIXME: We want the program to use the cross-compiled Guile when
   ;; cross-compiling.  But why do we need to be explicit here?
@@ -425,57 +485,71 @@ boot, since this cannot be done from GNU/Linux."
              (substitute* '("daemons/Makefile" "utils/Makefile")
                (("-o root -m 4755") ""))
              #t))
+         (add-after 'unpack 'create-runsystem
+           (lambda _
+             ;; XXX Work towards having startup.c invoke the Guile rc
+             (delete-file "daemons/runsystem.sh")
+             (with-output-to-file "daemons/runsystem.sh"
+               (lambda _
+                 (display "#! /bin/bash
+
+# XXX Guile needs pipe support for its finalizer thread, to start.
+# Remove this script when Linux and the Hurd have xattr patches.
+PATH=@PATH@
+
+fsck --yes --force /
+fsysopts / --writable
+
+# Note: this /hurd/ gets substituted
+settrans -c /servers/socket/1 /hurd/pflocal
+echo Starting /libexec/rc ...
+exec /libexec/rc \"$@\"
+")))
+             ))
+
          (add-before 'build 'set-file-names
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let* ((out  (assoc-ref outputs "out"))
                     (bash (assoc-ref inputs "bash-minimal"))
                     (coreutils (assoc-ref inputs "coreutils"))
                     (sed  (assoc-ref inputs "sed"))
-                    (grep (assoc-ref inputs "grep"))
                     (util-linux (assoc-ref inputs "util-linux")))
                (substitute* '("daemons/runttys.c" "daemons/getty.c" 
"utils/login.c")
                  (("/bin/login")
                   (string-append out "/bin/login"))
                  (("/bin/bash") (string-append bash "/bin/bash")))
-               (substitute* '("startup/startup.c" "init/init.c" "config/ttys")
+               (substitute* '("startup/startup.c" "config/ttys")
                  (("/libexec/")
                   (string-append out "/libexec/")))
                (substitute* '("utils/uptime.sh")
                  (("/bin/w")
                   (string-append out "/bin/w")))
-               (substitute* "daemons/console-run.c"
+               ;; Upon first boot the /hurd symlink does not exist; it is
+               ;; created during activation: Hard-code the .../hurd store file
+               ;; name.
+               (substitute* '("boot/boot.c"
+                              "daemons/console-run.c"
+                              "startup/startup.c")
                  (("/hurd/")
                   (string-append out "/hurd/")))
-
+               (substitute* '("libdiskfs/boot-start.c"
+                              "libdiskfs/opts-std-startup.c")
+                 (("_HURD_STARTUP")
+                  (string-append "\"" out "/hurd/startup\"")))
                (substitute* '("daemons/runsystem.sh"
-                              "daemons/runsystem.hurd.sh"
-                              "sutils/MAKEDEV.sh")
+                              "utils/fakeroot.sh"
+                              "utils/remap.sh"
+                              "sutils/MAKEDEV.sh"
+                              "sutils/losetup.sh")
                  (("^PATH=.*")
-                  (string-append "PATH=" out "/bin:" out "/sbin:"
-                                 coreutils "/bin:"
-                                 sed "/bin:" grep "/bin:"
-                                 util-linux "/bin\n"))
-                 (("^SHELL=.*")
-                  (string-append "SHELL=" bash "/bin/bash\n"))
+                  (string-append "PATH=" out "/bin"
+                                 ":" out "/sbin"
+                                 ":" coreutils "/bin"
+                                 ":" sed "/bin"
+                                 ":" util-linux "/sbin\n"))
                  (("/sbin/") (string-append out "/sbin/"))
                  (("/libexec/") (string-append out "/libexec/"))
                  (("/hurd/") (string-append out "/hurd/")))
-
-               (substitute* "daemons/runsystem.sh"
-                 (("export PATH")
-                  (string-append "export PATH\n"
-                                 "\
-fsysopts / --writable
-
-# MAKEDEV relies on pipes so this needs to be set up.
-settrans -c /servers/socket/1 /hurd/pflocal
-
-(cd /dev; MAKEDEV -D /dev std vcs tty{1,2,3,4,5,6})\n")))
-
-               (substitute* "daemons/runsystem.hurd.sh"
-                 (("export PATH")
-                  "export PATH
-fsysopts / --writable\n"))
                #t)))
          (add-after 'patch-shebangs 'patch-libexec-shebangs
            (lambda* (#:key inputs outputs #:allow-other-keys)
@@ -511,11 +585,13 @@ fsysopts / --writable\n"))
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let* ((out  (assoc-ref outputs "out"))
                     (file (string-append out "/libexec/rc"))
-                    (rc   (assoc-ref inputs "hurd-rc")))
+                    (rc   (assoc-ref inputs "hurd-rc"))
+                    (coreutils (assoc-ref inputs "coreutils")))
                (delete-file file)
                (copy-file rc file)
                (substitute* file
-                 (("@HURD@") out))
+                 (("@HURD@") out)
+                 (("@COREUTILS@") coreutils))
                #t))))
        #:configure-flags (list (string-append "LDFLAGS=-Wl,-rpath="
                                               %output "/lib")
@@ -544,7 +620,6 @@ fsysopts / --writable\n"))
        ("bash-minimal" ,bash-minimal)
        ("coreutils" ,coreutils)
        ("sed" ,sed)
-       ("grep" ,grep)
        ("util-linux" ,util-linux)))
     (native-inputs
      `(("autoconf" ,autoconf)