Commit | Line | Data |
---|---|---|
fcaa5f44 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> | |
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 | ||
99 | (define* (recursive-module-dependencies files | |
100 | #:key (lookup-module dot-ko)) | |
101 | "Return the topologically-sorted list of file names of the modules depended | |
102 | on by FILES, recursively. File names of modules are determined by applying | |
103 | LOOKUP-MODULE to the module name." | |
104 | (let loop ((files files) | |
105 | (result '()) | |
106 | (visited vlist-null)) | |
107 | (match files | |
108 | (() | |
109 | (delete-duplicates (reverse result))) | |
110 | ((head . tail) | |
111 | (let* ((visited? (vhash-assoc head visited)) | |
112 | (deps (if visited? | |
113 | '() | |
114 | (map lookup-module (module-dependencies head)))) | |
115 | (visited (if visited? | |
116 | visited | |
117 | (vhash-cons head #t visited)))) | |
118 | (loop (append deps tail) | |
119 | (append result deps) visited)))))) | |
120 | ||
121 | (define %not-newline | |
122 | (char-set-complement (char-set #\newline))) | |
123 | ||
124 | (define (modules-loaded) | |
125 | "Return the list of names of currently loaded Linux modules." | |
126 | (let* ((contents (call-with-input-file "/proc/modules" | |
127 | get-string-all)) | |
128 | (lines (string-tokenize contents %not-newline))) | |
129 | (match (map string-tokenize lines) | |
130 | (((modules . _) ...) | |
131 | modules)))) | |
132 | ||
133 | (define (module-loaded? module) | |
134 | "Return #t if MODULE is already loaded. MODULE must be a Linux module name, | |
135 | not a file name." | |
136 | (member module (modules-loaded))) | |
137 | ||
138 | (define* (load-linux-module* file | |
139 | #:key | |
140 | (recursive? #t) | |
141 | (lookup-module dot-ko)) | |
142 | "Load Linux module from FILE, the name of a `.ko' file. When RECURSIVE? is | |
143 | true, load its dependencies first (à la 'modprobe'.) The actual files | |
144 | containing modules depended on are obtained by calling LOOKUP-MODULE with the | |
145 | module name." | |
146 | (define (slurp module) | |
147 | ;; TODO: Use 'mmap' to reduce memory usage. | |
148 | (call-with-input-file file get-bytevector-all)) | |
149 | ||
150 | (when recursive? | |
151 | (for-each (cut load-linux-module* <> #:lookup-module lookup-module) | |
152 | (map lookup-module (module-dependencies file)))) | |
153 | ||
154 | (format (current-module-debugging-port) | |
155 | "loading Linux module from '~a'...~%" file) | |
156 | ||
157 | (catch 'system-error | |
158 | (lambda () | |
159 | (load-linux-module (slurp file))) | |
160 | (lambda args | |
161 | ;; If this module was already loaded and we're in modprobe style, ignore | |
162 | ;; the error. | |
7c4885f0 | 163 | (unless (and recursive? (= EEXIST (system-error-errno args))) |
fcaa5f44 LC |
164 | (apply throw args))))) |
165 | ||
166 | ;;; linux-modules.scm ends here |