summaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2019-08-22 15:53:27 -0400
committerMark H Weaver <mhw@netris.org>2019-08-22 15:53:27 -0400
commit893c2df00daa4e6dd6a7ff3813d7df5329877f9e (patch)
treeacd0db459464acae47083b66d5ce12cc656e2f10 /gnu/build
parent04b9b7bb05aff4c41f46cd79aa7bc953ace16e86 (diff)
parent0ccc9a0f5bb89b239d56157ea66f8420fcec5ba6 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/cross-toolchain.scm15
-rw-r--r--gnu/build/linux-boot.scm9
-rw-r--r--gnu/build/linux-modules.scm147
3 files changed, 158 insertions, 13 deletions
diff --git a/gnu/build/cross-toolchain.scm b/gnu/build/cross-toolchain.scm
index 53d6d39187..1704157750 100644
--- a/gnu/build/cross-toolchain.scm
+++ b/gnu/build/cross-toolchain.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2019 Carl Dong <contact@carldong.me>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -93,7 +94,7 @@ C_INCLUDE_PATH et al."
;; We're building the sans-libc cross-compiler, so nothing to do.
#t)))
-(define* (set-cross-path/mingw #:key inputs #:allow-other-keys)
+(define* (set-cross-path/mingw #:key inputs target #:allow-other-keys)
"Add the cross MinGW headers to CROSS_C_*_INCLUDE_PATH, and remove them from
C_*INCLUDE_PATH."
(let ((libc (assoc-ref inputs "libc"))
@@ -110,7 +111,7 @@ C_*INCLUDE_PATH."
(if libc
(let ((cpath (string-append libc "/include"
- ":" libc "/i686-w64-mingw32/include")))
+ ":" libc "/" target "/include")))
(for-each (cut setenv <> cpath)
%gcc-cross-include-paths))
@@ -140,7 +141,7 @@ C_*INCLUDE_PATH."
(when libc
(setenv "CROSS_LIBRARY_PATH"
(string-append libc "/lib"
- ":" libc "/i686-w64-mingw32/lib")))
+ ":" libc "/" target "/lib")))
(setenv "CPP" (string-append gcc "/bin/cpp"))
(for-each (lambda (var)
@@ -166,8 +167,12 @@ C_*INCLUDE_PATH."
a target triplet."
(modify-phases phases
(add-before 'configure 'set-cross-path
- (if (string-contains target "mingw")
- set-cross-path/mingw
+ ;; This mingw32 target checking logic should match that of target-mingw?
+ ;; in (guix utils), but (guix utils) is too large too copy over to the
+ ;; build side entirely and for now we have no way to select variables to
+ ;; copy over. See (gnu packages cross-base) for more details.
+ (if (string-suffix? "-mingw32" target)
+ (cut set-cross-path/mingw #:target target <...>)
set-cross-path))
(add-after 'install 'make-cross-binutils-visible
(cut make-cross-binutils-visible #:target target <...>))
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 03f2ea245c..f273957d78 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -471,10 +471,6 @@ upon error."
mounts)
"ext4"))
- (define (lookup-module name)
- (string-append linux-module-directory "/"
- (ensure-dot-ko name)))
-
(display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n")
@@ -489,9 +485,8 @@ upon error."
(start-repl))
(display "loading kernel modules...\n")
- (for-each (cut load-linux-module* <>
- #:lookup-module lookup-module)
- (map lookup-module linux-modules))
+ (load-linux-modules-from-directory linux-modules
+ linux-module-directory)
(when keymap-file
(let ((status (system* "loadkeys" keymap-file)))
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index c66ef97012..a149eff329 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,8 +31,10 @@
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
+ #:autoload (ice-9 pretty-print) (pretty-print)
#:export (dot-ko
ensure-dot-ko
+ module-formal-name
module-aliases
module-dependencies
module-soft-dependencies
@@ -42,13 +45,18 @@
modules-loaded
module-loaded?
load-linux-module*
+ load-linux-modules-from-directory
current-module-debugging-port
device-module-aliases
known-module-aliases
matching-modules
- missing-modules))
+ missing-modules
+
+ write-module-name-database
+ write-module-alias-database
+ write-module-device-database))
;;; Commentary:
;;;
@@ -95,6 +103,14 @@ key/value pairs.."
(define %not-comma
(char-set-complement (char-set #\,)))
+(define (module-formal-name file)
+ "Return the module name of FILE as it appears in its info section. Usually
+the module name is the same as the base name of FILE, modulo hyphens and minus
+the \".ko\" extension."
+ (match (assq 'name (modinfo-section-contents file))
+ (('name . name) name)
+ (#f #f)))
+
(define (module-dependencies file)
"Return the list of modules that FILE depends on. The returned list
contains module names, not actual file names."
@@ -310,6 +326,18 @@ appears in BLACK-LIST are not loaded."
(or (and recursive? (= EEXIST (system-error-errno args)))
(apply throw args)))))))
+(define (load-linux-modules-from-directory modules directory)
+ "Load MODULES and their dependencies from DIRECTORY, a directory containing
+the '.ko' files. The '.ko' suffix is automatically added to MODULES if
+needed."
+ (define module-name->file-name
+ (module-name-lookup directory))
+
+ (for-each (lambda (module)
+ (load-linux-module* (module-name->file-name module)
+ #:lookup-module module-name->file-name))
+ modules))
+
;;;
;;; Device modules.
@@ -486,4 +514,121 @@ are required to access DEVICE."
(remove (cut member <> provided) modules))
'()))
+
+;;;
+;;; Module databases.
+;;;
+
+(define (module-name->file-name/guess directory name)
+ "Guess the file name corresponding to NAME, a module name. That doesn't
+always work because sometimes underscores in NAME map to hyphens (e.g.,
+\"input-leds.ko\"), sometimes not (e.g., \"mac_hid.ko\")."
+ (string-append directory "/" (ensure-dot-ko name)))
+
+(define (module-name-lookup directory)
+ "Return a one argument procedure that takes a module name (e.g.,
+\"input_leds\") and returns its absolute file name (e.g.,
+\"/.../input-leds.ko\")."
+ (catch 'system-error
+ (lambda ()
+ (define mapping
+ (call-with-input-file (string-append directory "/modules.name")
+ read))
+
+ (lambda (name)
+ (or (assoc-ref mapping name)
+ (module-name->file-name/guess directory name))))
+ (lambda args
+ (if (= ENOENT (system-error-errno args))
+ (cut module-name->file-name/guess directory <>)
+ (apply throw args)))))
+
+(define (write-module-name-database directory)
+ "Write a database that maps \"module names\" as they appear in the relevant
+ELF section of '.ko' files, to actual file names. This format is
+Guix-specific. It aims to deal with inconsistent naming, in particular
+hyphens vs. underscores."
+ (define mapping
+ (map (lambda (file)
+ (match (module-formal-name file)
+ (#f (cons (basename file ".ko") file))
+ (name (cons name file))))
+ (find-files directory "\\.ko$")))
+
+ (call-with-output-file (string-append directory "/modules.name")
+ (lambda (port)
+ (display ";; Module name to file name mapping.
+;;
+;; This format is Guix-specific; it is not supported by upstream Linux tools.
+\n"
+ port)
+ (pretty-print mapping port))))
+
+(define (write-module-alias-database directory)
+ "Traverse the '.ko' files in DIRECTORY and create the corresponding
+'modules.alias' file."
+ (define aliases
+ (map (lambda (file)
+ (cons (file-name->module-name file) (module-aliases file)))
+ (find-files directory "\\.ko$")))
+
+ (call-with-output-file (string-append directory "/modules.alias")
+ (lambda (port)
+ (display "# Aliases extracted from modules themselves.\n" port)
+ (for-each (match-lambda
+ ((module . aliases)
+ (for-each (lambda (alias)
+ (format port "alias ~a ~a\n" alias module))
+ aliases)))
+ aliases))))
+
+(define (aliases->device-tuple aliases)
+ "Traverse ALIASES, a list of module aliases, and search for
+\"char-major-M-N\", \"block-major-M-N\", or \"devname:\" aliases. When they
+are found, return a tuple (DEVNAME TYPE MAJOR MINOR), otherwise return #f."
+ (define (char/block-major? alias)
+ (or (string-prefix? "char-major-" alias)
+ (string-prefix? "block-major-" alias)))
+
+ (define (char/block-major->tuple alias)
+ (match (string-tokenize alias %not-dash)
+ ((type "major" (= string->number major) (= string->number minor))
+ (list (match type
+ ("char" "c")
+ ("block" "b"))
+ major minor))))
+
+ (let* ((devname (any (lambda (alias)
+ (and (string-prefix? "devname:" alias)
+ (string-drop alias 8)))
+ aliases))
+ (major/minor (match (find char/block-major? aliases)
+ (#f #f)
+ (str (char/block-major->tuple str)))))
+ (and devname major/minor
+ (cons devname major/minor))))
+
+(define %not-dash
+ (char-set-complement (char-set #\-)))
+
+(define (write-module-device-database directory)
+ "Traverse the '.ko' files in DIRECTORY and create the corresponding
+'modules.devname' file. This file contains information about modules that can
+be loaded on-demand, such as file system modules."
+ (define aliases
+ (filter-map (lambda (file)
+ (match (aliases->device-tuple (module-aliases file))
+ (#f #f)
+ (tuple (cons (file-name->module-name file) tuple))))
+ (find-files directory "\\.ko$")))
+
+ (call-with-output-file (string-append directory "/modules.devname")
+ (lambda (port)
+ (display "# Device nodes to trigger on-demand module loading.\n" port)
+ (for-each (match-lambda
+ ((module devname type major minor)
+ (format port "~a ~a ~a~a:~a~%"
+ module devname type major minor)))
+ aliases))))
+
;;; linux-modules.scm ends here