bug#41855: [PATCH 0/2] hurd-boot: Cleanups: Remove MAKEDEV, then use setxattr (on the Hurd).

bug#41855: [PATCH 0/2] hurd-boot: Cleanups: Remove MAKEDEV, then use setxattr (on the Hurd).

[Jan (janneke) Nieuwenhuizen]

From: Jan Nieuwenhuizen <janneke@gnu.org>

Hi!

Several variants of these patches were present on wip-hurd-vm before.

Currently, we are running MAKEDEV from activation, and thus need hurd, bash,
coreutils and sed in PATH.

The first patch replaces that with scheme code, which seems a no-brainer to
me.  Then we only need hurd in PATH for settrans and gettrans.

The second patch then switches to using setxattr instead of settrans; alas we
still need gettrans as getxattr behaves "funny" on translated nodes.  I
suppose that would be a question for the bug-hurd?

Greetings,
Janneke

Jan (janneke) Nieuwenhuizen (2):
  hurd-boot: Create individual translators instead of running MAKEDEV.
  hurd-boot: Use 'setxattr' instead of invoking settrans.

 gnu/build/hurd-boot.scm | 172 +++++++++++++++++++++++++++++-----------
 gnu/system.scm          |   1 +
 2 files changed, 126 insertions(+), 47 deletions(-)

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

bug#41855: [PATCH 1/2] hurd-boot: Create individual translators instead of running MAKEDEV.

[Jan (janneke) Nieuwenhuizen]

* gnu/build/hurd-boot.scm (make-hurd-device-nodes): Do not create
dev/{null,zero,full,random,urandom} mount points.
(setup-translator, xattr-translator,
showtrans-translator?, translated?, set-hurd-device-translators): New
procedures.
(boot-hurd-system): Use them instead of running MAKEDEV.
---
 gnu/build/hurd-boot.scm | 172 +++++++++++++++++++++++++++++-----------
 1 file changed, 125 insertions(+), 47 deletions(-)

diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index 09326233d2..398cee1395 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -80,16 +80,8 @@ Return the value associated with OPTION, or #f on failure."
     (string-append root (if (string-suffix? "/" root) "" "/") dir))
 
   (mkdir (scope "dev"))
-  (for-each (lambda (file)
-              (call-with-output-file (scope file)
-                (lambda (port)
-                  (display file port)   ;avoid hard-linking
-                  (chmod port #o666))))
-            '("dev/null"
-              "dev/zero"
-              "dev/full"
-              "dev/random"
-              "dev/urandom"))
+  ;; Don't create /dev/null etc just yet; the store
+  ;; messes-up the permission bits.
   ;; Don't create /dev/console, /dev/vcs, etc.: they are created by
   ;; console-run on first boot.
 
@@ -115,6 +107,125 @@ Return the value associated with OPTION, or #f on failure."
   ;; settings?
   )
 
+(define (xattr-translator? file-name)
+  "Return true if FILE-NAME has an extended @code{gnu.translator} attribute
+set."
+  (false-if-exception
+   (not (string-null? (getxattr file-name "gnu.translator")))))
+
+(define (showtrans-translator? file-name)
+  "Return true if @file{showtrans} finds a translator installed on FILE-NAME."
+  (with-output-to-port (%make-void-port "w")
+    (lambda _
+      (with-error-to-port (%make-void-port "w")
+        (lambda _
+          (zero? (system* "showtrans" "--silent" file-name)))))))
+
+(define (translated? file-name)
+  "Return true if a translator is installed on FILE-NAME."
+  (if (string-contains %host-type "linux-gnu")
+      (xattr-translator? file-name)
+      (showtrans-translator? file-name)))
+
+(define* (setup-translator file-name command #:optional (mode #o600))
+  "Setup translator COMMAND on FILE-NAME."
+  (unless (translated? file-name)
+    (let ((dir (dirname file-name)))
+      (unless (directory-exists? dir)
+        (mkdir-p dir))
+      (unless (file-exists? file-name)
+        (call-with-output-file file-name
+          (lambda (port)
+            (display file-name port)  ;avoid hard-linking
+            (chmod port mode)))))
+    (catch 'system-error
+      (lambda _
+        (apply invoke "settrans" "--create" file-name command))
+      (lambda (key . args)
+        (let ((errno (system-error-errno (cons key args))))
+          (format (current-error-port) "~a: ~a\n"
+                  (strerror errno) file-name)
+          (format (current-error-port) "Ignoring...Good Luck!\n"))))))
+
+(define* (set-hurd-device-translators #:optional (root "/"))
+  "Make some of the device nodes needed on GNU/Hurd."
+
+  (define (scope dir)
+    (string-append root (if (string-suffix? "/" root) "" "/") dir))
+
+  (define scope-setup-translator
+    (match-lambda
+      ((file-name command)
+       (scope-setup-translator (list file-name command #o600)))
+      ((file-name command mode)
+       (let ((mount-point (scope file-name)))
+         (setup-translator mount-point command mode)))))
+
+  (define servers
+    '(("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.15" ;the default QEMU guest IP
+                                  "--netmask" "255.255.255.0"
+                                  "--gateway" "10.0.2.2"
+                                  "--ipv6" "/servers/socket/16"))))
+
+  (define devices
+    '(("dev/full"    ("/hurd/null"     "--full")            #o666)
+      ("dev/null"    ("/hurd/null")                         #o666)
+      ("dev/random"  ("/hurd/random"   "--seed-file" "/var/lib/random-seed")
+                                                            #o644)
+      ("dev/zero"    ("/hurd/storeio"  "--store-type=zero") #o666)
+
+      ("dev/console" ("/hurd/term"     "/dev/console" "device" "console"))
+
+      ("dev/klog"    ("/hurd/streamio" "kmsg"))
+      ("dev/mem"     ("/hurd/storeio"  "--no-cache" "mem")  #o660)
+      ("dev/shm"     ("/hurd/tmpfs"    "--mode=1777" "50%") #o644)
+      ("dev/time"    ("/hurd/storeio"  "--no-cache" "time") #o644)
+
+      ("dev/vcs"     ("/hurd/console"))
+      ("dev/tty"     ("/hurd/magic"    "tty")               #o666)
+
+      ("dev/tty1"    ("/hurd/term"     "/dev/tty1" "hurdio" "/dev/vcs/1/console")
+                                                            #o666)
+      ("dev/tty2"    ("/hurd/term"     "/dev/tty2" "hurdio" "/dev/vcs/2/console")
+                                                            #o666)
+      ("dev/tty3"    ("/hurd/term"     "/dev/tty3" "hurdio" "/dev/vcs/3/console")
+                                                            #o666)
+
+      ("dev/ptyp0"   ("/hurd/term"     "/dev/ptyp0" "pty-master" "/dev/ttyp0")
+                                                            #o666)
+      ("dev/ptyp1"   ("/hurd/term"     "/dev/ptyp1" "pty-master" "/dev/ttyp1")
+                                                            #o666)
+      ("dev/ptyp2"   ("/hurd/term"     "/dev/ptyp2" "pty-master" "/dev/ttyp2")
+                                                            #o666)
+
+      ("dev/ttyp0"   ("/hurd/term"     "/dev/ttyp0" "pty-slave" "/dev/ptyp0")
+                                                            #o666)
+      ("dev/ttyp1"   ("/hurd/term"     "/dev/ttyp1" "pty-slave" "/dev/ptyp1")
+                                                            #o666)
+      ("dev/ttyp2"   ("/hurd/term"     "/dev/ttyp2" "pty-slave" "/dev/ptyp2")
+                                                            #o666)))
+
+  (for-each scope-setup-translator servers)
+  (false-if-exception (mkdir-p (scope "dev/vcs/1")))
+  (false-if-exception (mkdir-p (scope "dev/vcs/2")))
+  (false-if-exception (mkdir-p (scope "dev/vcs/3")))
+  (false-if-exception (rename-file "/dev/console" "/dev/console-"))
+  (for-each scope-setup-translator devices)
+
+  (false-if-exception (symlink "/dev/random" "/dev/urandom"))
+  (false-if-exception (mkdir-p "/dev/fd"))
+  (false-if-exception (symlink "/dev/fd/0"   "/dev/stdin"))
+  (false-if-exception (symlink "/dev/fd/1"   "/dev/stdout"))
+  (false-if-exception (symlink "/dev/fd/2"   "/dev/stderr")))
+
 \f
 (define* (boot-hurd-system #:key (on-error 'debug))
   "This procedure is meant to be called from an early RC script.
@@ -126,20 +237,9 @@ starting the Shepherd.
 XXX TODO: see linux-boot.scm:boot-system.
 XXX TODO: add proper file-system checking, mounting
 XXX TODO: move bits to (new?) (hurd?) (activation?) services
-XXX TODO: use settrans/setxattr instead of MAKEDEV
+XXX TODO: use Linux xattr/setxattr to remove (settrans in) /libexec/RUNSYSTEM
 
 "
-  (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.15" ;the default QEMU guest IP
-                            "--netmask" "255.255.255.0"
-                            "--gateway" "10.0.2.2"
-                            "--ipv6" "/servers/socket/16"))))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
@@ -147,35 +247,13 @@ XXX TODO: use settrans/setxattr instead of MAKEDEV
   (call-with-error-handling
    (lambda ()
 
-     (define (translated? node)
-       ;; Return true if a translator is installed on NODE.
-       (with-output-to-port (%make-void-port "w")
-         (lambda ()
-           (with-error-to-port (%make-void-port "w")
-             (lambda ()
-               (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"))
+       (format #t "Setting-up essential translators...\n")
+       (setenv "PATH" (string-append system "/profile/bin"))
+       (set-hurd-device-translators)
 
        (false-if-exception (delete-file "/hurd"))
        (let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

bug#41855: [PATCH 2/2] hurd-boot: Use 'setxattr' instead of invoking settrans.

[Jan (janneke) Nieuwenhuizen]

Note: Using `getxattr' on the Hurd instead of running showtrans does not
work (yet?).

* gnu/build/hurd-boot.scm (setup-translator): Use 'setxattr' instead of
invoking settrans.
* gnu/system.scm (hurd-multiboot-modules): Add --x-xattr-translator-records to
enable xattr-embebbing of translators.
---
 gnu/build/hurd-boot.scm | 2 +-
 gnu/system.scm          | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index 398cee1395..8150aff972 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -140,7 +140,7 @@ set."
             (chmod port mode)))))
     (catch 'system-error
       (lambda _
-        (apply invoke "settrans" "--create" file-name command))
+        (setxattr file-name "gnu.translator" (string-join command "\0" 'suffix)))
       (lambda (key . args)
         (let ((errno (system-error-errno (cons key args))))
           (format (current-error-port) "~a: ~a\n"
diff --git a/gnu/system.scm b/gnu/system.scm
index d51691fe76..25cc63a9df 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1191,6 +1191,7 @@ a list of <menu-entry>, to populate the \"old entries\" menu."
                 "--device-master-port='${device-port}'"
                 "--exec-server-task='${exec-task}'"
                 "--store-type=typed"
+                "--x-xattr-translator-records"
                 "'${root}'" "'$(task-create)'" "'$(task-resume)'"))
          (target (%current-target-system))
          (libc (if target
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

bug#41855: [PATCH 1/2] hurd-boot: Create individual translators instead of running MAKEDEV.

[Ludovic Courtès]

Hi!

"Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:

> * gnu/build/hurd-boot.scm (make-hurd-device-nodes): Do not create
> dev/{null,zero,full,random,urandom} mount points.
> (setup-translator, xattr-translator,
> showtrans-translator?, translated?, set-hurd-device-translators): New
> procedures.
> (boot-hurd-system): Use them instead of running MAKEDEV.

This is mostly about moving the logic from the MAKEDEV script to this
file, right?  Sounds nice.

> +(define (xattr-translator? file-name)
> +  "Return true if FILE-NAME has an extended @code{gnu.translator} attribute
> +set."
> +  (false-if-exception
> +   (not (string-null? (getxattr file-name "gnu.translator")))))

I’d call it ‘passive-translator-xattr?’.

In general, I’d avoid ‘false-if-exception’ as much as possible because
it can hide real issues.  So here, you could catch 'system-error and
check for ENODATA.  If you need it in several places, you can define a
‘false-if-ENODATA’ macro

> +(define (showtrans-translator? file-name)
> +  "Return true if @file{showtrans} finds a translator installed on FILE-NAME."

Should be ‘passive-translator-installed?’ no?  (IIRC ‘showtrans’ only
shows passive translator settings by default.)

> +  (with-output-to-port (%make-void-port "w")
> +    (lambda _
> +      (with-error-to-port (%make-void-port "w")
> +        (lambda _
> +          (zero? (system* "showtrans" "--silent" file-name)))))))
> +
> +(define (translated? file-name)
> +  "Return true if a translator is installed on FILE-NAME."
> +  (if (string-contains %host-type "linux-gnu")
> +      (xattr-translator? file-name)
> +      (showtrans-translator? file-name)))

It’s counter-intuitive that hurd-boot.scm is used from GNU/Linux.
Should we move the shared bits in (gnu build hurd) or similar?

> +(define* (setup-translator file-name command #:optional (mode #o600))
> +  "Setup translator COMMAND on FILE-NAME."

‘set-translator’?  :-)

> +  (false-if-exception (mkdir-p (scope "dev/vcs/1")))
> +  (false-if-exception (mkdir-p (scope "dev/vcs/2")))
> +  (false-if-exception (mkdir-p (scope "dev/vcs/3")))
> +  (false-if-exception (rename-file "/dev/console" "/dev/console-"))
> +  (for-each scope-setup-translator devices)
> +
> +  (false-if-exception (symlink "/dev/random" "/dev/urandom"))
> +  (false-if-exception (mkdir-p "/dev/fd"))
> +  (false-if-exception (symlink "/dev/fd/0"   "/dev/stdin"))
> +  (false-if-exception (symlink "/dev/fd/1"   "/dev/stdout"))
> +  (false-if-exception (symlink "/dev/fd/2"   "/dev/stderr")))

‘false-if-EEXIST’?

Thanks!

Ludo’.

bug#41855: [PATCH 2/2] hurd-boot: Use 'setxattr' instead of invoking settrans.

[Ludovic Courtès]

"Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:

> Note: Using `getxattr' on the Hurd instead of running showtrans does not
> work (yet?).

How does it not work?  :-)

> * gnu/build/hurd-boot.scm (setup-translator): Use 'setxattr' instead of
> invoking settrans.
> * gnu/system.scm (hurd-multiboot-modules): Add --x-xattr-translator-records to
> enable xattr-embebbing of translators.
                   ^
Typo.

Otherwise LGTM!

Ludo’.

[bug#41855] [PATCH 2/2] hurd-boot: Use 'setxattr' instead of invoking settrans.

[Jan Nieuwenhuizen]

Ludovic Courtès writes:

Hello!

> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:
>
>> Note: Using `getxattr' on the Hurd instead of running showtrans does not
>> work (yet?).
>
> How does it not work?  :-)

root@childhurd ~# showtrans /dev/vcs
/gnu/store/b48w1piqvqldl54sfj57g6vib405mn3a-hurd-0.9-1.91a5167/hurd/console

scheme@(guile-user)> (getxattr "/dev/vcs" "gnu.translator")
$1 = #f

>> * gnu/build/hurd-boot.scm (setup-translator): Use 'setxattr' instead of
>> invoking settrans.
>> * gnu/system.scm (hurd-multiboot-modules): Add --x-xattr-translator-records to
>> enable xattr-embebbing of translators.
>                    ^
> Typo.

Fixed!

> Otherwise LGTM!

Thanks!

Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

[bug#41855] [PATCH 1/2] hurd-boot: Create individual translators instead of running MAKEDEV.

[Jan Nieuwenhuizen]

[-- Attachment #1: Type: text/plain, Size: 3845 bytes --]

Ludovic Courtès writes:

Hi!

> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:
>
>> * gnu/build/hurd-boot.scm (make-hurd-device-nodes): Do not create
>> dev/{null,zero,full,random,urandom} mount points.
>> (setup-translator, xattr-translator,
>> showtrans-translator?, translated?, set-hurd-device-translators): New
>> procedures.
>> (boot-hurd-system): Use them instead of running MAKEDEV.
>
> This is mostly about moving the logic from the MAKEDEV script to this
> file, right?  Sounds nice.

Yes.  Glad you like the idea too.

>> +(define (xattr-translator? file-name)
>> +  "Return true if FILE-NAME has an extended @code{gnu.translator} attribute
>> +set."
>> +  (false-if-exception
>> +   (not (string-null? (getxattr file-name "gnu.translator")))))
>
> I’d call it ‘passive-translator-xattr?’.

> In general, I’d avoid ‘false-if-exception’ as much as possible because
> it can hide real issues.  So here, you could catch 'system-error and
> check for ENODATA.  If you need it in several places, you can define a
> ‘false-if-ENODATA’ macro

Nice.  Ah, I remember having file-exists? checks or no check at all and
then found it only worked on first boot, not with a persistent image.
Minor detail.  So I got out my axe and..."it worked" :-/

>> +(define (showtrans-translator? file-name)
>> +  "Return true if @file{showtrans} finds a translator installed on FILE-NAME."
>
> Should be ‘passive-translator-installed?’ no?  (IIRC ‘showtrans’ only
> shows passive translator settings by default.)

Yes, thanks.

>> +  (with-output-to-port (%make-void-port "w")
>> +    (lambda _
>> +      (with-error-to-port (%make-void-port "w")
>> +        (lambda _
>> +          (zero? (system* "showtrans" "--silent" file-name)))))))
>> +
>> +(define (translated? file-name)
>> +  "Return true if a translator is installed on FILE-NAME."
>> +  (if (string-contains %host-type "linux-gnu")
>> +      (xattr-translator? file-name)
>> +      (showtrans-translator? file-name)))
>
> It’s counter-intuitive that hurd-boot.scm is used from GNU/Linux.
> Should we move the shared bits in (gnu build hurd) or similar?

Maybe...I don't know.  hurd-boot defines functions that are needed to
create a bootable hurd -- some can be called from GNU/Linux.

Similarly, "linux-boot" defines "make-essential-device-nodes", which
could be called from GNU/Hurd when we cross build a linux VM.

Well, having one weird situation is a bad argument to propagate the
madness.

I guess it makes sense to move utility functions like
passive-translator-xattr, passive-translator-installed?, and translated?
could be moved to (gnu build hurd).

Haven't made this change yet, let me know you want; or feel free to make
the change yourself :-)

>> +(define* (setup-translator file-name command #:optional (mode #o600))
>> +  "Setup translator COMMAND on FILE-NAME."
>
> ‘set-translator’?  :-)

=> set-translator! :-)

>> +  (false-if-exception (mkdir-p (scope "dev/vcs/1")))
>> +  (false-if-exception (mkdir-p (scope "dev/vcs/2")))
>> +  (false-if-exception (mkdir-p (scope "dev/vcs/3")))
>> +  (false-if-exception (rename-file "/dev/console" "/dev/console-"))
>> +  (for-each scope-setup-translator devices)
>> +
>> +  (false-if-exception (symlink "/dev/random" "/dev/urandom"))
>> +  (false-if-exception (mkdir-p "/dev/fd"))
>> +  (false-if-exception (symlink "/dev/fd/0"   "/dev/stdin"))
>> +  (false-if-exception (symlink "/dev/fd/1"   "/dev/stdout"))
>> +  (false-if-exception (symlink "/dev/fd/2"   "/dev/stderr")))
>
> ‘false-if-EEXIST’?

Done for symlink; for mkdir, using

  (define (mkdir* dir)
    (let ((dir (scope dir)))
     (unless (file-exists? dir)
       (mkdir-p dir))))

New patch attached.

Greetings,
Janneke


[-- Attachment #2: v2-0001-hurd-boot-Create-individual-translators-instead-o.patch --]
[-- Type: text/x-patch, Size: 11106 bytes --]

From 1e27aabb8bf32e85547517e1f0e35f789a08933d Mon Sep 17 00:00:00 2001
From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
Date: Mon, 8 Jun 2020 13:02:13 +0200
Subject: [PATCH v2 1/2] hurd-boot: Create individual translators instead of
 running MAKEDEV.

* guix/build/utils.scm
* gnu/build/hurd-boot.scm (make-hurd-device-nodes): Do not create
dev/{null,zero,full,random,urandom} mount points.
(passive-translator-xattr?, passive-translator-installed?, translated?,
set-hurd-device-translators): New procedures.
(false-if-EEXIST): New macro.
(boot-hurd-system): Use them instead of running MAKEDEV.
---
 gnu/build/hurd-boot.scm | 190 ++++++++++++++++++++++++++++++----------
 1 file changed, 143 insertions(+), 47 deletions(-)

diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index 09326233d2..3f0e215344 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -80,16 +80,8 @@ Return the value associated with OPTION, or #f on failure."
     (string-append root (if (string-suffix? "/" root) "" "/") dir))
 
   (mkdir (scope "dev"))
-  (for-each (lambda (file)
-              (call-with-output-file (scope file)
-                (lambda (port)
-                  (display file port)   ;avoid hard-linking
-                  (chmod port #o666))))
-            '("dev/null"
-              "dev/zero"
-              "dev/full"
-              "dev/random"
-              "dev/urandom"))
+  ;; Don't create /dev/null etc just yet; the store
+  ;; messes-up the permission bits.
   ;; Don't create /dev/console, /dev/vcs, etc.: they are created by
   ;; console-run on first boot.
 
@@ -115,6 +107,143 @@ Return the value associated with OPTION, or #f on failure."
   ;; settings?
   )
 
+(define (passive-translator-xattr? file-name)
+  "Return true if FILE-NAME has an extended @code{gnu.translator} attribute
+set."
+  (catch 'system-error
+    (lambda _ (not (string-null? (getxattr file-name "gnu.translator"))))
+    (lambda args
+      (if (= ENODATA (system-error-errno args))
+          #f
+          (apply throw args)))))
+
+(define (passive-translator-installed? file-name)
+  "Return true if @file{showtrans} finds a translator installed on FILE-NAME."
+  (with-output-to-port (%make-void-port "w")
+    (lambda _
+      (with-error-to-port (%make-void-port "w")
+        (lambda _
+          (zero? (system* "showtrans" "--silent" file-name)))))))
+
+(define (translated? file-name)
+  "Return true if a translator is installed on FILE-NAME."
+  (if (string-contains %host-type "linux-gnu")
+      (passive-translator-xattr? file-name)
+      (passive-translator-installed? file-name)))
+
+(define* (set-translator! file-name command #:optional (mode #o600))
+  "Setup translator COMMAND on FILE-NAME."
+  (unless (translated? file-name)
+    (let ((dir (dirname file-name)))
+      (unless (directory-exists? dir)
+        (mkdir-p dir))
+      (unless (file-exists? file-name)
+        (call-with-output-file file-name
+          (lambda (port)
+            (display file-name port)  ;avoid hard-linking
+            (chmod port mode)))))
+    (catch 'system-error
+      (lambda _
+        (apply invoke "settrans" "--create" file-name command))
+      (lambda (key . args)
+        (let ((errno (system-error-errno (cons key args))))
+          (format (current-error-port) "~a: ~a\n"
+                  (strerror errno) file-name)
+          (format (current-error-port) "Ignoring...Good Luck!\n"))))))
+
+(define-syntax-rule (false-if-EEXIST exp)
+  "Evaluate EXP but return #f if it raises to 'system-error with EEXIST."
+  (catch 'system-error
+    (lambda () exp)
+    (lambda args
+      (if (= EEXIST (system-error-errno args))
+          #f
+          (apply throw args)))))
+
+(define* (set-hurd-device-translators #:optional (root "/"))
+  "Make some of the device nodes needed on GNU/Hurd."
+
+  (define (scope dir)
+    (string-append root (if (string-suffix? "/" 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)))))
+
+  (define (mkdir* dir)
+    (let ((dir (scope dir)))
+     (unless (file-exists? dir)
+       (mkdir-p dir))))
+
+  (define servers
+    '(("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.15" ;the default QEMU guest IP
+                                  "--netmask" "255.255.255.0"
+                                  "--gateway" "10.0.2.2"
+                                  "--ipv6" "/servers/socket/16"))))
+
+  (define devices
+    '(("dev/full"    ("/hurd/null"     "--full")            #o666)
+      ("dev/null"    ("/hurd/null")                         #o666)
+      ("dev/random"  ("/hurd/random"   "--seed-file" "/var/lib/random-seed")
+                                                            #o644)
+      ("dev/zero"    ("/hurd/storeio"  "--store-type=zero") #o666)
+
+      ("dev/console" ("/hurd/term"     "/dev/console" "device" "console"))
+
+      ("dev/klog"    ("/hurd/streamio" "kmsg"))
+      ("dev/mem"     ("/hurd/storeio"  "--no-cache" "mem")  #o660)
+      ("dev/shm"     ("/hurd/tmpfs"    "--mode=1777" "50%") #o644)
+      ("dev/time"    ("/hurd/storeio"  "--no-cache" "time") #o644)
+
+      ("dev/vcs"     ("/hurd/console"))
+      ("dev/tty"     ("/hurd/magic"    "tty")               #o666)
+
+      ("dev/tty1"    ("/hurd/term"     "/dev/tty1" "hurdio" "/dev/vcs/1/console")
+                                                            #o666)
+      ("dev/tty2"    ("/hurd/term"     "/dev/tty2" "hurdio" "/dev/vcs/2/console")
+                                                            #o666)
+      ("dev/tty3"    ("/hurd/term"     "/dev/tty3" "hurdio" "/dev/vcs/3/console")
+                                                            #o666)
+
+      ("dev/ptyp0"   ("/hurd/term"     "/dev/ptyp0" "pty-master" "/dev/ttyp0")
+                                                            #o666)
+      ("dev/ptyp1"   ("/hurd/term"     "/dev/ptyp1" "pty-master" "/dev/ttyp1")
+                                                            #o666)
+      ("dev/ptyp2"   ("/hurd/term"     "/dev/ptyp2" "pty-master" "/dev/ttyp2")
+                                                            #o666)
+
+      ("dev/ttyp0"   ("/hurd/term"     "/dev/ttyp0" "pty-slave" "/dev/ptyp0")
+                                                            #o666)
+      ("dev/ttyp1"   ("/hurd/term"     "/dev/ttyp1" "pty-slave" "/dev/ptyp1")
+                                                            #o666)
+      ("dev/ttyp2"   ("/hurd/term"     "/dev/ttyp2" "pty-slave" "/dev/ptyp2")
+                                                            #o666)))
+
+  (for-each scope-set-translator! servers)
+  (mkdir* (scope "dev/vcs/1"))
+  (mkdir* (scope "dev/vcs/2"))
+  (mkdir* (scope "dev/vcs/2"))
+  (rename-file (scope "/dev/console") (scope "/dev/console-"))
+  (for-each scope-set-translator! devices)
+
+  (false-if-EEXIST (symlink "/dev/random" (scope "dev/urandom")))
+  (mkdir* (scope "dev/fd"))
+  (false-if-EEXIST (symlink "/dev/fd/0" (scope "dev/stdin")))
+  (false-if-EEXIST (symlink "/dev/fd/1" (scope "dev/stdout")))
+  (false-if-EEXIST (symlink "/dev/fd/2" (scope "dev/stderr"))))
+
 \f
 (define* (boot-hurd-system #:key (on-error 'debug))
   "This procedure is meant to be called from an early RC script.
@@ -126,20 +255,9 @@ starting the Shepherd.
 XXX TODO: see linux-boot.scm:boot-system.
 XXX TODO: add proper file-system checking, mounting
 XXX TODO: move bits to (new?) (hurd?) (activation?) services
-XXX TODO: use settrans/setxattr instead of MAKEDEV
+XXX TODO: use Linux xattr/setxattr to remove (settrans in) /libexec/RUNSYSTEM
 
 "
-  (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.15" ;the default QEMU guest IP
-                            "--netmask" "255.255.255.0"
-                            "--gateway" "10.0.2.2"
-                            "--ipv6" "/servers/socket/16"))))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
@@ -147,35 +265,13 @@ XXX TODO: use settrans/setxattr instead of MAKEDEV
   (call-with-error-handling
    (lambda ()
 
-     (define (translated? node)
-       ;; Return true if a translator is installed on NODE.
-       (with-output-to-port (%make-void-port "w")
-         (lambda ()
-           (with-error-to-port (%make-void-port "w")
-             (lambda ()
-               (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"))
+       (format #t "Setting-up essential translators...\n")
+       (setenv "PATH" (string-append system "/profile/bin"))
+       (set-hurd-device-translators)
 
        (false-if-exception (delete-file "/hurd"))
        (let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com


[-- Attachment #3: Type: text/plain, Size: 152 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

[bug#41855] [PATCH 1/2] hurd-boot: Create individual translators instead of running MAKEDEV.

[Ludovic Courtès]

Hi,

Jan Nieuwenhuizen <janneke@gnu.org> skribis:

>> It’s counter-intuitive that hurd-boot.scm is used from GNU/Linux.
>> Should we move the shared bits in (gnu build hurd) or similar?
>
> Maybe...I don't know.  hurd-boot defines functions that are needed to
> create a bootable hurd -- some can be called from GNU/Linux.
>
> Similarly, "linux-boot" defines "make-essential-device-nodes", which
> could be called from GNU/Hurd when we cross build a linux VM.

Right.

> Well, having one weird situation is a bad argument to propagate the
> madness.
>
> I guess it makes sense to move utility functions like
> passive-translator-xattr, passive-translator-installed?, and translated?
> could be moved to (gnu build hurd).
>
> Haven't made this change yet, let me know you want; or feel free to make
> the change yourself :-)

Yeah, we can leave that for later.  :-)

> From 1e27aabb8bf32e85547517e1f0e35f789a08933d Mon Sep 17 00:00:00 2001
> From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
> Date: Mon, 8 Jun 2020 13:02:13 +0200
> Subject: [PATCH v2 1/2] hurd-boot: Create individual translators instead of
>  running MAKEDEV.
>
> * guix/build/utils.scm

Something’s wrong!

> * gnu/build/hurd-boot.scm (make-hurd-device-nodes): Do not create
> dev/{null,zero,full,random,urandom} mount points.
> (passive-translator-xattr?, passive-translator-installed?, translated?,
> set-hurd-device-translators): New procedures.
> (false-if-EEXIST): New macro.
> (boot-hurd-system): Use them instead of running MAKEDEV.

[...]

> +(define* (set-translator! file-name command #:optional (mode #o600))

Nitpick: there shouldn’t be a bang here (just like for ‘mkdir’, etc.).

Otherwise LGTM, thank you!

Ludo’.

bug#41855: [PATCH 1/2] hurd-boot: Create individual translators instead of running MAKEDEV.

[Jan Nieuwenhuizen]

Ludovic Courtès writes:

Hi!

> Jan Nieuwenhuizen <janneke@gnu.org> skribis:

>> Similarly, "linux-boot" defines "make-essential-device-nodes", which
>> could be called from GNU/Hurd when we cross build a linux VM.
>
> Right.
>
>> Haven't made this change yet, let me know you want; or feel free to make
>> the change yourself :-)
>
> Yeah, we can leave that for later.  :-)

"Good" :-)

>> From 1e27aabb8bf32e85547517e1f0e35f789a08933d Mon Sep 17 00:00:00 2001
>> From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
>> Date: Mon, 8 Jun 2020 13:02:13 +0200
>> Subject: [PATCH v2 1/2] hurd-boot: Create individual translators instead of
>>  running MAKEDEV.
>>
>> * guix/build/utils.scm
>
> Something’s wrong!

Oops, removed this mid-way change-of-mind sublimation.

>> * gnu/build/hurd-boot.scm (make-hurd-device-nodes): Do not create
>> dev/{null,zero,full,random,urandom} mount points.
>> (passive-translator-xattr?, passive-translator-installed?, translated?,
>> set-hurd-device-translators): New procedures.
>> (false-if-EEXIST): New macro.
>> (boot-hurd-system): Use them instead of running MAKEDEV.
>
> [...]
>
>> +(define* (set-translator! file-name command #:optional (mode #o600))
>
> Nitpick: there shouldn’t be a bang here (just like for ‘mkdir’, etc.).

...ah, interesting.  ! is for scheme'y imperativeness.

> Otherwise LGTM, thank you!

Pushed this serie master as f25e8f76fec03e5a31c221e7427d6962ece1aa67

That was all I have all from wip-hurd-vm.  At least until we decide to
risk using the linux xattr patch (looks like that will be in linux-5.8).

Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com