20/24: gnu: services: Add %hurd-startup-service.

[guix-commits]

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

commit 68d8c094659565fe19abc1c433a17337ce5cacb7
Author: Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
AuthorDate: Thu Apr 30 15:40:07 2020 +0200

    gnu: services: Add %hurd-startup-service.
    
    This decouples startup of the Hurd from the "hurd" package, moving the RC
    script into SYSTEM.
    
    * gnu/packages/hurd.scm (hurd)[inputs]: Remove hurd-rc-script.
    [arguments]: Do not substitute it.  Update "runsystem.sh" to parse kernel
    arguments and exec into --system=SYSTEM/rc.
    (hurd-rc-script): Move to...
    * gnu/services.scm (%hurd-rc-file): ...this new variable.
    (hurd-rc-entry): New procedure.
    (%hurd-startup-service): Use it in new variable.
    * gnu/system.scm (hurd-default-essential-services): Use it.
---
 gnu/build/hurd-boot.scm | 35 +++++++++++++++--------------
 gnu/packages/hurd.scm   | 58 ++++++++++---------------------------------------
 gnu/services.scm        | 35 +++++++++++++++++++++++++++++
 gnu/system.scm          |  1 +
 4 files changed, 67 insertions(+), 62 deletions(-)

diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index 729822d..0932623 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -153,27 +153,30 @@ XXX TODO: use settrans/setxattr instead of MAKEDEV
          (lambda ()
            (with-error-to-port (%make-void-port "w")
              (lambda ()
-               (zero? (system* "showtrans" "-s" node)))))))
-
-     (for-each (match-lambda
-                 ((node command)
-                  (unless (translated? node)
-                    (mkdir-p (dirname node))
-                    (apply invoke "settrans" "-c" node command))))
-               translators)
-
-     (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"))
+               (zero? (system* "showtrans" "--silent" node)))))))
 
      (let* ((args    (command-line))
             (system  (find-long-option "--system" args))
             (to-load (find-long-option "--load" args)))
 
+       (format #t "Creating essential servers...\n")
+       (setenv "PATH" (string-append system "/profile/bin"
+                                     ":" system "/profile/sbin"))
+       (for-each (match-lambda
+                   ((node command)
+                    (unless (translated? node)
+                      (mkdir-p (dirname node))
+                      (apply invoke "settrans" "--create" node command))))
+                 translators)
+
+       (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"))
+
        (false-if-exception (delete-file "/hurd"))
        (let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
          (symlink hurd/hurd "/hurd"))
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index d02bbe6..dd2d0f1 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -310,35 +310,6 @@ Hurd-minimal package which are needed for both glibc and 
GCC.")
      (base32
       "0p2vhnc18cnbmb39vq4m7hzv4mhnm2l0a2s7gx3ar277fwng3hys"))))
 
-(define (hurd-rc-script)
-  "Return a script to be installed as /libexec/rc in the 'hurd' package.  The
-script takes care of installing the relevant passive translators on the first
-boot, since this cannot be done from GNU/Linux.  Then, it runs system
-activation; starting the Shepherd."
-
-  (define rc
-    (with-imported-modules '((guix build utils)
-                             (gnu build hurd-boot)
-                             (guix build syscalls))
-      #~(begin
-          (use-modules (guix build utils)
-                       (gnu build hurd-boot)
-                       (guix build syscalls)
-                       (ice-9 match)
-                       (system repl repl)
-                       (srfi srfi-1)
-                       (srfi srfi-26))
-
-          ;; "@HURD@" and "@COREUTILS@" are placeholders.
-          (setenv "PATH" "@HURD@/bin:@HURD@/sbin:@COREUTILS@/bin")
-
-          (boot-hurd-system))))
-
-  ;; FIXME: We want the program to use the cross-compiled Guile when
-  ;; cross-compiling.  But why do we need to be explicit here?
-  (with-parameters ((%current-target-system "i586-pc-gnu"))
-    (program-file "rc" rc)))
-
 (define dde-sources
   ;; This is the current tip of the dde branch
   (let ((commit "ac1c7eb7a8b24b7469bed5365be38a968d59a136"))
@@ -422,11 +393,19 @@ fsysopts / --writable
 
 # Note: this /hurd/ gets substituted
 settrans --create /servers/socket/1 /hurd/pflocal
-echo Starting /libexec/rc ...
-exec /libexec/rc \"$@\"
-")))
-             ))
 
+# parse multiboot arguments
+for i in \"$@\"; do
+    case $i in
+        (--system=*)
+            system=${i#--system=}
+            ;;
+    esac
+done
+
+echo Starting ${system}/rc...
+exec ${system}/rc \"$@\"
+")))))
          (add-before 'build 'set-file-names
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let* ((out  (assoc-ref outputs "out"))
@@ -502,18 +481,6 @@ exec /libexec/rc \"$@\"
                (mkdir-p datadir)
                (copy-file "unifont"
                           (string-append datadir "/vga-system.bdf"))
-               #t)))
-         (add-after 'install 'install-rc-file
-           (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"))
-                    (coreutils (assoc-ref inputs "coreutils")))
-               (delete-file file)
-               (copy-file rc file)
-               (substitute* file
-                 (("@HURD@") out)
-                 (("@COREUTILS@") coreutils))
                #t))))
        #:configure-flags (list (string-append "LDFLAGS=-Wl,-rpath="
                                               %output "/lib")
@@ -528,7 +495,6 @@ exec /libexec/rc \"$@\"
     (build-system gnu-build-system)
     (inputs
      `(("glibc-hurd-headers" ,glibc/hurd-headers)
-       ("hurd-rc" ,(hurd-rc-script))
 
        ("libgcrypt" ,libgcrypt)                  ;for /hurd/random
        ("libdaemon" ,libdaemon)                  ;for /bin/console --daemonize
diff --git a/gnu/services.scm b/gnu/services.scm
index 63a709f..27e5558 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -93,6 +93,8 @@
             activation-service-type
             activation-service->script
             %linux-bare-metal-service
+            %hurd-rc-script
+            %hurd-startup-service
             special-files-service-type
             extra-special-file
             etc-service-type
@@ -605,6 +607,39 @@ ACTIVATION-SCRIPT-TYPE."
                   activation-service-type
                   %linux-kernel-activation))
 
+(define %hurd-rc-script
+  ;; The RC script to be started upon boot.
+  (program-file "rc"
+                (with-imported-modules (source-module-closure
+                                        '((guix build utils)
+                                          (gnu build hurd-boot)
+                                          (guix build syscalls)))
+                  #~(begin
+                      (use-modules (guix build utils)
+                                   (gnu build hurd-boot)
+                                   (guix build syscalls)
+                                   (ice-9 match)
+                                   (system repl repl)
+                                   (srfi srfi-1)
+                                   (srfi srfi-26))
+                      (boot-hurd-system)))))
+
+(define (hurd-rc-entry rc)
+  "Return, as a monadic value, an entry for the RC script in the system
+directory."
+  (mlet %store-monad ((rc (lower-object rc)))
+    (return `(("rc" ,rc)))))
+
+(define hurd-startup-service-type
+  ;; The service that creates the initial SYSTEM/rc startup file.
+  (service-type (name 'startup)
+                (extensions
+                 (list (service-extension system-service-type hurd-rc-entry)))
+                (default-value %hurd-rc-script)))
+
+(define %hurd-startup-service
+  ;; The service that produces the RC script.
+  (service hurd-startup-service-type %hurd-rc-script))
 
 (define special-files-service-type
   ;; Service to install "special files" such as /bin/sh and /usr/bin/env.
diff --git a/gnu/system.scm b/gnu/system.scm
index 88b2082..21d0fbd 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -602,6 +602,7 @@ bookkeeping."
 (define (hurd-default-essential-services os)
   (list (service system-service-type '())
         %boot-service
+        %hurd-startup-service
         %activation-service
         %shepherd-root-service
         (service user-processes-service-type)