diff options
| -rw-r--r-- | gnu/build/linux-modules.scm | 78 |
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 |