4 files changed, 50 insertions, 12 deletions

diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index ce198cce961..578378bb208 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -74,10 +74,18 @@ Return the value associated with OPTION, or #f on failure."
                 (loop (absolute target) (+ depth 1))
                 file))))))
 
-(define* (make-hurd-device-nodes #:optional (root "/"))
+(define* (make-hurd-device-nodes #:key (root "/") (hurd "/hurd"))
   "Make some of the nodes needed on GNU/Hurd."
   (define (scope dir)
-    (string-append root (if (string-suffix? "/" root) "" "/") dir))
+    (in-vicinity root dir))
+
+  (define scope-set-translator
+    (match-lambda
+      ((file-name command)
+       (scope-set-translator (list file-name command #o600)))
+      ((file-name command mode)
+       (let ((mount-point (scope file-name)))
+         (set-translator mount-point command mode)))))
 
   (mkdir-p (scope "dev"))
   ;; XXX: We must have `/dev/console` otherwise `console-run` tries to
@@ -114,12 +122,32 @@ Return the value associated with OPTION, or #f on failure."
               "suspend"))
 
   (mkdir-p (scope "servers/socket"))
+  (mkdir-p (scope "servers/bus/pci"))
 
-  ;; Don't create /servers/socket/1 & co: runsystem does that on first boot.
+  ;; Set the 'gnu.translator' extended attribute for passive translator
+  ;; settings for pipes (servers/socet/1) and mount information (proc/mounts).
+  ;; Pipes are needed for guile-3.0.11 to startup, this enables moving
+  ;; "runsystem" to guile.
+  ;; XXX TODO: Set more passive xattr translators?
+  (define servers
+    `(
+      ;; ("servers/bus/pci"         ("/hurd/pci-arbiter"))
+      ;; ("servers/crash-dump-core" ("/hurd/crash" "--dump-core"))
+      ;; ("servers/crash-kill"      ("/hurd/crash" "--kill"))
+      ;; ("servers/crash-suspend"   ("/hurd/crash" "--suspend"))
+      ;; ("servers/password"        ("/hurd/password"))
+      ;; PIPE -- for running runsystem as Guile
+      ("servers/socket/1"        (,(in-vicinity hurd "pflocal")))
+      ;; /servers/socket/2 and /26 are created by 'static-networking-service'.
+      ;; XXX: Spawn pfinet without arguments on these nodes so that a DHCP
+      ;; client has someone to talk to?
+      ("proc"                    (,(in-vicinity hurd "procfs") "--stat-mode=444"))))
 
-  ;; TODO: Set the 'gnu.translator' extended attribute for passive translator
-  ;; settings?
-  (mkdir-p (scope "servers/bus/pci")))
+  (for-each scope-set-translator servers)
+
+  (define devices
+    '())
+  (for-each scope-set-translator devices))
 
 (define (passive-translator-xattr? file-name)
   "Return true if FILE-NAME has an extended @code{gnu.translator} attribute
@@ -190,7 +218,7 @@ needed."
   "Make some of the device nodes needed on GNU/Hurd."
 
   (define (scope dir)
-    (string-append root (if (string-suffix? "/" root) "" "/") dir))
+    (in-vicinity root dir))
 
   (define scope-set-translator
     (match-lambda
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index dbb87103daf..820dfe202fb 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -322,7 +322,7 @@ register-closure."
 
   ;; Populate /dev.
   (when make-device-nodes
-    (make-device-nodes root))
+    (make-device-nodes #:root root))
 
   (when register-closures?
     (unless copy-closures?
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 0e4967012c8..bdf4aff9718 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -352,7 +352,8 @@ set to the given OS."
 (define-syntax-rule (with-imported-modules* gexp* ...)
   (with-extensions gcrypt-sqlite3&co
     (with-imported-modules `(,@(source-module-closure
-                                '((gnu build image)
+                                '((ice-9 optargs)
+                                  (gnu build image)
                                   (gnu build bootloader)
                                   (gnu build hurd-boot)
                                   (gnu build linux-boot)
@@ -360,7 +361,8 @@ set to the given OS."
                                 #:select? neither-config-nor-git?)
                              ((guix config) => ,(make-config.scm)))
       #~(begin
-          (use-modules (gnu build image)
+          (use-modules (ice-9 optargs)
+                       (gnu build image)
                        (gnu build bootloader)
                        (gnu build hurd-boot)
                        (gnu build linux-boot)
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index ba223b1e0cd..c65a9c8f13d 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024, 2026 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +22,7 @@
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
+  #:use-module (gnu packages hurd)
   #:use-module (gnu packages ssh)
   #:use-module (guix platforms x86)
   #:use-module (gnu services)
@@ -97,7 +98,14 @@
   #~(lambda* (#:rest args)
       (apply initialize-root-partition
              (append args
-                     (list #:make-device-nodes make-hurd-device-nodes
+                     (list #:make-device-nodes
+                           (lambda device-args
+                             (let-keywords (cdr args) #t
+                                           ((system-directory #f))
+                               (let ((hurd (in-vicinity system-directory
+                                                        "hurd/hurd")))
+                                 (apply make-hurd-device-nodes
+                                        (cons* #:hurd hurd device-args)))))
                            ;; XXX Creating a db.sqlite with journal_mode=WAL
                            ;; yields "unable to open database file" on GNU/Hurd
                            ;; for an sqlite with the hurd-locking-mode.patch;