linux-modules: Support 'modprobe.blacklist' on the command line.

* gnu/build/linux-modules.scm (file-name->module-name)
(module-black-list): New procedure.
* gnu/build/linux-modules.scm (load-linux-module*): Add #:black-list
parameter.
[black-listed?, load-dependencies]: New procedures.
Use them.
This commit is contained in:
Ludovic Courtès 2016-01-16 14:21:57 +01:00
parent 67cedc4ba6
commit 7ba903b6db
1 changed files with 55 additions and 19 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -96,6 +96,11 @@ contains module names, not actual file names."
name name
(dot-ko 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 (define* (recursive-module-dependencies files
#:key (lookup-module dot-ko)) #:key (lookup-module dot-ko))
"Return the topologically-sorted list of file names of the modules depended "Return the topologically-sorted list of file names of the modules depended
@ -130,6 +135,22 @@ LOOKUP-MODULE to the module name."
(((modules . _) ...) (((modules . _) ...)
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) (define (module-loaded? module)
"Return #t if MODULE is already loaded. MODULE must be a Linux module name, "Return #t if MODULE is already loaded. MODULE must be a Linux module name,
not a file name." not a file name."
@ -138,29 +159,44 @@ not a file name."
(define* (load-linux-module* file (define* (load-linux-module* file
#:key #:key
(recursive? #t) (recursive? #t)
(lookup-module dot-ko)) (lookup-module dot-ko)
"Load Linux module from FILE, the name of a `.ko' file. When RECURSIVE? is (black-list (module-black-list)))
true, load its dependencies first (à la 'modprobe'.) The actual files "Load Linux module from FILE, the name of a '.ko' file; return true on
containing modules depended on are obtained by calling LOOKUP-MODULE with the success, false otherwise. When RECURSIVE? is true, load its dependencies
module name." 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) (define (slurp module)
;; TODO: Use 'finit_module' to reduce memory usage. ;; TODO: Use 'finit_module' to reduce memory usage.
(call-with-input-file file get-bytevector-all)) (call-with-input-file file get-bytevector-all))
(when recursive? (define (black-listed? module)
(for-each (cut load-linux-module* <> #:lookup-module lookup-module) (let ((result (member module black-list)))
(map lookup-module (module-dependencies file)))) (when result
(format (current-module-debugging-port)
"not loading module '~a' because it's black-listed~%"
module))
result))
(format (current-module-debugging-port) (define (load-dependencies file)
"loading Linux module from '~a'...~%" file) (let ((dependencies (module-dependencies file)))
(every (cut load-linux-module* <> #:lookup-module lookup-module)
(map lookup-module dependencies))))
(catch 'system-error (and (not (black-listed? (file-name->module-name file)))
(lambda () (or (not recursive?)
(load-linux-module (slurp file))) (load-dependencies file))
(lambda args (begin
;; If this module was already loaded and we're in modprobe style, ignore (format (current-module-debugging-port)
;; the error. "loading Linux module from '~a'...~%" file)
(unless (and recursive? (= EEXIST (system-error-errno args)))
(apply throw args))))) (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 ;;; linux-modules.scm ends here