From mboxrd@z Thu Jan 1 00:00:00 1970 From: Danny Milosavljevic Subject: bug#22050: [PATCH v2 1/2] linux-boot: Add make-static-device-nodes. Date: Wed, 13 Dec 2017 23:17:58 +0100 Message-ID: <20171213221759.1955-2-dannym@scratchpost.org> References: <20171213220445.1056-1-dannym@scratchpost.org> <20171213221759.1955-1-dannym@scratchpost.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:36024) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ePFOj-0000Iv-AA for bug-guix@gnu.org; Wed, 13 Dec 2017 17:21:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ePFOg-0000Cj-MG for bug-guix@gnu.org; Wed, 13 Dec 2017 17:21:05 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:52222) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ePFOg-0000Ca-Ha for bug-guix@gnu.org; Wed, 13 Dec 2017 17:21:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ePFOg-00086h-C3 for bug-guix@gnu.org; Wed, 13 Dec 2017 17:21:02 -0500 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <20171213221759.1955-1-dannym@scratchpost.org> List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: 22050@debbugs.gnu.org, ludo@gnu.org * gnu/build/linux-boot.scm (make-static-device-nodes): New variable. --- gnu/build/linux-boot.scm | 62 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index 2547f1e0a..54e919fcb 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,65 @@ 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 () + (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!