projects/guix·blob java-team · refs

180 lines · 6.2 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2024 Giacomo Leidi <[email protected]>
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 tests shadow)
20 #:use-module (gnu packages base)
21 #:use-module (gnu packages containers)
22 #:use-module (gnu tests)
23 #:use-module (gnu services)
24 #:use-module (gnu system)
25 #:use-module (gnu system accounts)
26 #:use-module (gnu system shadow)
27 #:use-module (gnu system vm)
28 #:use-module (guix gexp)
29 #:export (%test-subids))
30
31
32(define %subids-os
33 (simple-operating-system
34 (simple-service
35 'simple-profile
36 profile-service-type
37 (list podman))
38 (simple-service
39 'simple-subids
40 subids-service-type
41 (subids-extension
42 (subgids
43 (list
44 (subid-range
45 (name "alice"))
46 (subid-range
47 (name "bob")
48 (start 100700))))
49 (subuids
50 (list
51 (subid-range
52 (name "alice"))))))))
53
54(define (run-subids-test)
55 "Run IMAGE as an OCI backed Shepherd service, inside OS."
56
57 (define os
58 (marionette-operating-system
59 (operating-system-with-gc-roots
60 %subids-os
61 (list))
62 #:imported-modules '((gnu services herd)
63 (guix combinators))))
64
65 (define vm
66 (virtual-machine
67 (operating-system os)
68 (volatile? #f)
69 (memory-size 1024)
70 (disk-image-size (* 3000 (expt 2 20)))
71 (port-forwardings '())))
72
73 (define test
74 (with-imported-modules '((gnu build marionette))
75 #~(begin
76 (use-modules (srfi srfi-11) (srfi srfi-64)
77 (gnu build marionette))
78
79 (define marionette
80 ;; Relax timeout to accommodate older systems and
81 ;; allow for pulling the image.
82 (make-marionette (list #$vm) #:timeout 60))
83
84 (test-runner-current (system-test-runner #$output))
85 (test-begin "subids")
86
87 (test-equal "/etc/subid and /etc/subgid are created and their content is sound"
88 '("root:100000:700\nbob:100700:65536\nalice:166236:65536\n"
89 "root:100000:65536\nalice:165536:65536\n")
90 (marionette-eval
91 `(begin
92 (use-modules (ice-9 textual-ports))
93
94 (define (read-file file-name)
95 (call-with-input-file file-name get-string-all))
96
97 (let* ((response1 (read-file "/etc/subgid"))
98 (response2 (read-file "/etc/subuid")))
99 (list response1 response2)))
100 marionette))
101
102 (test-equal "podman unshare runs for unprivileged users"
103 " 0 1000 1\n 1 165536 65536"
104 (marionette-eval
105 `(begin
106 (use-modules (srfi srfi-1)
107 (ice-9 popen)
108 (ice-9 match)
109 (ice-9 rdelim)
110 (ice-9 textual-ports))
111 (define out-dir "/tmp")
112 (define (read-file file-name)
113 (call-with-input-file file-name get-string-all))
114
115 (define (wait-for-file file)
116 ;; Wait until FILE shows up.
117 (let loop ((i 60))
118 (cond ((file-exists? file)
119 #t)
120 ((zero? i)
121 (error "file didn't show up" file))
122 (else
123 (sleep 1)
124 (loop (- i 1))))))
125
126 (define (read-lines file-or-port)
127 (define (loop-lines port)
128 (let loop ((lines '()))
129 (match (read-line port)
130 ((? eof-object?)
131 (reverse lines))
132 (line
133 (loop (cons line lines))))))
134
135 (if (port? file-or-port)
136 (loop-lines file-or-port)
137 (call-with-input-file file-or-port
138 loop-lines)))
139
140 (define slurp
141 (lambda args
142 (let* ((port (apply open-pipe* OPEN_READ
143 (list "sh" "-l" "-c"
144 (string-join
145 args
146 " "))))
147 (output (read-lines port))
148 (status (close-pipe port)))
149 output)))
150
151 (match (primitive-fork)
152 (0
153 (dynamic-wind
154 (const #f)
155 (lambda ()
156 (setgid (passwd:gid (getpwnam "alice")))
157 (setuid (passwd:uid (getpw "alice")))
158
159 (let* ((response1 (slurp
160 "podman" "unshare" "cat" "/proc/self/uid_map")))
161 (call-with-output-file (string-append out-dir "/response1")
162 (lambda (port)
163 (display (string-join response1 "\n") port)))))
164 (lambda ()
165 (primitive-exit 127))))
166 (pid
167 (cdr (waitpid pid))))
168 (wait-for-file (string-append out-dir "/response1"))
169 (read-file (string-append out-dir "/response1")))
170 marionette))
171
172 (test-end))))
173
174 (gexp->derivation "subids-test" test))
175
176(define %test-subids
177 (system-test
178 (name "subids")
179 (description "Test sub UIDs and sub GIDs provisioning service.")
180 (value (run-subids-test))))