aboutsummaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/linux-modules.scm78
1 files changed, 57 insertions, 21 deletions
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index e6552fdb67..bbe1a74d85 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -96,6 +96,11 @@ contains module names, not actual file names."
name
(dot-ko name)))
+(define (file-name->module-name file)
+ "Return the module name corresponding to FILE, stripping the trailing '.ko',
+etc."
+ (basename file ".ko"))
+
(define* (recursive-module-dependencies files
#:key (lookup-module dot-ko))
"Return the topologically-sorted list of file names of the modules depended
@@ -130,6 +135,22 @@ LOOKUP-MODULE to the module name."
(((modules . _) ...)
modules))))
+(define (module-black-list)
+ "Return the black list of modules that must not be loaded. This black list
+is specified using 'modprobe.blacklist=MODULE1,MODULE2,...' on the kernel
+command line; it is honored by libkmod."
+ (define parameter
+ "modprobe.blacklist=")
+
+ (let ((command (call-with-input-file "/proc/cmdline"
+ get-string-all)))
+ (append-map (lambda (arg)
+ (if (string-prefix? parameter arg)
+ (string-tokenize (string-drop arg (string-length parameter))
+ %not-comma)
+ '()))
+ (string-tokenize command))))
+
(define (module-loaded? module)
"Return #t if MODULE is already loaded. MODULE must be a Linux module name,
not a file name."
@@ -138,29 +159,44 @@ not a file name."
(define* (load-linux-module* file
#:key
(recursive? #t)
- (lookup-module dot-ko))
- "Load Linux module from FILE, the name of a `.ko' file. When RECURSIVE? is
-true, load its dependencies first (à la 'modprobe'.) The actual files
-containing modules depended on are obtained by calling LOOKUP-MODULE with the
-module name."
+ (lookup-module dot-ko)
+ (black-list (module-black-list)))
+ "Load Linux module from FILE, the name of a '.ko' file; return true on
+success, false otherwise. When RECURSIVE? is true, load its dependencies
+first (à la 'modprobe'.) The actual files containing modules depended on are
+obtained by calling LOOKUP-MODULE with the module name. Modules whose name
+appears in BLACK-LIST are not loaded."
(define (slurp module)
;; TODO: Use 'finit_module' to reduce memory usage.
(call-with-input-file file get-bytevector-all))
- (when recursive?
- (for-each (cut load-linux-module* <> #:lookup-module lookup-module)
- (map lookup-module (module-dependencies file))))
-
- (format (current-module-debugging-port)
- "loading Linux module from '~a'...~%" file)
-
- (catch 'system-error
- (lambda ()
- (load-linux-module (slurp file)))
- (lambda args
- ;; If this module was already loaded and we're in modprobe style, ignore
- ;; the error.
- (unless (and recursive? (= EEXIST (system-error-errno args)))
- (apply throw args)))))
+ (define (black-listed? module)
+ (let ((result (member module black-list)))
+ (when result
+ (format (current-module-debugging-port)
+ "not loading module '~a' because it's black-listed~%"
+ module))
+ result))
+
+ (define (load-dependencies file)
+ (let ((dependencies (module-dependencies file)))
+ (every (cut load-linux-module* <> #:lookup-module lookup-module)
+ (map lookup-module dependencies))))
+
+ (and (not (black-listed? (file-name->module-name file)))
+ (or (not recursive?)
+ (load-dependencies file))
+ (begin
+ (format (current-module-debugging-port)
+ "loading Linux module from '~a'...~%" file)
+
+ (catch 'system-error
+ (lambda ()
+ (load-linux-module (slurp file)))
+ (lambda args
+ ;; If this module was already loaded and we're in modprobe style, ignore
+ ;; the error.
+ (or (and recursive? (= EEXIST (system-error-errno args)))
+ (apply throw args)))))))
;;; linux-modules.scm ends here