aboutsummaryrefslogtreecommitdiff
path: root/tests/guix-daemon.sh
blob: 330ad6883502b47d39c50df9209fe1bc292ad2e9 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
# GNU Guix is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or (at
# your option) any later version.
#
# GNU Guix is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

#
# Test the daemon and its interaction with 'guix substitute'.
#

set -e

guix-daemon --version
guix build --version

drv="`guix build emacs -d`"
out="`guile -c '								\
  (use-modules (guix) (guix grafts) (gnu packages emacs))			\
  (define store (open-connection))						\
  (%graft? #f)
  (display (derivation->output-path (package-derivation store emacs)))'`"

hash_part="`basename $out | cut -c 1-32`"
narinfo="$hash_part.narinfo"
substitute_dir="`echo $GUIX_BINARY_SUBSTITUTE_URL | sed -'es,file://,,g'`"

cat > "$substitute_dir/nix-cache-info"<<EOF
StoreDir: `dirname $drv`
WantMassQuery: 0
EOF

cat > "$substitute_dir/$narinfo"<<EOF
StorePath: $out
URL: /nowhere/example.nar
Compression: none
NarSize: 1234
References: 
System: `guile -c '(use-modules (guix)) (display (%current-system))'`
Deriver: $drv
EOF

# Remove the cached narinfo.
rm -f "$XDG_CACHE_HOME/guix/substitute/$hash_part"

# Make sure we see the substitute.
guile -c "
  (use-modules (guix))
  (define store (open-connection))
  (set-build-options store #:use-substitutes? #t
                     #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
  (exit (has-substitutes? store \"$out\"))"

# Now, run guix-daemon --no-substitutes.
socket="$GUIX_STATE_DIRECTORY/alternate-socket"
guix-daemon --no-substitutes --listen="$socket" --disable-chroot &
daemon_pid=$!
trap 'kill $daemon_pid' EXIT

# Make sure we DON'T see the substitute.
guile -c "
  (use-modules (guix))
  (define store (open-connection \"$socket\"))

  ;; This setting MUST NOT override the daemon's --no-substitutes.
  (set-build-options store #:use-substitutes? #t
                     #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))

  (exit (not (has-substitutes? store \"$out\")))"

kill "$daemon_pid"

# Pass several '--listen' options, and make sure they are all honored.
guix-daemon --disable-chroot --listen="$socket" --listen="$socket-second" \
	    --listen="localhost" --listen="localhost:9876" &
daemon_pid=$!

for uri in "$socket" "$socket-second" \
		     "guix://localhost" "guix://localhost:9876"
do
    GUIX_DAEMON_SOCKET="$uri" guix build guile-bootstrap
done

kill "$daemon_pid"

# Make sure 'profiles/per-user' is created when connecting over TCP.

orig_GUIX_STATE_DIRECTORY="$GUIX_STATE_DIRECTORY"
GUIX_STATE_DIRECTORY="$GUIX_STATE_DIRECTORY-2"

guix-daemon --disable-chroot --listen="localhost:9877" &
daemon_pid=$!

GUIX_DAEMON_SOCKET="guix://localhost:9877"
export GUIX_DAEMON_SOCKET

test ! -d "$GUIX_STATE_DIRECTORY/profiles/per-user"

guix build guile-bootstrap -d

test -d "$GUIX_STATE_DIRECTORY/profiles/per-user/$USER"

kill "$daemon_pid"
unset GUIX_DAEMON_SOCKET
GUIX_STATE_DIRECTORY="$orig_GUIX_STATE_DIRECTORY"

# Check the failed build cache.

guix-daemon --no-substitutes --listen="$socket" --disable-chroot	\
  --cache-failures &
daemon_pid=$!

guile -c "
  (use-modules (guix) (guix grafts) (guix tests) (srfi srfi-34))
  (define store (open-connection-for-tests \"$socket\"))

  ;; Disable grafts to avoid building more than needed.
  (%graft? #f)

  (define (build-without-failing drv)
    (lambda (store)
      (guard (c ((store-protocol-error? c) (values #t store)))
        (build-derivations store (list drv))
        (values #f store))))

  ;; Make sure failed builds are cached and can be removed from
  ;; the cache.
  (run-with-store store
    (mlet* %store-monad ((drv (gexp->derivation \"failure\"
                                                #~(begin
                                                    (ungexp output)
                                                     #f)))
                         (out -> (derivation->output-path drv))
                         (ok?    (build-without-failing drv)))
      ;; Note the mixture of monadic and direct style.  Don't try
      ;; this at home!
      (return (exit (and ok?
                         (equal? (query-failed-paths store) (list out))
                         (begin
                           (clear-failed-paths store (list out))
                           (null? (query-failed-paths store)))))))
    #:guile-for-build (%guile-for-build)) "

kill "$daemon_pid"


# Make sure the daemon's default 'build-cores' setting is honored.

guix-daemon --listen="$socket" --disable-chroot --cores=42 &
daemon_pid=$!

GUIX_DAEMON_SOCKET="$socket" \
guile -c '
  (use-modules (guix) (guix tests))

  (with-store store
    (let* ((build  (add-text-to-store store "build.sh"
                                      "echo $NIX_BUILD_CORES > $out"))
           (bash   (add-to-store store "bash" #t "sha256"
                                 (search-bootstrap-binary "bash"
                                                          (%current-system))))
           (drv    (derivation store "the-thing" bash
                               `("-e" ,build)
                               #:inputs `((,bash) (,build))
                               #:env-vars `(("x" . ,(random-text))))))
      (and (build-derivations store (list drv))
           (exit
            (= 42 (pk (call-with-input-file (derivation->output-path drv)
                        read)))))))'


kill "$daemon_pid"

# Make sure the daemon's default 'timeout' and 'max-silent-time' settings are
# honored.

client_code='
  (use-modules (guix) (guix tests) (srfi srfi-34))

  (with-store store
    (let* ((build  (add-text-to-store store "build.sh"
                                      "while true ; do : ; done"))
           (bash   (add-to-store store "bash" #t "sha256"
                                 (search-bootstrap-binary "bash"
                                                          (%current-system))))
           (drv    (derivation store "the-thing" bash
                               `("-e" ,build)
                               #:inputs `((,bash) (,build))
                               #:env-vars `(("x" . ,(random-text))))))
      (exit (guard (c ((store-protocol-error? c)
                       (->bool
                        (string-contains (pk (store-protocol-error-message c))
                                         "failed"))))
              (build-derivations store (list drv))
              #f))))'


for option in --max-silent-time=1 --timeout=1
do
    guix-daemon --listen="$socket" --disable-chroot "$option" &
    daemon_pid=$!

    GUIX_DAEMON_SOCKET="$socket" guile -c "$client_code"
    kill "$daemon_pid"
done

# Make sure garbage collection from a TCP connection does not work.

tcp_socket="127.0.0.1:9998"
guix-daemon --listen="$tcp_socket" &
daemon_pid=$!

GUIX_DAEMON_SOCKET="guix://$tcp_socket"
export GUIX_DAEMON_SOCKET

! guix gc

unset GUIX_DAEMON_SOCKET
kill "$daemon_pid"

# Log compression.

guix-daemon --listen="$socket" --disable-chroot --debug --log-compression=gzip &
daemon_pid=$!

stamp="compressed-build-log-test-$$-`date +%H%M%S`"
client_code="
  (use-modules (guix) (gnu packages bootstrap))

  (with-store store
    (run-with-store store
      (mlet %store-monad ((drv (lower-object
				(computed-file \"compressed-log-test\"
					       #~(begin
						   (display \"$stamp\")
                                                   (newline)
						   (mkdir #\$output))
					       #:guile %bootstrap-guile))))
	(display (derivation-file-name drv))
	(newline)
	(return #t))))
"

GUIX_DAEMON_SOCKET="$socket"
export GUIX_DAEMON_SOCKET

drv=`guile -c "$client_code"`
guix build "$drv"

log=`guix build "$drv" --log-file`
test -f "$log"
case "$log" in
    *.gz) test "`gunzip -c < "$log"`" = "$stamp" ;;
    *)    false ;;
esac
soc-ref %build-inputs "cfitsio") "/include")) #:phases (modify-phases %standard-phases (add-before 'configure 'patch-/bin/sh (lambda _ (substitute* "makedefs.in" (("/bin/sh") "sh")) #t)) (delete 'install-license-files)) ; installed by ‘make install’ ;; Parallel execution of the test suite is not supported. #:parallel-tests? #f)) (home-page "https://www.atnf.csiro.au/people/mcalabre/WCS") (synopsis "Library which implements the FITS WCS standard") (description "The FITS \"World Coordinate System\" (@dfn{WCS}) standard defines keywords and usage that provide for the description of astronomical coordinate systems in a @dfn{FITS} (Flexible Image Transport System) image header.") (license license:lgpl3+))) (define-public gnuastro (package (name "gnuastro") (version "0.12") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/gnuastro/gnuastro-" version ".tar.lz")) (sha256 (base32 "0ypk1c72q778cixfa52vjxzbd5m4qc6hfjgnipy16sfa7mnspmyf")))) (build-system gnu-build-system) (arguments '(#:configure-flags '("--disable-static"))) (inputs `(("cfitsio" ,cfitsio) ("gsl" ,gsl) ("libjpeg" ,libjpeg-turbo) ("libtiff" ,libtiff) ("wcslib" ,wcslib) ("zlib" ,zlib))) (native-inputs `(("libtool" ,libtool) ("lzip" ,lzip))) (home-page "https://www.gnu.org/software/gnuastro/") (synopsis "Astronomy utilities") (description "The GNU Astronomy Utilities (Gnuastro) is a suite of programs for the manipulation and analysis of astronomical data.") (license license:gpl3+))) (define-public stellarium (package (name "stellarium") (version "0.20.1") (source (origin (method url-fetch) (uri (string-append "https://github.com/Stellarium/stellarium" "/releases/download/v" version "/stellarium-" version ".tar.gz")) (sha256 (base32 "034jkrdaaamvbrkfwi3qcl6h8hwfnw2nvf7a82faj55rskcpnkhm")))) (build-system cmake-build-system) (inputs `(("qtbase" ,qtbase) ("qtlocation" ,qtlocation) ("qtmultimedia" ,qtmultimedia) ("qtscript" ,qtscript) ("qtserialport" ,qtserialport) ("zlib" ,zlib))) (native-inputs `(("gettext" ,gettext-minimal) ; xgettext is used at compile time ("perl" ,perl) ; For pod2man ("qtbase" ,qtbase) ; Qt MOC is needed at compile time ("qttools" ,qttools))) (arguments `(#:test-target "test" #:configure-flags (list "-DENABLE_TESTING=1" (string-append "-DCMAKE_CXX_FLAGS=-isystem " (assoc-ref %build-inputs "qtserialport") "/include/qt5")) #:phases (modify-phases %standard-phases (add-before 'check 'set-offscreen-display (lambda _ ;; make Qt render "offscreen", required for tests (setenv "QT_QPA_PLATFORM" "offscreen") (setenv "HOME" "/tmp") #t))))) (home-page "https://stellarium.org/") (synopsis "3D sky viewer") (description "Stellarium is a planetarium. It shows a realistic sky in 3D, just like what you see with the naked eye, binoculars, or a telescope. It can be used to control telescopes over a serial port for tracking celestial objects.") (license license:gpl2+))) (define-public celestia (let ((commit "9dbdf29c4ac3d20afb2d9a80d3dff241ecf81dce")) (package (name "celestia") (version (git-version "1.6.1" "815" commit)) (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/celestiaproject/celestia") (commit commit))) (file-name (git-file-name name version)) (sha256 (base32 "00xibg87l1arzifakgj7s828x9pszcgx7x7ij88a561ig49ryh78")))) (build-system cmake-build-system) (native-inputs `(("perl" ,perl) ("libgit2" ,libgit2) ("pkg-config" ,pkg-config) ("libtool" ,libtool) ("gettext" ,gettext-minimal))) (inputs `(("glu" ,glu) ("glew" ,glew) ("libtheora" ,libtheora) ("libjpeg" ,libjpeg-turbo) ("libpng" ,libpng) ;; maybe required? ("mesa" ,mesa) ;; optional: fmtlib, Eigen3; ("fmt" ,fmt) ("eigen" ,eigen) ;; glut: for glut interface ("freeglut" ,freeglut))) (propagated-inputs `(("lua" ,lua))) (arguments `(#:configure-flags '("-DENABLE_GLUT=ON" "-DENABLE_QT=OFF") #:tests? #f)) ;no tests (home-page "https://celestia.space/") (synopsis "Real-time 3D visualization of space") (description "This simulation program lets you explore our universe in three dimensions. Celestia simulates many different types of celestial objects. From planets and moons to star clusters and galaxies, you can visit every object in the expandable database and view it from any point in space and time. The position and movement of solar system objects is calculated accurately in real time at any rate desired.") (license license:gpl2+)))) (define-public celestia-gtk (package (inherit celestia) (name "celestia-gtk") (inputs (append (alist-delete "freeglut" (package-inputs celestia)) `(("gtk2" ,gtk+-2) ("gtkglext" ,gtkglext)))) (arguments `(#:configure-flags '("-DENABLE_GTK=ON" "-DENABLE_QT=OFF") #:tests? #f)))) (define-public libnova (package (name "libnova") (version "0.16") (source (origin (method git-fetch) (uri (git-reference (url "https://git.code.sf.net/p/libnova/libnova.git") (commit (string-append "v" version)))) (file-name (git-file-name name version)) (sha256 (base32 "0icwylwkixihzni0kgl0j8dx3qhqvym6zv2hkw2dy6v9zvysrb1b")))) (build-system gnu-build-system) (arguments `(#:phases (modify-phases %standard-phases (add-after 'unpack 'patch-git-version (lambda _ (substitute* "./git-version-gen" (("/bin/sh") (which "sh"))) #t))))) (native-inputs `(("autoconf" ,autoconf) ("automake" ,automake) ("libtool" ,libtool))) (synopsis "Celestial mechanics, astrometry and astrodynamics library") (description "Libnova is a general purpose, double precision, Celestial Mechanics, Astrometry and Astrodynamics library.") (home-page "http://libnova.sourceforge.net/") (license (list license:lgpl2.0+ license:gpl2+)))) ; examples/transforms.c & lntest/*.c (define-public xplanet (package (name "xplanet") (version "1.3.1") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/xplanet/xplanet/" version "/xplanet-" version ".tar.gz")) (sha256 (base32 "1rzc1alph03j67lrr66499zl0wqndiipmj99nqgvh9xzm1qdb023")) (patches (search-patches "xplanet-1.3.1-cxx11-eof.patch" "xplanet-1.3.1-libdisplay_DisplayOutput.cpp.patch" "xplanet-1.3.1-libimage_gif.c.patch" "xplanet-1.3.1-xpUtil-Add2017LeapSecond.cpp.patch")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("libx11" ,libx11) ("libxscrnsaver" ,libxscrnsaver) ("libice" ,libice) ("freetype" ,freetype) ("pango" ,pango) ("giflib" ,giflib) ("libjpeg", libjpeg-turbo) ("libpng" ,libpng) ("libtiff" ,libtiff) ("netpbm" ,netpbm) ("zlib" ,zlib))) (arguments `(#:configure-flags (let ((netpbm (assoc-ref %build-inputs "netpbm"))) (append (list ;; Give correct path for pnm.h header to configure script (string-append "CPPFLAGS=-I" netpbm "/include/netpbm") ;; no nasa jpl cspice support "--without-cspice" ))))) (home-page "http://xplanet.sourceforge.net/") (synopsis "Planetary body renderer") (description "Xplanet renders an image of a planet into an X window or file. All of the major planets and most satellites can be drawn and different map projections are also supported, including azimuthal, hemisphere, Lambert, Mercator, Mollweide, Peters, polyconic, orthographic and rectangular.") (license license:gpl2+))) (define-public gpredict (package (name "gpredict") (version "2.2.1") (source (origin (method url-fetch) (uri (string-append "https://github.com/csete/gpredict/releases" "/download/v" version "/gpredict-" version ".tar.bz2")) (sha256 (base32 "0hwf97kng1zy8rxyglw04x89p0bg07zq30hgghm20yxiw2xc8ng7")))) (build-system gnu-build-system) (native-inputs `(("intltool" ,intltool) ("gettext" ,gettext-minimal) ("pkg-config" ,pkg-config))) (inputs `(("curl" ,curl) ("glib" ,glib) ("goocanvas" ,goocanvas) ("gtk+" ,gtk+))) (arguments `(#:phases (modify-phases %standard-phases (add-after 'unpack 'fix-tests (lambda _ ;; Remove reference to non-existent file. (substitute* "po/POTFILES.in" (("src/gtk-sat-tree\\.c") "")) #t))))) (synopsis "Satellite tracking and orbit prediction application") (description "Gpredict is a real-time satellite tracking and orbit prediction application. It can track a large number of satellites and display their position and other data in lists, tables, maps, and polar plots (radar view). Gpredict can also predict the time of future passes for a satellite, and provide you with detailed information about each pass.") (home-page "http://gpredict.oz9aec.net/index.php") (license license:gpl2+)))