bug#22050: [PATCH v3 1/2] linux-boot: Add make-static-device-nodes.

[Danny Milosavljevic <dannym@scratchpost.org>]

* gnu/build/linux-boot.scm (make-static-device-nodes): New variable.
---
 gnu/build/linux-boot.scm | 63 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 2547f1e0a..f6eea96e3 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -24,6 +24,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 popen)
   #:use-module (ice-9 ftw)
   #:use-module (guix build utils)
   #:use-module ((guix build syscalls)
@@ -35,6 +37,7 @@
             linux-command-line
             find-long-option
             make-essential-device-nodes
+            make-static-device-nodes
             configure-qemu-networking
 
             bind-mount
@@ -105,6 +108,66 @@ with the given MAJOR number, starting with MINOR."
              'block-special #o644 (device-number major (+ minor i)))
       (loop (+ i 1)))))
 
+(define (tmpfiles-mknod name type mode-string device-number-string)
+  "Given a NAME, TYPE, MODE-STRING, DEVICE-NUMBER-STRING,
+   call mknod with the respective numbers."
+  (let* ((mode (string->number mode-string 8))
+         (device-number-parts (string-split device-number-string #\:)))
+    (match device-number-parts
+     ((major-device-number-string minor-device-number-string)
+      (let ((major-device-number (string->number major-device-number-string))
+            (minor-device-number (string->number minor-device-number-string)))
+        (mknod name type #o660 (device-number major-device-number
+                                              minor-device-number))))
+     (_ #f))))
+
+(define (log-static-device-system-error name callback)
+  "Call CALLBACK.  If it fails, print an error message."
+  (catch 'system-error
+    (lambda ()
+      (callback))
+    (lambda args
+      (format #t "could not create node '~a'~%" name))))
+
+(define* (make-static-device-nodes kmod-executable-name)
+  "Invoke and handle 'kmod static-nodes' output."
+  ;; "kmod static-nodes --format=tmpfiles" output format:
+  ;;   c! /dev/fuse 0600 - - - 10:229
+  ;;   d /dev/vfio 0755 - - -
+  (let ((port (open-pipe* OPEN_READ
+                          kmod-executable-name
+                          "static-nodes"
+                          "--format=tmpfiles"
+                          "--output=/proc/self/fd/1")))
+    (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (let loop ((line (read-line port)))
+          (if (not (eof-object? line))
+            (let ((fields (string-split line #\space)))
+              (match fields
+               (("d" name mode-string "-" "-" "-")
+                (let ((mode (string->number mode-string 8)))
+                  (log-static-device-system-error name
+                    (lambda ()
+                      (unless (file-exists? name)
+                        (mkdir name mode))))))
+               (("c!" name mode-string "-" "-" "-" device-number-string)
+                (log-static-device-system-error name
+                  (lambda ()
+                    (tmpfiles-mknod name 'char-special mode-string
+                                    device-number-string))))
+               (("b!" name mode-string "-" "-" "-" device-number-string)
+                (log-static-device-system-error name
+                  (lambda ()
+                    (tmpfiles-mknod name 'block-special mode-string
+                                    device-number-string))))
+               (_ #f))
+              (loop (read-line port))))))
+      (lambda ()
+        (close-pipe port)))))
+
 (define* (make-essential-device-nodes #:key (root "/"))
   "Make essential device nodes under ROOT/dev."
   ;; The hand-made devtmpfs/udev!