projects/guix·blob master · refs

210 lines · 7.1 KiB

1# GNU Guix --- Functional package management for GNU
2# Copyright © 2023 Maxim Cournoyer <[email protected]>
3# Copyright © 2023-2024, 2026 Ludovic Courtès <[email protected]>
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#
21# Test the 'guix time-machine' command-line utility.
22#
23
24channels_file="channels-test-$$.scm"
25log_file="log-test-$$.log"
26trap "rm -f $channels_file $log_file" EXIT
27
28cat > "$channels_file" <<EOF
29(system "echo rm -rf /")
30%default-channels
31EOF
32
33# This must fail: 'system' is not among the available bindings in the
34# evaluation sandbox.
35guix time-machine -C "$channels_file" && false
36
37cat > "$channels_file" <<EOF
38(use-modules (system foreign))
39%default-channels
40EOF
41
42# Likewise, 'use-modules' is not available.
43guix time-machine -C "$channels_file" && false
44
45# Get 'time-machine' to download a channel file with an untrusted channel.
46# Check that this fails with a "'guix' is not trusted" message.
47cat > "$channels_file" <<EOF
48(use-modules (guix tests http)
49 (guix diagnostics)
50 (guix scripts time-machine))
51
52(define channels
53 '(list (channel
54 (name 'guix)
55 (url "https://example.org/evil/guix.git")
56 (branch "devel")
57 (commit "cabba9e900d2350aef42e65643de78500b2aad06")
58 (introduction
59 (make-channel-introduction
60 "badcafef1d5c170db68aa4bbfb77024fdc468ed3"
61 (openpgp-fingerprint
62 "CABB A9EE 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5"))))))
63
64(with-http-server (list (list 200 (object->string channels)))
65 (let ((error (open-output-string)))
66 (catch 'quit
67 (lambda ()
68 (parameterize ((guix-warning-port error))
69 (guix-time-machine "-C" (%local-url) "--" "describe")
70 (primitive-exit 1)))
71 (lambda _
72 (exit (->bool (string-contains (get-output-string error)
73 "'guix' is not trusted")))))))
74EOF
75guix repl -- "$channels_file"
76
77# Check that using 'time-machine' and 'downloaded-channels' with '#:append'
78# correctly verifies if the appended channels are untrusted. Check that this
79# fails with a "'guix' is not trusted" message.
80cat > "$channels_file" <<EOF
81(use-modules (guix tests http)
82 (guix diagnostics)
83 (guix scripts time-machine))
84
85(define channels
86 '(list))
87
88(with-http-server (list (list 200 (object->string channels)))
89 (let* ((error (open-output-string))
90 (port (mkstemp "guix-channels-XXXXXX"))
91 (file (port-filename port)))
92 (write (quasiquote
93 (downloaded-channels
94 ,(%local-url)
95 #:append
96 (list
97 (channel
98 (name 'guix) ;; this is an untrusted channel
99 (url ,(%local-url)) ;; url doesn't matter
100 (branch "devel")
101 (commit "cabba9e900d2350aef42e65643de78500b2aad06")
102 (introduction
103 (make-channel-introduction
104 "badcafef1d5c170db68aa4bbfb77024fdc468ed3"
105 (openpgp-fingerprint
106 "CABB A9EE 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5"))))))) port)
107 (close-port port)
108 (catch 'quit
109 (lambda ()
110 (parameterize ((guix-warning-port error))
111 (guix-time-machine "--allow-untrusted-channels=no" "-C" file "--" "describe")
112 (primitive-exit 1)))
113 (lambda _
114 (delete-file file)
115 (exit (->bool (string-contains (get-output-string error)
116 "'guix' is not trusted")))))))
117EOF
118guix repl -- "$channels_file"
119
120# Check '--max-indirections' and 'downloaded-channels'.
121cat > "$channels_file" <<EOF
122(downloaded-channels "https://example.org/channels.scm")
123EOF
124
125guix time-machine -C "$channels_file" --max-indirections=0 2> "$log_file" && false
126grep "too many channel indirections" "$log_file"
127
128# Get 'time-machine' to download a channel file without an introduction, this
129# time via 'downloaded-channels'. Check that this fails with an appropriate
130# error message.
131cat > "$channels_file" <<EOF
132(use-modules (guix tests http)
133 (guix diagnostics)
134 (guix scripts time-machine))
135
136(define channels
137 '(list (channel ;this channel lacks an introduction
138 (name 'guix)
139 (url "https://example.org/evil/guix.git")
140 (commit "cabba9e900d2350aef42e65643de78500b2aad06"))))
141
142(with-http-server (list (list 200 (object->string channels)))
143 (let* ((error (open-output-string))
144 (port (mkstemp "guix-channels-XXXXXX"))
145 (file (port-filename port)))
146 (write (quasiquote (downloaded-channels ,(%local-url))) port)
147 (close-port port)
148 (catch 'quit
149 (lambda ()
150 (parameterize ((guix-warning-port error))
151 (guix-time-machine "-C" file "--" "describe")
152 (primitive-exit 1)))
153 (lambda _
154 (delete-file file)
155 (exit (->bool (string-contains (get-output-string error)
156 "cannot be authenticated")))))))
157EOF
158guix repl -- "$channels_file"
159
160cat > "$channels_file" <<EOF
161%default-channels
162EOF
163
164# Ensure there are zero trusted channels
165mkdir -p "$XDG_CACHE_HOME/dot-config/guix"
166cat > "$XDG_CACHE_HOME/dot-config/guix/trusted-channels.scm" <<EOF
167(list)
168EOF
169
170# Ignore the user's ~/.config/guix/trusted-channels.scm and ensure this
171# command fails.
172XDG_CONFIG_HOME="$XDG_CACHE_HOME/dot-config" \
173guix time-machine -C "$channels_file" --allow-untrusted-channels=no 2> "$log_file" && false
174grep "'guix' is not trusted" "$log_file"
175
176if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
177then
178 # Ignore the user's ~/.config/guix/trusted-channels.scm. We've ensured
179 # there are no trusted channels so the following command must fail.
180 XDG_CONFIG_HOME="$XDG_CACHE_HOME/dot-config" \
181 guix time-machine \
182 -C swh:1:cnt:003e1e0c1b9b358082201332c926ae54e9549002 \
183 2> "$log_file" \
184 && false
185 grep "'guix' is not trusted" "$log_file"
186fi
187
188if [ -d "$abs_top_srcdir/.git" ] \
189 || guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
190then
191 guix time-machine --version
192else
193 echo "This test requires networking or a local Git checkout; skipping." >&2
194 exit 77
195fi
196
197if [ -d "$abs_top_srcdir/.git" ]
198then
199 # Note: No "file://" prefix because that makes cloning much more expensive
200 # for some reason.
201 EXTRA_OPTIONS="--url=$abs_top_srcdir"
202else
203 EXTRA_OPTIONS=""
204fi
205
206# Visiting a commit older than v0.16.0 must fail (this test is expensive
207# because it clones the whole repository).
208guix time-machine -q --commit=v0.15.0 $EXTRA_OPTIONS -- describe && false
209
210true