From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:50644) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1es7dv-00005J-6M for guix-patches@gnu.org; Sat, 03 Mar 2018 08:56:08 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1es7dt-0000rv-8h for guix-patches@gnu.org; Sat, 03 Mar 2018 08:56:07 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:34089) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1es7dt-0000rq-3M for guix-patches@gnu.org; Sat, 03 Mar 2018 08:56:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1es7ds-0006Nv-SX for guix-patches@gnu.org; Sat, 03 Mar 2018 08:56:04 -0500 Subject: [bug#30604] [PATCH v8 7/7] linux-initrd: Factorize %modprobe and flat-linux-module-directory. Resent-Message-ID: From: Danny Milosavljevic Date: Sat, 3 Mar 2018 14:55:33 +0100 Message-Id: <20180303135533.6112-8-dannym@scratchpost.org> In-Reply-To: <20180303135533.6112-1-dannym@scratchpost.org> References: <20180302153408.14091-1-dannym@scratchpost.org> <20180303135533.6112-1-dannym@scratchpost.org> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 30604@debbugs.gnu.org * gnu/build/linux-modules.scm (module-aliases->module-file-names): New procedure. * gnu/system/linux-initrd.scm (%modprobe): Use module-aliases->module-file-names. (flat-linux-module-directory): Use module-aliases->module-file-names. --- gnu/build/linux-modules.scm | 56 +++++++++++++++++++++- gnu/system/linux-initrd.scm | 110 ++++++++++++++++++-------------------------- 2 files changed, 100 insertions(+), 66 deletions(-) diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm index af217c974..44059ad93 100644 --- a/gnu/build/linux-modules.scm +++ b/gnu/build/linux-modules.scm @@ -21,6 +21,7 @@ #:use-module (guix elf) #:use-module (guix glob) #:use-module (guix build syscalls) + #:use-module (guix build utils) ; find-files #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) @@ -28,9 +29,12 @@ #:use-module (ice-9 vlist) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (ice-9 ftw) #:export (dot-ko ensure-dot-ko module-aliases + module-aliases->module-file-names module-dependencies recursive-module-dependencies modules-loaded @@ -385,7 +389,7 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by (define (install-module-files module-files output) "Install MODULE-FILES to OUTPUT. -Precondition: OUTPUT is an empty directory." +Precondition: OUTPUT is an empty directory except for \"modules.builtin\"." (let ((aliases (map (lambda (module-file-name) (format #t "copying '~a'...~%" module-file-name) @@ -431,4 +435,54 @@ Precondition: OUTPUT is an empty directory." (_ #f)) aliases)))))) +(define (module-aliases->module-file-names linux aliases) + "Resolve ALIASES to module file names, including their dependencies (which will appear +first). Each alias will map to a list of module file names. +LINUX is the directory containing \"lib\"." + (define (string->regexp str) + ;; Return a regexp that matches STR exactly. + (string-append "^" (regexp-quote str) "$")) + + (define module-dir + (string-append linux "/lib/modules")) + + (define (find-only-entry directory) + (match (scandir directory) + (("." ".." basename) + (string-append directory "/" basename)))) + + (define linux-release-module-directory + (find-only-entry module-dir)) + + (define known-module-aliases* + (known-module-aliases + (string-append linux-release-module-directory + "/modules.alias"))) + (define (resolve-alias alias) + "If possible, resolve ALIAS to a list of module names. +Otherwise return just ALIAS as possible module names." + (match (delete-duplicates (matching-modules alias + known-module-aliases*)) + (() + (list alias)) + (items + items))) + + (define (lookup module) + (let ((name (ensure-dot-ko module))) + (match (find-files module-dir (string->regexp name)) + ((file) + file) + (() + (error "module not found" name module-dir)) + ((_ ...) + (error "several modules by that name" + name module-dir))))) + (append-map (lambda (alias) + (let ((modules (map lookup (resolve-alias alias)))) + (append (recursive-module-dependencies modules + #:lookup-module + lookup) modules))) + aliases)) + ;;; linux-modules.scm ends here diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 8050ac47e..dc826c63e 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -58,35 +58,14 @@ (define* (%modprobe linux-module-directory #:key (guile %guile-static-stripped)) + "Minimal implementation of modprobe for our initrd. +LINUX-MODULE-DIRECTORY is the directory that contains \"lib\"." (program-file "modprobe" (with-imported-modules (source-module-closure '((gnu build linux-modules))) #~(begin (use-modules (gnu build linux-modules) (ice-9 getopt-long) - (ice-9 match) (srfi srfi-1) (ice-9 ftw)) - (define (find-only-entry directory) - (match (scandir directory) - (("." ".." basename) - (string-append directory "/" basename)))) - (define (resolve-alias alias) - (let* ((linux-release-module-directory - (find-only-entry (string-append "/lib/modules")))) - (match (delete-duplicates (matching-modules alias - (known-module-aliases - (string-append linux-release-module-directory - "/modules.alias")))) - (() - (error "no alias by that name" alias)) - (items - items)))) - (define (lookup-module module) - (let* ((linux-release-module-directory - (find-only-entry (string-append "/lib/modules"))) - (file-name (string-append linux-release-module-directory - "/" (ensure-dot-ko module)))) - (if (file-exists? file-name) - file-name - (error "no module file found for module" module)))) + (ice-9 match) (srfi srfi-1)) (define option-spec '((quiet (single-char #\q) (value #f)))) (define options @@ -98,22 +77,31 @@ (for-each (match-lambda (('quiet . #t) #f) - ((() modules ...) - (for-each (lambda (alias) - (catch #t - (lambda () - (let ((modules (resolve-alias alias))) (for-each (lambda (module) - (load-linux-module* - (lookup-module module) - #:lookup-module - lookup-module)) - modules))) - (lambda (key . args) - (display (cons* key args) - (current-error-port)) - (newline (current-error-port)) - (set! exit-status 1)))) - modules))) + ((() aliases ...) + (catch #t + (lambda () + (let ((module-file-names + (module-aliases->module-file-names + #$linux-module-directory aliases))) + (for-each (lambda (name) + (catch 'system-error + (lambda () + (when (not (load-linux-module* name + #:recursive? + #f)) + (set! exit-status 1))) + (lambda (key . args) + (when (not (= EEXIST + (system-error-errno + (cons key args)))) + (print-exception (current-error-port) + #f key args) + (set! exit-status 1))))) + module-file-names))) + (lambda (key . args) + (print-exception (current-error-port) + #f key args) + (set! exit-status 1))))) options) (exit exit-status)))) #:guile guile)) @@ -173,17 +161,17 @@ the derivations referenced by EXP are automatically copied to the initrd." #:references-graphs `(("init-closure" ,init) ("modprobe-closure" ,modprobe)))) -(define (flat-linux-module-directory linux modules) - "Return a flat directory containing the Linux kernel modules listed in -MODULES and taken from LINUX." +(define (flat-linux-module-directory linux aliases) + "Return a flat directory containing the Linux kernel modules resolved by +ALIASES and taken from LINUX." (define build-exp (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules))) #~(begin - (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw) + (use-modules (ice-9 match) (ice-9 ftw) (srfi srfi-1) - (guix build utils) + (guix build utils) ; TODO: Remove (gnu build linux-modules)) (define (string->regexp str) @@ -193,33 +181,25 @@ MODULES and taken from LINUX." (define module-dir (string-append #$linux "/lib/modules")) - (define (lookup module) - (let ((name (ensure-dot-ko module))) - (match (find-files module-dir (string->regexp name)) - ((file) - file) - (() - (error "module not found" name module-dir)) - ((_ ...) - (error "several modules by that name" - name module-dir))))) + (define (find-only-entry directory) + (match (scandir directory) + (("." ".." basename) + (string-append directory "/" basename)))) + + (define linux-release-module-directory + (find-only-entry module-dir)) (define modules - (let ((modules (map lookup '#$modules))) - (append modules - (recursive-module-dependencies modules - #:lookup-module lookup)))) + (module-aliases->module-file-names #$linux '#$aliases)) (define version - (match - (filter - (lambda (name) - (not (string-prefix? "." name))) - (scandir module-dir)) - ((item) item))) + (basename linux-release-module-directory)) (let ((output (string-append #$output "/lib/modules/" version))) (mkdir-p output) + (install-file + (string-append linux-release-module-directory "/modules.builtin") + output) (install-module-files (delete-duplicates modules) output)) #t))) (computed-file "linux-modules" build-exp))