06/07: DRAFT: gnu: hurd: Provide our own /libexec/rc script.

[guix-commits]

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

commit 06c563fdfe93d40a825b93cbc60e49f0a1998112
Author: Ludovic Courtès <address@hidden>
AuthorDate: Wed Apr 1 16:14:40 2020 +0200

    DRAFT: gnu: hurd: Provide our own /libexec/rc script.
    
    DRAFT: Script untested!
    
    * gnu/packages/hurd.scm (hurd-rc-script): New procedure.
    (hurd)[inputs]: Add (hurd-rc-script).
---
 gnu/packages/hurd.scm | 66 ++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 60 insertions(+), 6 deletions(-)

diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index 7ea35bb..bd7302f 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -25,6 +25,7 @@
   #:use-module (guix download)
   #:use-module (guix packages)
   #:use-module (gnu packages)
+  #:use-module (guix gexp)
   #:use-module (guix utils)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system trivial)
@@ -286,6 +287,49 @@ Hurd-minimal package which are needed for both glibc and 
GCC.")
     (description
      "GNU Mach is the microkernel upon which a GNU Hurd system is based.")))
 
+(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."
+  (define translators
+    '(("/servers/crash-dump-core" ("/hurd/crash" "--dump-core"))
+      ("/servers/crash-kill" ("/hurd/crash" "--kill"))
+      ("/servers/crash-suspend" ("/hurd/crash" "--suspend"))
+      ("/servers/password" ("/hurd/password"))
+      ("/servers/socket/1" ("/hurd/pflocal"))
+      ("/servers/socket/2" ("/hurd/pfinet" "--interface" "eth0"
+                            "--address" "10.0.2.77"
+                            "--netmask" "255.255.255.0"
+                            "--gateway" "10.0.2.2"
+                            "--ipv6" "/servers/socket/16"))))
+
+  (define rc
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (ice-9 match))
+
+          ;; XXX: We expect to be installed in HURD/libexec/rc.
+          (setenv "PATH" "../../bin")
+
+          (define (translated? node)
+            ;; Return true if a translator is installed on NODE.
+            (with-output-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))))
+
+  ;; 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-public hurd
   (package
     (name "hurd")
@@ -296,11 +340,19 @@ Hurd-minimal package which are needed for both glibc and 
GCC.")
      `(#:phases
        (modify-phases %standard-phases
          (add-before 'build 'pre-build
-                     (lambda _
-                       ;; Don't change the ownership of any file at this time.
-                       (substitute* '("daemons/Makefile" "utils/Makefile")
-                         (("-o root -m 4755") ""))
-                       #t)))
+           (lambda _
+             ;; Don't change the ownership of any file at this time.
+             (substitute* '("daemons/Makefile" "utils/Makefile")
+               (("-o root -m 4755") ""))
+             #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")))
+               (delete-file file)
+               (copy-file rc file)
+               #t))))
        #:configure-flags (list (string-append "LDFLAGS=-Wl,-rpath="
                                               %output "/lib")
                           "--disable-ncursesw"
@@ -308,7 +360,9 @@ Hurd-minimal package which are needed for both glibc and 
GCC.")
                           "--without-libz"
                           "--without-parted")))
     (build-system gnu-build-system)
-    (inputs `(("glibc-hurd-headers" ,glibc/hurd-headers)))
+    (inputs
+     `(("glibc-hurd-headers" ,glibc/hurd-headers)
+       ("hurd-rc" ,(hurd-rc-script))))
     (native-inputs
      `(("autoconf" ,autoconf)
        ("automake" ,automake)