;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Peter Mikkelsen ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2020 Ludovic Courtès ;;; Copyright © 2022 Bruno Victal ;;; ;;; 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 . (define-module (gnu services audio) #:use-module (guix gexp) #:use-module (gu
aboutsummaryrefslogtreecommitdiff
blob: 1424ea9a880017199bf60f7fe96f1334aa8bd3a4 (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
# GNU Guix --- Functional package management for GNU
# Copyright © 2015, 2016, 2017, 2018, 2019, 2021 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 'guix environment'.
#

set -e

guix environment --version

tmpdir="t-guix-environment-$$"
gcroot="t-guix-environment-gc-root-$$"
trap 'rm -r "$tmpdir"; rm -f "$gcroot"' EXIT

mkdir "$tmpdir"

# 'guix environment' launches /bin/sh if 'SHELL' is unset, so export 'SHELL'
# since we know it's valid (build environments lack /bin/sh.)
export SHELL

# Check the environment variables for the bootstrap Guile.
guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
     --search-paths > "$tmpdir/a"
guix environment --bootstrap --ad-hoc guile-bootstrap:out --pure \
     --search-paths > "$tmpdir/b"

# $PATH must appear in the search paths, and nothing else.
grep -E '^export PATH=.*profile/bin' "$tmpdir/a"
test "`wc -l < "$tmpdir/a"`" = 1

# Guile must be on $PATH.
test -x `sed -r 's/^export PATH="(.*)"/\1/' "$tmpdir/a"`/guile

cmp "$tmpdir/a" "$tmpdir/b"

# Check '--preserve'.
GUIX_TEST_ABC=1
GUIX_TEST_DEF=2
GUIX_TEST_XYZ=3
export GUIX_TEST_ABC GUIX_TEST_DEF GUIX_TEST_XYZ
guix environment --bootstrap --ad-hoc guile-bootstrap --pure	\
     --preserve='^GUIX_TEST_A' --preserve='^GUIX_TEST_D'	\
     -- "$SHELL" -c set > "$tmpdir/a"
grep '^PATH=' "$tmpdir/a"
grep '^GUIX_TEST_ABC=' "$tmpdir/a"
grep '^GUIX_TEST_DEF=' "$tmpdir/a"
grep '^GUIX_TEST_XYZ=' "$tmpdir/a" && false

# Make sure the exit value is preserved.
if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
        -- guile -c '(exit 42)'
then
    false
else
    test $? = 42
fi

# Make sure 'GUIX_ENVIRONMENT' points to the profile.
guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
     -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"'

# Make sure 'GUIX_ENVIRONMENT' points to the profile when building from a
# manifest.
echo "(use-modules (guix profiles) (gnu packages bootstrap))

(packages->manifest (list %bootstrap-guile))
" > $tmpdir/manifest.scm
guix environment --bootstrap --manifest=$tmpdir/manifest.scm --pure \
     -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"'

# Make sure '--manifest' can be specified multiple times.
cat > "$tmpdir/manifest2.scm" <<EOF
(use-modules (guix) (guix profiles)
             (guix build-system trivial)
             (gnu packages bootstrap))

(packages->manifest
 (list (package
         (inherit %bootstrap-guile)
         (name "eliug")
         (build-system trivial-build-system)
         (arguments
          (quasiquote
           (#:guile ,%bootstrap-guile
            #:builder
            (begin
              (mkdir %output)
              (mkdir (string-append %output "/eliug")))))))))
EOF
guix environment --bootstrap -m "$tmpdir/manifest.scm" \
     -m "$tmpdir/manifest2.scm" --pure \
     -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile" && test -d "$GUIX_ENVIRONMENT/eliug"'

# Make sure '-r' works as expected.
rm -f "$gcroot"
expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \
             -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT'`"
guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
     -- guile -c 1
test `readlink "$gcroot"` = "$expected"

# Make sure '-r' is idempotent.
guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
     -- guile -c 1
test `readlink "$gcroot"` = "$expected"

# Make sure '-p' works as expected.
test $(guix environment -p "$gcroot" -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT') = "$expected"
paths1="$(guix environment -p "$gcroot" --search-paths)"
paths2="$(guix environment --bootstrap --ad-hoc guile-bootstrap --search-paths)"
test "$paths1" = "$paths2"

rm "$gcroot"

# Try '-r' with a relative file name.
(cd "$tmpdir"; mkdir "gc-root";
 guix environment --bootstrap -r "gc-root/r" --ad-hoc guile-bootstrap \
      -- guile -c 1;
 rm "gc-root/r"; rmdir "gc-root")

# Same with an absolute file name.
guix environment --bootstrap -r "$PWD/$gcroot" --ad-hoc guile-bootstrap \
     -- guile -c 1
test `readlink "$gcroot"` = "$expected"

case "`uname -m`" in
    x86_64)
	# On x86_64, we should be able to create a 32-bit environment.
	guix environment --bootstrap --ad-hoc guile-bootstrap --pure	\
	     -- guile -c '(exit (string-prefix? "x86_64" %host-type))'
	guix environment --bootstrap --ad-hoc guile-bootstrap --pure	\
	     -s i686-linux						\
	     -- guile -c '(exit (string-prefix? "i686" %host-type))'
	;;
    *)
	echo "nothing to do" >&2
	;;
esac

# Make sure we can build the environment of 'guix'.  There may be collisions
# in its profile (e.g., for 'gzip'), but we have to accept them.
guix environment guix --bootstrap -n

# Try program transformation options.
mkdir "$tmpdir/emacs-36.8"
drv="`guix environment --ad-hoc emacs -n 2>&1 | grep 'emacs.*\.drv'`"
transformed_drv="`guix environment --ad-hoc emacs --with-source="$tmpdir/emacs-36.8" -n 2>&1 | grep 'emacs.*\.drv'`"
test -n "$drv"
test "$drv" != "$transformed_drv"
case "$transformed_drv" in
    *-emacs-36.8.drv) true;;
    *)                false;;
esac
rmdir "$tmpdir/emacs-36.8"

# Transformation options without '--ad-hoc'.
drv="`guix environment -n emacs-geiser 2>&1 | grep '\.drv$'`"
transformed_drv="`guix environment -n emacs-geiser \
  --with-input=emacs-minimal=vim 2>&1 | grep '\.drv$'`"
test "$drv" != "$transformed_drv"
case "$drv" in
    *-emacs-minimal*.drv*) true;;
    *)                     false;;
esac
case "$transformed_drv" in
    *-emacs-minimal*.drv*) false;;
    *)                     true;;
esac
case "$transformed_drv" in
    *-vim*.drv*) true;;
    *)           false;;
esac


if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
then
    # Compute the build environment for the initial GNU Make.
    guix environment --bootstrap --no-substitutes --search-paths --pure \
         -e '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/a"

    # Make sure bootstrap binaries are in the profile.
    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`

    # Make sure the bootstrap binaries are all listed where they belong.
    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
    grep -E "^export C_INCLUDE_PATH=\"$profile/include\"" "$tmpdir/a"
    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0
    do
	guix gc --references "$profile" | grep "$dep"
    done

    # 'make-boot0' itself must not be listed.
    guix gc --references "$profile" | grep make-boot0 && false

    # Make sure that the shell spawned with '--exec' sees the same environment
    # as returned by '--search-paths'.
    guix environment --bootstrap --no-substitutes --pure \
         -e '(@ (guix tests) gnu-make-for-tests)' \
         -- /bin/sh -c 'echo $PATH $C_INCLUDE_PATH $LIBRARY_PATH' > "$tmpdir/b"
    ( . "$tmpdir/a" ; echo $PATH $C_INCLUDE_PATH $LIBRARY_PATH ) > "$tmpdir/c"
    cmp "$tmpdir/b" "$tmpdir/c"

    rm "$tmpdir"/*

    # The following test assumes 'make-boot0' has a "debug" output.
    make_boot0_debug="`guix build -e '(@ (guix tests) gnu-make-for-tests)' | grep -e -debug`"
    test "x$make_boot0_debug" != "x"

    # Make sure the "debug" output is not listed.
    guix gc --references "$profile" | grep "$make_boot0_debug" && false

    # Compute the build environment for the initial GNU Make, but add in the
    # bootstrap Guile as an ad-hoc addition.
    guix environment --bootstrap --no-substitutes --search-paths --pure	\
         -e '(@ (guix tests) gnu-make-for-tests)'		\
         --ad-hoc guile-bootstrap > "$tmpdir/a"
    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`

    # Make sure the bootstrap binaries are all listed where they belong.
    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
    grep -E "^export C_INCLUDE_PATH=\"$profile/include\"" "$tmpdir/a"
    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \
				    guile-bootstrap
    do
	guix gc --references "$profile" | grep "$dep"
    done

    # Make sure a package list with plain package objects and package+output
    # tuples can be used with -e.
    expr_list_test_code="
(list (@ (guix tests) gnu-make-for-tests)
      (list (@ (gnu packages bootstrap) %bootstrap-guile) \"out\"))"

    guix environment --bootstrap --ad-hoc --no-substitutes --search-paths \
         --pure -e "$expr_list_test_code" > "$tmpdir/a"
    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`

    for dep in make-test-boot0 guile-bootstrap
    do
	guix gc --references "$profile" | grep "$dep"
    done
fi
. See @url{https://github.com/jcorporation/myMPD/issues/950}.") (script-acl (maybe-mympd-ip-acl (mympd-ip-acl (allow '("127.0.0.1")))) "ACL to access the myMPD script backend.") (ssl? (boolean #f) "SSL/TLS support.") (ssl-port (maybe-port 443) "Port to listen for HTTPS.") (ssl-cert maybe-string "Path to PEM encoded X.509 SSL/TLS certificate (public key).") (ssl-key maybe-string "Path to PEM encoded SSL/TLS private key.") (pin-hash maybe-string "SHA-256 hashed pin used by myMPD to control settings access by prompting a pin from the user.") (save-caches? maybe-boolean "Whether to preserve caches between service restarts.")) (define (mympd-serialize-configuration config) (define serialize-value (match-lambda ((? boolean? val) (if val "true" "false")) ((? integer? val) (number->string val)) ((? mympd-ip-acl? val) (ip-acl-serialize-configuration val)) ((? string? val) val))) (define (ip-acl-serialize-configuration config) (define (serialize-list-of-string prefix lst) (map (cut format #f "~a~a" prefix <>) lst)) (string-join (append (serialize-list-of-string "+" (mympd-ip-acl-allow config)) (serialize-list-of-string "-" (mympd-ip-acl-deny config))) ",")) ;; myMPD configuration fields are serialized as individual files under ;; /config/. (match-record config (work-directory acl covercache-ttl http? host port log-level lualibs uri script-acl ssl? ssl-port ssl-cert ssl-key pin-hash save-caches?) (define (serialize-field filename value) (when (maybe-value-set? value) (list (format #f "~a/config/~a" work-directory filename) (mixed-text-file filename (serialize-value value))))) (let ((filename-to-field `(("acl" . ,acl) ("covercache_keep_days" . ,covercache-ttl) ("http" . ,http?) ("http_host" . ,host) ("http_port" . ,port) ("loglevel" . ,log-level) ("lualibs" . ,lualibs) ("mympd_uri" . ,uri) ("scriptacl" . ,script-acl) ("ssl" . ,ssl?) ("ssl_port" . ,ssl-port) ("ssl_cert" . ,ssl-cert) ("ssl_key" . ,ssl-key) ("pin_hash" . ,pin-hash) ("save_caches" . ,save-caches?)))) (filter list? (generic-serialize-alist list serialize-field filename-to-field))))) (define (mympd-shepherd-service config) (match-record config (package shepherd-requirement user work-directory cache-directory log-level log-to) (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level))) (shepherd-service (documentation "Run the myMPD daemon.") (requirement `(loopback user-processes ,@shepherd-requirement)) (provision '(mympd)) (start #~(begin (let* ((pw (getpwnam #$user)) (uid (passwd:uid pw)) (gid (passwd:gid pw))) (for-each (lambda (dir) (mkdir-p dir) (chown dir uid gid)) (list #$work-directory #$cache-directory))) (make-forkexec-constructor `(#$(file-append package "/bin/mympd") "--user" #$user #$@(if (eqv? log-to 'syslog) '("--syslog") '()) "--workdir" #$work-directory "--cachedir" #$cache-directory) #:environment-variables (list #$log-level*) #:log-file #$(if (string? log-to) log-to #f)))) (stop #~(make-kill-destructor)))))) (define (mympd-accounts config) (match-record config (user group) (list (user-group (name group) (system? #t)) (user-account (name user) (group group) (system? #t) (comment "myMPD user") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin")))))) (define (mympd-log-rotation config) (match-record config (log-to) (if (string? log-to) (list (log-rotation (files (list log-to)))) '()))) (define mympd-service-type (service-type (name 'mympd) (extensions (list (service-extension shepherd-root-service-type (compose list mympd-shepherd-service)) (service-extension account-service-type mympd-accounts) (service-extension special-files-service-type mympd-serialize-configuration) (service-extension rottlog-service-type mympd-log-rotation))) (description "Run myMPD, a frontend for MPD. (Music Player Daemon)") (default-value (mympd-configuration))))