projects/guix·blob master · refs

266 lines · 8.1 KiB

1# GNU Guix --- Functional package management for GNU
2# Copyright © 2012, 2014-2019, 2026 Ludovic Courtès <[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#
20# Test the daemon and its interaction with 'guix substitute'.
21#
22
23set -e
24
25guix-daemon --version
26guix build --version
27
28drv="`guix build emacs -d`"
29out="`guile -c ' \
30 (use-modules (guix) (gnu packages emacs)) \
31 (define store (open-connection)) \
32 (%graft? #f)
33 (display (derivation->output-path (package-derivation store emacs)))'`"
34
35hash_part="`basename $out | cut -c 1-32`"
36narinfo="$hash_part.narinfo"
37substitute_dir="`echo $GUIX_BINARY_SUBSTITUTE_URL | sed -'es,file://,,g'`"
38
39cat > "$substitute_dir/nix-cache-info"<<EOF
40StoreDir: `dirname $drv`
41WantMassQuery: 0
42EOF
43
44cat > "$substitute_dir/$narinfo"<<EOF
45StorePath: $out
46URL: /nowhere/example.nar
47Compression: none
48NarSize: 1234
49References:
50System: `guile -c '(use-modules (guix)) (display (%current-system))'`
51Deriver: $(basename $drv)
52EOF
53
54# Remove the cached narinfo.
55rm -f "$XDG_CACHE_HOME/guix/substitute/$hash_part"
56
57# Make sure we see the substitute.
58guile -c "
59 (use-modules (guix))
60 (define store (open-connection))
61 (set-build-options store #:use-substitutes? #t
62 #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
63 (exit (has-substitutes? store \"$out\"))"
64
65# Now, run guix-daemon --no-substitutes.
66socket="$GUIX_STATE_DIRECTORY/alternate-socket"
67guix-daemon --no-substitutes --listen="$socket" --disable-chroot &
68daemon_pid=$!
69trap 'kill $daemon_pid' EXIT
70
71# Make sure we DON'T see the substitute.
72guile -c "
73 (use-modules (guix))
74 (define store (open-connection \"$socket\"))
75
76 ;; This setting MUST NOT override the daemon's --no-substitutes.
77 (set-build-options store #:use-substitutes? #t
78 #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
79
80 (exit (not (has-substitutes? store \"$out\")))"
81
82kill "$daemon_pid"
83
84# Pass several '--listen' options, and make sure they are all honored.
85guix-daemon --disable-chroot --listen="$socket" --listen="$socket-second" \
86 --listen="localhost" --listen="localhost:9876" &
87daemon_pid=$!
88
89for uri in "$socket" "$socket-second" \
90 "guix://localhost" "guix://localhost:9876"
91do
92 GUIX_DAEMON_SOCKET="$uri" guix build guile-bootstrap
93done
94
95kill "$daemon_pid"
96
97# Make sure 'profiles/per-user' is created when connecting over TCP.
98
99orig_GUIX_STATE_DIRECTORY="$GUIX_STATE_DIRECTORY"
100GUIX_STATE_DIRECTORY="$GUIX_STATE_DIRECTORY-2"
101
102guix-daemon --disable-chroot --listen="localhost:9877" &
103daemon_pid=$!
104
105GUIX_DAEMON_SOCKET="guix://localhost:9877"
106export GUIX_DAEMON_SOCKET
107
108test ! -d "$GUIX_STATE_DIRECTORY/profiles/per-user"
109
110guix build guile-bootstrap -d
111
112test -d "$GUIX_STATE_DIRECTORY/profiles/per-user/$USER"
113
114kill "$daemon_pid"
115unset GUIX_DAEMON_SOCKET
116GUIX_STATE_DIRECTORY="$orig_GUIX_STATE_DIRECTORY"
117
118# Check the failed build cache.
119
120guix-daemon --no-substitutes --listen="$socket" --disable-chroot \
121 --cache-failures &
122daemon_pid=$!
123
124guile -c "
125 (use-modules (guix) (guix tests) (srfi srfi-34))
126 (define store (open-connection-for-tests \"$socket\"))
127
128 ;; Disable grafts to avoid building more than needed.
129 (%graft? #f)
130
131 (define (build-without-failing drv)
132 (lambda (store)
133 (guard (c ((store-protocol-error? c) (values #t store)))
134 (build-derivations store (list drv))
135 (values #f store))))
136
137 ;; Make sure failed builds are cached and can be removed from
138 ;; the cache.
139 (run-with-store store
140 (mlet* %store-monad ((drv (gexp->derivation \"failure\"
141 #~(begin
142 (ungexp output)
143 #f)))
144 (out -> (derivation->output-path drv))
145 (ok? (build-without-failing drv)))
146 ;; Note the mixture of monadic and direct style. Don't try
147 ;; this at home!
148 (return (exit (and ok?
149 (equal? (query-failed-paths store) (list out))
150 (begin
151 (clear-failed-paths store (list out))
152 (null? (query-failed-paths store)))))))
153 #:guile-for-build (%guile-for-build)) "
154
155kill "$daemon_pid"
156
157
158# Make sure the daemon's default 'build-cores' setting is honored.
159
160guix-daemon --listen="$socket" --disable-chroot --cores=42 &
161daemon_pid=$!
162
163GUIX_DAEMON_SOCKET="$socket" \
164guile -c '
165 (use-modules (guix) (guix tests))
166
167 (with-store store
168 (let* ((build (add-text-to-store store "build.sh"
169 "echo $NIX_BUILD_CORES > $out"))
170 (bash (add-to-store store "bash" #t "sha256"
171 (search-bootstrap-binary "bash"
172 (%current-system))))
173 (drv (derivation store "the-thing" bash
174 `("-e" ,build)
175 #:inputs `((,bash) (,build))
176 #:env-vars `(("x" . ,(random-text))))))
177 (and (build-derivations store (list drv))
178 (exit
179 (= 42 (pk (call-with-input-file (derivation->output-path drv)
180 read)))))))'
181
182
183kill "$daemon_pid"
184
185# Make sure the daemon's default 'timeout' and 'max-silent-time' settings are
186# honored.
187
188client_code='
189 (use-modules (guix) (guix tests) (srfi srfi-34))
190
191 (with-store store
192 (let* ((build (add-text-to-store store "build.sh"
193 "while true ; do : ; done"))
194 (bash (add-to-store store "bash" #t "sha256"
195 (search-bootstrap-binary "bash"
196 (%current-system))))
197 (drv (derivation store "the-thing" bash
198 `("-e" ,build)
199 #:inputs `((,bash) (,build))
200 #:env-vars `(("x" . ,(random-text))))))
201 (exit (guard (c ((store-protocol-error? c)
202 (->bool
203 (string-contains (pk (store-protocol-error-message c))
204 "failed"))))
205 (build-derivations store (list drv))
206 #f))))'
207
208
209for option in --max-silent-time=1 --timeout=1
210do
211 guix-daemon --listen="$socket" --disable-chroot "$option" &
212 daemon_pid=$!
213
214 GUIX_DAEMON_SOCKET="$socket" guile -c "$client_code"
215 kill "$daemon_pid"
216done
217
218# Make sure garbage collection from a TCP connection does not work.
219
220tcp_socket="127.0.0.1:9998"
221guix-daemon --listen="$tcp_socket" &
222daemon_pid=$!
223
224GUIX_DAEMON_SOCKET="guix://$tcp_socket"
225export GUIX_DAEMON_SOCKET
226
227guix gc && false
228
229unset GUIX_DAEMON_SOCKET
230kill "$daemon_pid"
231
232# Log compression.
233
234guix-daemon --listen="$socket" --disable-chroot --debug --log-compression=gzip &
235daemon_pid=$!
236
237stamp="compressed-build-log-test-$$-`date +%H%M%S`"
238client_code="
239 (use-modules (guix) (gnu packages bootstrap))
240
241 (with-store store
242 (run-with-store store
243 (mlet %store-monad ((drv (lower-object
244 (computed-file \"compressed-log-test\"
245 #~(begin
246 (display \"$stamp\")
247 (newline)
248 (mkdir #\$output))
249 #:guile %bootstrap-guile))))
250 (display (derivation-file-name drv))
251 (newline)
252 (return #t))))
253"
254
255GUIX_DAEMON_SOCKET="$socket"
256export GUIX_DAEMON_SOCKET
257
258drv=`guile -c "$client_code"`
259guix build "$drv"
260
261log=`guix build "$drv" --log-file`
262test -f "$log"
263case "$log" in
264 *.gz) test "`gunzip -c < "$log" | grep -v 'guile: warning.*locale'`" = "$stamp" ;;
265 *) false ;;
266esac