Commit | Line | Data |
---|---|---|
29fa45f4 | 1 | ;;; GNU Guix --- Functional package management for GNU |
7adbe85e | 2 | ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> |
b4abdeb6 | 3 | ;;; Copyright © 2015 David Thompson <davet@gnu.org> |
29fa45f4 LC |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (test-syscalls) | |
df3ce5c1 | 21 | #:use-module (guix utils) |
29fa45f4 | 22 | #:use-module (guix build syscalls) |
b7d48312 | 23 | #:use-module (gnu build linux-container) |
4d54785c | 24 | #:use-module (srfi srfi-1) |
381ac93b | 25 | #:use-module (srfi srfi-26) |
7585016f LC |
26 | #:use-module (srfi srfi-64) |
27 | #:use-module (ice-9 match)) | |
29fa45f4 LC |
28 | |
29 | ;; Test the (guix build syscalls) module, although there's not much that can | |
30 | ;; actually be tested without being root. | |
31 | ||
32 | (test-begin "syscalls") | |
33 | ||
34 | (test-equal "mount, ENOENT" | |
35 | ENOENT | |
36 | (catch 'system-error | |
37 | (lambda () | |
38 | (mount "/dev/null" "/does-not-exist" "ext2") | |
39 | #f) | |
40 | (compose system-error-errno list))) | |
41 | ||
35066aa5 | 42 | (test-assert "umount, ENOENT/EPERM" |
29fa45f4 LC |
43 | (catch 'system-error |
44 | (lambda () | |
45 | (umount "/does-not-exist") | |
46 | #f) | |
35066aa5 LC |
47 | (lambda args |
48 | ;; Both return values have been encountered in the wild. | |
49 | (memv (system-error-errno args) (list EPERM ENOENT))))) | |
29fa45f4 | 50 | |
ccea821b | 51 | (test-assert "mount-points" |
381ac93b LC |
52 | ;; Reportedly "/" is not always listed as a mount point, so check a few |
53 | ;; others (see <http://bugs.gnu.org/20261>.) | |
54 | (any (cute member <> (mount-points)) | |
55 | '("/" "/proc" "/sys" "/dev"))) | |
ccea821b | 56 | |
715fc9d4 LC |
57 | (test-assert "swapon, ENOENT/EPERM" |
58 | (catch 'system-error | |
59 | (lambda () | |
60 | (swapon "/does-not-exist") | |
61 | #f) | |
62 | (lambda args | |
63 | (memv (system-error-errno args) (list EPERM ENOENT))))) | |
64 | ||
2793c0fb | 65 | (test-assert "swapoff, ENOENT/EINVAL/EPERM" |
715fc9d4 LC |
66 | (catch 'system-error |
67 | (lambda () | |
68 | (swapoff "/does-not-exist") | |
69 | #f) | |
70 | (lambda args | |
2793c0fb | 71 | (memv (system-error-errno args) (list EPERM EINVAL ENOENT))))) |
715fc9d4 | 72 | |
b4abdeb6 DT |
73 | (test-assert "mkdtemp!" |
74 | (let* ((tmp (or (getenv "TMPDIR") "/tmp")) | |
75 | (dir (mkdtemp! (string-append tmp "/guix-test-XXXXXX")))) | |
76 | (and (file-exists? dir) | |
77 | (begin | |
78 | (rmdir dir) | |
79 | #t)))) | |
80 | ||
8950ed11 DT |
81 | (define (user-namespace pid) |
82 | (string-append "/proc/" (number->string pid) "/ns/user")) | |
83 | ||
b7d48312 DT |
84 | (define perform-container-tests? |
85 | (and (user-namespace-supported?) | |
86 | (unprivileged-user-namespace-supported?))) | |
87 | ||
88 | (unless perform-container-tests? | |
b62a3ebc | 89 | (test-skip 1)) |
8950ed11 DT |
90 | (test-assert "clone" |
91 | (match (clone (logior CLONE_NEWUSER SIGCHLD)) | |
92 | (0 (primitive-exit 42)) | |
93 | (pid | |
94 | ;; Check if user namespaces are different. | |
95 | (and (not (equal? (readlink (user-namespace pid)) | |
96 | (readlink (user-namespace (getpid))))) | |
97 | (match (waitpid pid) | |
98 | ((_ . status) | |
99 | (= 42 (status:exit-val status)))))))) | |
100 | ||
b7d48312 | 101 | (unless perform-container-tests? |
b62a3ebc | 102 | (test-skip 1)) |
43ace6ea DT |
103 | (test-assert "setns" |
104 | (match (clone (logior CLONE_NEWUSER SIGCHLD)) | |
105 | (0 (primitive-exit 0)) | |
106 | (clone-pid | |
107 | (match (pipe) | |
108 | ((in . out) | |
109 | (match (primitive-fork) | |
110 | (0 | |
111 | (close in) | |
112 | ;; Join the user namespace. | |
113 | (call-with-input-file (user-namespace clone-pid) | |
114 | (lambda (port) | |
115 | (setns (port->fdes port) 0))) | |
116 | (write 'done out) | |
117 | (close out) | |
118 | (primitive-exit 0)) | |
119 | (fork-pid | |
120 | (close out) | |
121 | ;; Wait for the child process to join the namespace. | |
122 | (read in) | |
123 | (let ((result (and (equal? (readlink (user-namespace clone-pid)) | |
124 | (readlink (user-namespace fork-pid)))))) | |
125 | ;; Clean up. | |
126 | (waitpid clone-pid) | |
127 | (waitpid fork-pid) | |
128 | result)))))))) | |
8950ed11 | 129 | |
b7d48312 | 130 | (unless perform-container-tests? |
b62a3ebc | 131 | (test-skip 1)) |
df3ce5c1 DT |
132 | (test-assert "pivot-root" |
133 | (match (pipe) | |
134 | ((in . out) | |
135 | (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD)) | |
136 | (0 | |
137 | (close in) | |
138 | (call-with-temporary-directory | |
139 | (lambda (root) | |
140 | (let ((put-old (string-append root "/real-root"))) | |
141 | (mount "none" root "tmpfs") | |
142 | (mkdir put-old) | |
143 | (call-with-output-file (string-append root "/test") | |
144 | (lambda (port) | |
145 | (display "testing\n" port))) | |
146 | (pivot-root root put-old) | |
147 | ;; The test file should now be located inside the root directory. | |
148 | (write (file-exists? "/test") out) | |
149 | (close out)))) | |
150 | (primitive-exit 0)) | |
151 | (pid | |
152 | (close out) | |
153 | (let ((result (read in))) | |
154 | (close in) | |
155 | (and (zero? (match (waitpid pid) | |
156 | ((_ . status) | |
157 | (status:exit-val status)))) | |
158 | (eq? #t result)))))))) | |
159 | ||
b89e7405 LC |
160 | (test-assert "all-network-interface-names" |
161 | (match (all-network-interface-names) | |
4d54785c LC |
162 | (((? string? names) ..1) |
163 | (member "lo" names)))) | |
164 | ||
b89e7405 LC |
165 | (test-assert "network-interface-names" |
166 | (match (network-interface-names) | |
7585016f | 167 | (((? string? names) ..1) |
b89e7405 | 168 | (lset<= string=? names (all-network-interface-names))))) |
7585016f | 169 | |
973eea34 | 170 | (test-assert "network-interface-flags" |
c9bf64d6 | 171 | (let* ((sock (socket AF_INET SOCK_STREAM 0)) |
973eea34 LC |
172 | (flags (network-interface-flags sock "lo"))) |
173 | (close-port sock) | |
174 | (and (not (zero? (logand flags IFF_LOOPBACK))) | |
175 | (not (zero? (logand flags IFF_UP)))))) | |
176 | ||
177 | (test-equal "loopback-network-interface?" | |
178 | ENODEV | |
179 | (and (loopback-network-interface? "lo") | |
180 | (catch 'system-error | |
181 | (lambda () | |
182 | (loopback-network-interface? "nonexistent") | |
183 | #f) | |
184 | (lambda args | |
185 | (system-error-errno args))))) | |
186 | ||
c9bf64d6 | 187 | (test-skip (if (zero? (getuid)) 1 0)) |
d35c5e29 | 188 | (test-assert "set-network-interface-flags" |
c9bf64d6 LC |
189 | (let ((sock (socket AF_INET SOCK_STREAM 0))) |
190 | (catch 'system-error | |
191 | (lambda () | |
192 | (set-network-interface-flags sock "lo" IFF_UP)) | |
193 | (lambda args | |
194 | (close-port sock) | |
d35c5e29 LC |
195 | ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32. |
196 | (memv (system-error-errno args) (list EPERM EACCES)))))) | |
c9bf64d6 LC |
197 | |
198 | (test-equal "network-interface-address lo" | |
199 | (make-socket-address AF_INET (inet-pton AF_INET "127.0.0.1") 0) | |
200 | (let* ((sock (socket AF_INET SOCK_STREAM 0)) | |
201 | (addr (network-interface-address sock "lo"))) | |
202 | (close-port sock) | |
203 | addr)) | |
204 | ||
54e515eb | 205 | (test-skip (if (zero? (getuid)) 1 0)) |
d35c5e29 | 206 | (test-assert "set-network-interface-address" |
c9bf64d6 LC |
207 | (let ((sock (socket AF_INET SOCK_STREAM 0))) |
208 | (catch 'system-error | |
209 | (lambda () | |
210 | (set-network-interface-address sock "nonexistent" | |
211 | (make-socket-address | |
212 | AF_INET | |
213 | (inet-pton AF_INET "127.12.14.15") | |
214 | 0))) | |
215 | (lambda args | |
216 | (close-port sock) | |
d35c5e29 LC |
217 | ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32. |
218 | (memv (system-error-errno args) (list EPERM EACCES)))))) | |
c9bf64d6 | 219 | |
e7f5691d LC |
220 | (test-equal "network-interfaces returns one or more interfaces" |
221 | '(#t #t #t) | |
222 | (match (network-interfaces) | |
223 | ((interfaces ..1) | |
224 | (list (every interface? interfaces) | |
225 | (every string? (map interface-name interfaces)) | |
7adbe85e LC |
226 | (every (lambda (sockaddr) |
227 | ;; Sometimes interfaces have no associated address. | |
228 | (or (vector? sockaddr) | |
229 | (not sockaddr))) | |
230 | (map interface-address interfaces)))))) | |
e7f5691d LC |
231 | |
232 | (test-equal "network-interfaces returns \"lo\"" | |
233 | (list #t (make-socket-address AF_INET (inet-pton AF_INET "127.0.0.1") 0)) | |
234 | (match (filter (lambda (interface) | |
235 | (string=? "lo" (interface-name interface))) | |
236 | (network-interfaces)) | |
237 | ((loopbacks ..1) | |
238 | (list (every (lambda (lo) | |
239 | (not (zero? (logand IFF_LOOPBACK (interface-flags lo))))) | |
240 | loopbacks) | |
241 | (match (find (lambda (lo) | |
242 | (= AF_INET (sockaddr:fam (interface-address lo)))) | |
243 | loopbacks) | |
244 | (#f #f) | |
245 | (lo (interface-address lo))))))) | |
246 | ||
29ff6d9f LC |
247 | (test-equal "terminal-window-size ENOTTY" |
248 | ENOTTY | |
249 | (call-with-input-file "/dev/null" | |
250 | (lambda (port) | |
251 | (catch 'system-error | |
252 | (lambda () | |
253 | (terminal-window-size port)) | |
254 | (lambda args | |
255 | (system-error-errno args)))))) | |
256 | ||
257 | (test-assert "terminal-columns" | |
258 | (> (terminal-columns) 0)) | |
259 | ||
6d2b4391 LC |
260 | (test-assert "terminal-columns non-file port" |
261 | (> (terminal-columns (open-input-string "Join us now, share the software!")) | |
262 | 0)) | |
263 | ||
29fa45f4 | 264 | (test-end) |