;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (gnu build linux-modules)
#:use-module (guix elf)
+ #:use-module (guix build syscalls)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
name
(dot-ko name)))
+(define (normalize-module-name module)
+ "Return the \"canonical\" name for MODULE, replacing hyphens with
+underscores."
+ ;; See 'modname_normalize' in libkmod.
+ (string-map (lambda (chr)
+ (case chr
+ ((#\-) #\_)
+ (else chr)))
+ module))
+
+(define (file-name->module-name file)
+ "Return the module name corresponding to FILE, stripping the trailing '.ko'
+and normalizing it."
+ (normalize-module-name (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
(((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 for users that pass
+'KMOD_PROBE_APPLY_BLACKLIST', which includes 'modprobe --use-blacklist' and
+udev."
+ (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."
(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 'mmap' to reduce memory usage.
+ ;; 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