Commit | Line | Data |
---|---|---|
fcaa5f44 | 1 | ;;; GNU Guix --- Functional package management for GNU |
7ba903b6 | 2 | ;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org> |
fcaa5f44 LC |
3 | ;;; |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (gnu build linux-modules) | |
20 | #:use-module (guix elf) | |
21 | #:use-module (rnrs io ports) | |
22 | #:use-module (rnrs bytevectors) | |
23 | #:use-module (srfi srfi-1) | |
24 | #:use-module (srfi srfi-26) | |
25 | #:use-module (ice-9 vlist) | |
26 | #:use-module (ice-9 match) | |
27 | #:export (dot-ko | |
28 | ensure-dot-ko | |
29 | module-dependencies | |
30 | recursive-module-dependencies | |
31 | modules-loaded | |
32 | module-loaded? | |
33 | load-linux-module* | |
34 | ||
35 | current-module-debugging-port)) | |
36 | ||
37 | ;;; Commentary: | |
38 | ;;; | |
39 | ;;; Tools to deal with Linux kernel modules. | |
40 | ;;; | |
41 | ;;; Code: | |
42 | ||
43 | (define current-module-debugging-port | |
44 | (make-parameter (%make-void-port "w"))) | |
45 | ||
46 | (define (section-contents elf section) | |
47 | "Return the contents of SECTION in ELF as a bytevector." | |
48 | (let* ((modinfo (elf-section-by-name elf ".modinfo")) | |
49 | (contents (make-bytevector (elf-section-size modinfo)))) | |
50 | (bytevector-copy! (elf-bytes elf) (elf-section-offset modinfo) | |
51 | contents 0 | |
52 | (elf-section-size modinfo)) | |
53 | contents)) | |
54 | ||
55 | (define %not-nul | |
56 | (char-set-complement (char-set #\nul))) | |
57 | ||
58 | (define (nul-separated-string->list str) | |
59 | "Split STR at occurrences of the NUL character and return the resulting | |
60 | string list." | |
61 | (string-tokenize str %not-nul)) | |
62 | ||
63 | (define (key=value->pair str) | |
64 | "Assuming STR has the form \"KEY=VALUE\", return a pair like (KEY | |
65 | . \"VALUE\")." | |
66 | (let ((= (string-index str #\=))) | |
67 | (cons (string->symbol (string-take str =)) | |
68 | (string-drop str (+ 1 =))))) | |
69 | ||
70 | (define (modinfo-section-contents file) | |
71 | "Return the contents of the '.modinfo' section of FILE as a list of | |
72 | key/value pairs.." | |
73 | (let* ((bv (call-with-input-file file get-bytevector-all)) | |
74 | (elf (parse-elf bv)) | |
75 | (modinfo (section-contents elf ".modinfo"))) | |
76 | (map key=value->pair | |
77 | (nul-separated-string->list (utf8->string modinfo))))) | |
78 | ||
79 | (define %not-comma | |
80 | (char-set-complement (char-set #\,))) | |
81 | ||
82 | (define (module-dependencies file) | |
83 | "Return the list of modules that FILE depends on. The returned list | |
84 | contains module names, not actual file names." | |
85 | (let ((info (modinfo-section-contents file))) | |
86 | (match (assq 'depends info) | |
87 | (('depends . what) | |
88 | (string-tokenize what %not-comma))))) | |
89 | ||
90 | (define dot-ko | |
91 | (cut string-append <> ".ko")) | |
92 | ||
93 | (define (ensure-dot-ko name) | |
94 | "Return NAME with a '.ko' prefix appended, unless it already has it." | |
95 | (if (string-suffix? ".ko" name) | |
96 | name | |
97 | (dot-ko name))) | |
98 | ||
5c7dd5ac LC |
99 | (define (normalize-module-name module) |
100 | "Return the \"canonical\" name for MODULE, replacing hyphens with | |
101 | underscores." | |
102 | ;; See 'modname_normalize' in libkmod. | |
103 | (string-map (lambda (chr) | |
104 | (case chr | |
105 | ((#\-) #\_) | |
106 | (else chr))) | |
107 | module)) | |
108 | ||
7ba903b6 | 109 | (define (file-name->module-name file) |
5c7dd5ac LC |
110 | "Return the module name corresponding to FILE, stripping the trailing '.ko' |
111 | and normalizing it." | |
112 | (normalize-module-name (basename file ".ko"))) | |
7ba903b6 | 113 | |
fcaa5f44 LC |
114 | (define* (recursive-module-dependencies files |
115 | #:key (lookup-module dot-ko)) | |
116 | "Return the topologically-sorted list of file names of the modules depended | |
117 | on by FILES, recursively. File names of modules are determined by applying | |
118 | LOOKUP-MODULE to the module name." | |
119 | (let loop ((files files) | |
120 | (result '()) | |
121 | (visited vlist-null)) | |
122 | (match files | |
123 | (() | |
124 | (delete-duplicates (reverse result))) | |
125 | ((head . tail) | |
126 | (let* ((visited? (vhash-assoc head visited)) | |
127 | (deps (if visited? | |
128 | '() | |
129 | (map lookup-module (module-dependencies head)))) | |
130 | (visited (if visited? | |
131 | visited | |
132 | (vhash-cons head #t visited)))) | |
133 | (loop (append deps tail) | |
134 | (append result deps) visited)))))) | |
135 | ||
136 | (define %not-newline | |
137 | (char-set-complement (char-set #\newline))) | |
138 | ||
139 | (define (modules-loaded) | |
140 | "Return the list of names of currently loaded Linux modules." | |
141 | (let* ((contents (call-with-input-file "/proc/modules" | |
142 | get-string-all)) | |
143 | (lines (string-tokenize contents %not-newline))) | |
144 | (match (map string-tokenize lines) | |
145 | (((modules . _) ...) | |
146 | modules)))) | |
147 | ||
7ba903b6 LC |
148 | (define (module-black-list) |
149 | "Return the black list of modules that must not be loaded. This black list | |
150 | is specified using 'modprobe.blacklist=MODULE1,MODULE2,...' on the kernel | |
5c7dd5ac LC |
151 | command line; it is honored by libkmod for users that pass |
152 | 'KMOD_PROBE_APPLY_BLACKLIST', which includes 'modprobe --use-blacklist' and | |
153 | udev." | |
7ba903b6 LC |
154 | (define parameter |
155 | "modprobe.blacklist=") | |
156 | ||
157 | (let ((command (call-with-input-file "/proc/cmdline" | |
158 | get-string-all))) | |
159 | (append-map (lambda (arg) | |
160 | (if (string-prefix? parameter arg) | |
161 | (string-tokenize (string-drop arg (string-length parameter)) | |
162 | %not-comma) | |
163 | '())) | |
164 | (string-tokenize command)))) | |
165 | ||
fcaa5f44 LC |
166 | (define (module-loaded? module) |
167 | "Return #t if MODULE is already loaded. MODULE must be a Linux module name, | |
168 | not a file name." | |
169 | (member module (modules-loaded))) | |
170 | ||
171 | (define* (load-linux-module* file | |
172 | #:key | |
173 | (recursive? #t) | |
7ba903b6 LC |
174 | (lookup-module dot-ko) |
175 | (black-list (module-black-list))) | |
176 | "Load Linux module from FILE, the name of a '.ko' file; return true on | |
177 | success, false otherwise. When RECURSIVE? is true, load its dependencies | |
178 | first (à la 'modprobe'.) The actual files containing modules depended on are | |
179 | obtained by calling LOOKUP-MODULE with the module name. Modules whose name | |
180 | appears in BLACK-LIST are not loaded." | |
fcaa5f44 | 181 | (define (slurp module) |
fb741749 | 182 | ;; TODO: Use 'finit_module' to reduce memory usage. |
fcaa5f44 LC |
183 | (call-with-input-file file get-bytevector-all)) |
184 | ||
7ba903b6 LC |
185 | (define (black-listed? module) |
186 | (let ((result (member module black-list))) | |
187 | (when result | |
188 | (format (current-module-debugging-port) | |
189 | "not loading module '~a' because it's black-listed~%" | |
190 | module)) | |
191 | result)) | |
192 | ||
193 | (define (load-dependencies file) | |
194 | (let ((dependencies (module-dependencies file))) | |
195 | (every (cut load-linux-module* <> #:lookup-module lookup-module) | |
196 | (map lookup-module dependencies)))) | |
197 | ||
198 | (and (not (black-listed? (file-name->module-name file))) | |
199 | (or (not recursive?) | |
200 | (load-dependencies file)) | |
201 | (begin | |
202 | (format (current-module-debugging-port) | |
203 | "loading Linux module from '~a'...~%" file) | |
204 | ||
205 | (catch 'system-error | |
206 | (lambda () | |
207 | (load-linux-module (slurp file))) | |
208 | (lambda args | |
209 | ;; If this module was already loaded and we're in modprobe style, ignore | |
210 | ;; the error. | |
211 | (or (and recursive? (= EEXIST (system-error-errno args))) | |
212 | (apply throw args))))))) | |
fcaa5f44 LC |
213 | |
214 | ;;; linux-modules.scm ends here |