[jackhill/guix/guix.git] / tests / guix-environment-container.sh

# GNU Guix --- Functional package management for GNU
# Copyright © 2015 David Thompson <davet@gnu.org>
# Copyright © 2022, 2023 John Kehayias <john.kehayias@protonmail.com>
# Copyright © 2023 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

if ! guile -c '((@ (guix scripts environment) assert-container-features))'
then
    # User containers are not supported; skip this test.
    exit 77
fi

tmpdir="t-guix-environment-$$"
trap 'rm -r "$tmpdir"' EXIT

mkdir "$tmpdir"

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

# Try '--root' and '--profile'.
root="$tmpdir/root"
guix environment -C --ad-hoc --bootstrap guile-bootstrap -r "$root" -- guile --version
guix environment -C -p "$root" --bootstrap -- guile --version
path1=$(guix environment -C -p "$root" --bootstrap -- guile -c '(display (getenv "PATH"))')
path2=$(guix environment -C --ad-hoc --bootstrap guile-bootstrap  -- guile -c '(display (getenv "PATH"))')
test "$path1" = "$path2"

# Make sure "localhost" resolves.
guix environment --container --ad-hoc --bootstrap guile-bootstrap \
     -- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))'

# We should get ECONNREFUSED, not ENETUNREACH, which would indicate that "lo"
# is down.
guix environment --container --ad-hoc --bootstrap guile-bootstrap \
     -- guile -c "(exit (= ECONNREFUSED
  (catch 'system-error
    (lambda ()
      (let ((sock (socket AF_INET SOCK_STREAM 0)))
        (connect sock AF_INET INADDR_LOOPBACK 12345)))
    (lambda args
      (pk 'errno (system-error-errno args))))))"

# Make sure '--preserve' is honored.
result="`FOOBAR=42; export FOOBAR; guix environment -C --ad-hoc --bootstrap \
   guile-bootstrap -E ^FOO -- guile -c '(display (getenv \"FOOBAR\"))'`"
test "$result" = "42"

# By default, the UID inside the container should be the same as outside.
uid="`id -u`"
inner_uid="`guix environment -C --ad-hoc --bootstrap guile-bootstrap \
  -- guile -c '(display (getuid))'`"
test $inner_uid = $uid

# When '--user' is passed, the UID should be 1000.  (Note: Use a separate HOME
# so that we don't run into problems when the test directory is under /home.)
export tmpdir
inner_uid="`HOME=$tmpdir guix environment -C --ad-hoc --bootstrap guile-bootstrap \
  --user=gnu-guix -- guile -c '(display (getuid))'`"
test $inner_uid = 1000

if test "x$USER" = "x"; then USER="`id -un`"; fi

# Check whether /etc/passwd and /etc/group are valid.
guix environment -C --ad-hoc --bootstrap guile-bootstrap \
     -- guile -c "(exit (string=? \"$USER\" (passwd:name (getpwuid (getuid)))))"
guix environment -C --ad-hoc --bootstrap guile-bootstrap \
     -- guile -c '(exit (string? (group:name (getgrgid (getgid)))))'
guix environment -C --ad-hoc --bootstrap guile-bootstrap \
     -- guile -c '(use-modules (srfi srfi-1))
                  (exit (every group:name
                               (map getgrgid (vector->list (getgroups)))))'

# Make sure file-not-found errors in mounts are reported.
if guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	--expose=/does-not-exist -- guile -c 1 2> "$tmpdir/error"
then
    false
else
    grep "/does-not-exist" "$tmpdir/error"
    grep "[Nn]o such file" "$tmpdir/error"
fi

# Make sure that the right directories are mapped.
mount_test_code="
(use-modules (ice-9 rdelim)
             (ice-9 match)
             (srfi srfi-1))

(define mappings
  (filter-map (lambda (line)
                (match (string-split line #\space)
                  ;; Empty line.
                  ((\"\") #f)
                  ;; Ignore the root file system.
                  ((_ \"/\" _ _ _ _)
                   #f)
                  ;; Ignore these types of file systems, except if they
                  ;; correspond to a parent file system.
                  ((_ mount (or \"tmpfs\" \"proc\" \"sysfs\" \"devtmpfs\"
                                \"devpts\" \"cgroup\" \"mqueue\") _ _ _)
                   (and (string-prefix? (getcwd) mount)
		        mount))
                  ((_ mount _ _ _ _)
                   mount)))
              (string-split (call-with-input-file \"/proc/mounts\" read-string)
                            #\newline)))

(for-each (lambda (mount)
            (display mount)
            (newline))
          mappings)"

guix environment --container --ad-hoc --bootstrap guile-bootstrap \
     -- guile -c "$mount_test_code" > $tmpdir/mounts

cat "$tmpdir/mounts"
test `wc -l < $tmpdir/mounts` -eq 4

current_dir="`cd $PWD; pwd -P`"
grep -e "$current_dir$" $tmpdir/mounts # current directory
grep $(guix build guile-bootstrap) $tmpdir/mounts
grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash

rm $tmpdir/mounts

# Make sure 'GUIX_ENVIRONMENT' is set to '~/.guix-profile' when requested
# within a container.
(
  linktest='
(exit (and (string=? (getenv "GUIX_ENVIRONMENT")
                     (string-append (getenv "HOME") "/.guix-profile"))
           (string-prefix? "'"$NIX_STORE_DIR"'"
                           (readlink (string-append (getenv "HOME")
                                                    "/.guix-profile")))))'

  cd "$tmpdir" \
     && guix environment --bootstrap --container --link-profile \
             --ad-hoc guile-bootstrap --pure \
             -- guile -c "$linktest"
)

# Test that user can be mocked.
usertest='(exit (and (string=? (getenv "HOME") "/home/foognu")
                     (string=? (passwd:name (getpwuid 1000)) "foognu")
                     (file-exists? "/home/foognu/umock")))'
touch "$tmpdir/umock"
HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \
     --ad-hoc guile-bootstrap --pure \
     --share="$tmpdir/umock" \
     -- guile -c "$usertest"

# if not sharing CWD, chdir home
(
  cd "$tmpdir" \
    && guix environment --bootstrap --container --no-cwd --user=foo  \
            --ad-hoc guile-bootstrap --pure \
            -- /bin/sh -c 'test $(pwd) == "/home/foo" -a ! -d '"$tmpdir"
)

# Check the exit code.

abnormal_exit_code="
(use-modules (system foreign))
;; Purposely make Guile crash with a segfault. :)
(pointer->string (make-pointer 123) 123)"

if guix environment --bootstrap --container \
	--ad-hoc guile-bootstrap -- guile -c "$abnormal_exit_code"
then false;
else
    test $? -gt 127
fi

# Test the Filesystem Hierarchy Standard (FHS) container option, --emulate-fhs (-F)

# As this option requires a glibc package (glibc-for-fhs), try to run these
# tests with the user's global store to make it easier to build or download a
# substitute.
storedir="`guile -c '(use-modules (guix config))(display %storedir)'`"
localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
NIX_STORE_DIR="$storedir"
GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
export NIX_STORE_DIR GUIX_DAEMON_SOCKET

if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
then
    exit 77
fi

# Test that the container has FHS specific files/directories.  Note that /bin
# exists in a non-FHS container as it will contain sh, a symlink to the bash
# package, so we don't test for it.
guix shell -C --emulate-fhs --bootstrap guile-bootstrap \
     -- guile -c '(exit (and (file-exists? "/etc/ld.so.cache")
                             (file-exists? "/lib")
                             (file-exists? "/sbin")
                             (file-exists? "/usr/bin")
                             (file-exists? "/usr/include")
                             (file-exists? "/usr/lib")
                             (file-exists? "/usr/libexec")
                             (file-exists? "/usr/sbin")
                             (file-exists? "/usr/share")))'

# Test that the ld cache was generated and can be successfully read.
guix shell -CF --bootstrap guile-bootstrap \
     -- guile -c '(execlp "ldconfig" "ldconfig" "-p")'

# Test that the package glibc-for-fhs is in the container even if there is the
# regular glibc package from another source.  See
# <https://issues.guix.gnu.org/58861>.
guix shell -CF --bootstrap guile-bootstrap glibc \
     -- guile -c '(exit (if (string-contains (readlink "/lib/libc.so")
                            "glibc-for-fhs")
                           0
                           1))'

# Test that $PATH inside the container includes the FHS directories.
guix shell -CF coreutils -- env | grep ^PATH=/bin:/usr/bin:/sbin:/usr/sbin.*

# Make sure '--preserve' is honored for $PATH, which the '--emulate-fhs'
# option modifies.  We can't (easily) check the whole $PATH as it will differ
# inside and outside the container, so just check our test $PATH is still
# present.  See <https://issues.guix.gnu.org/60566>.
PATH=/foo $(type -P guix) shell -CF -E ^PATH$ coreutils \
     -- env | grep ^PATH=.*:/foo

# '--symlink' works.
echo "TESTING SYMLINK IN CONTAINER"
guix shell --bootstrap guile-bootstrap --container \
     --symlink=/usr/bin/guile=bin/guile -- \
     /usr/bin/guile --version

# A dangling symlink causes the command to fail.
! guix shell --bootstrap -CS /usr/bin/python=bin/python guile-bootstrap -- exit

# An invalid symlink spec causes the command to fail.
! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap -- exit
Commit	Line	Data
f535dcbe DT	1	# GNU Guix --- Functional package management for GNU
f535dcbe DT	2	# Copyright © 2015 David Thompson <davet@gnu.org>
3bfbfa29 JK	3	# Copyright © 2022, 2023 John Kehayias <john.kehayias@protonmail.com>
3bfbfa29 JK	4	# Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
f535dcbe DT	5	#
	6	# This file is part of GNU Guix.
	7	#
	8	# GNU Guix is free software; you can redistribute it and/or modify it
	9	# under the terms of the GNU General Public License as published by
	10	# the Free Software Foundation; either version 3 of the License, or (at
	11	# your option) any later version.
	12	#
	13	# GNU Guix is distributed in the hope that it will be useful, but
	14	# WITHOUT ANY WARRANTY; without even the implied warranty of
	15	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	# GNU General Public License for more details.
	17	#
	18	# You should have received a copy of the GNU General Public License
	19	# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	20
	21	#
	22	# Test 'guix environment'.
	23	#
	24
	25	set -e
	26
	27	guix environment --version
	28
90f496be	29	if ! guile -c '((@ (guix scripts environment) assert-container-features))'
6493fd04 LC	30	then
	31	# User containers are not supported; skip this test.
	32	exit 77
	33	fi
	34
f535dcbe DT	35	tmpdir="t-guix-environment-$$"
	36	trap 'rm -r "$tmpdir"' EXIT
	37
	38	mkdir "$tmpdir"
	39
	40	# Make sure the exit value is preserved.
	41	if guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	42	-- guile -c '(exit 42)'
	43	then
	44	false
	45	else
	46	test $? = 42
	47	fi
	48
10208952 LC	49	# Try '--root' and '--profile'.
	50	root="$tmpdir/root"
	51	guix environment -C --ad-hoc --bootstrap guile-bootstrap -r "$root" -- guile --version
	52	guix environment -C -p "$root" --bootstrap -- guile --version
	53	path1=$(guix environment -C -p "$root" --bootstrap -- guile -c '(display (getenv "PATH"))')
	54	path2=$(guix environment -C --ad-hoc --bootstrap guile-bootstrap -- guile -c '(display (getenv "PATH"))')
	55	test "$path1" = "$path2"
	56
0f53c801 LC	57	# Make sure "localhost" resolves.
	58	guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	59	-- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))'
	60
b68d4106 LC	61	# We should get ECONNREFUSED, not ENETUNREACH, which would indicate that "lo"
	62	# is down.
	63	guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	64	-- guile -c "(exit (= ECONNREFUSED
	65	(catch 'system-error
	66	(lambda ()
	67	(let ((sock (socket AF_INET SOCK_STREAM 0)))
	68	(connect sock AF_INET INADDR_LOOPBACK 12345)))
	69	(lambda args
	70	(pk 'errno (system-error-errno args))))))"
	71
5a02f8e3 LC	72	# Make sure '--preserve' is honored.
	73	result="`FOOBAR=42; export FOOBAR; guix environment -C --ad-hoc --bootstrap \
	74	guile-bootstrap -E ^FOO -- guile -c '(display (getenv \"FOOBAR\"))'`"
	75	test "$result" = "42"
	76
1ccc0f80 LC	77	# By default, the UID inside the container should be the same as outside.
	78	uid="`id -u`"
	79	inner_uid="`guix environment -C --ad-hoc --bootstrap guile-bootstrap \
	80	-- guile -c '(display (getuid))'`"
	81	test $inner_uid = $uid
	82
	83	# When '--user' is passed, the UID should be 1000. (Note: Use a separate HOME
	84	# so that we don't run into problems when the test directory is under /home.)
	85	export tmpdir
	86	inner_uid="`HOME=$tmpdir guix environment -C --ad-hoc --bootstrap guile-bootstrap \
	87	--user=gnu-guix -- guile -c '(display (getuid))'`"
	88	test $inner_uid = 1000
	89
8a9922bd LC	90	if test "x$USER" = "x"; then USER="`id -un`"; fi
8a9922bd LC	91
952afb6f	92	# Check whether /etc/passwd and /etc/group are valid.
8a9922bd LC	93	guix environment -C --ad-hoc --bootstrap guile-bootstrap \
8a9922bd LC	94	-- guile -c "(exit (string=? \"$USER\" (passwd:name (getpwuid (getuid)))))"
952afb6f LC	95	guix environment -C --ad-hoc --bootstrap guile-bootstrap \
	96	-- guile -c '(exit (string? (group:name (getgrgid (getgid)))))'
	97	guix environment -C --ad-hoc --bootstrap guile-bootstrap \
	98	-- guile -c '(use-modules (srfi srfi-1))
	99	(exit (every group:name
	100	(map getgrgid (vector->list (getgroups)))))'
8a9922bd	101
c06f6db7 LC	102	# Make sure file-not-found errors in mounts are reported.
	103	if guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	104	--expose=/does-not-exist -- guile -c 1 2> "$tmpdir/error"
	105	then
	106	false
	107	else
	108	grep "/does-not-exist" "$tmpdir/error"
	109	grep "[Nn]o such file" "$tmpdir/error"
	110	fi
	111
f535dcbe DT	112	# Make sure that the right directories are mapped.
	113	mount_test_code="
	114	(use-modules (ice-9 rdelim)
	115	(ice-9 match)
	116	(srfi srfi-1))
	117
	118	(define mappings
	119	(filter-map (lambda (line)
	120	(match (string-split line #\space)
	121	;; Empty line.
	122	((\"\") #f)
1250034d LC	123	;; Ignore the root file system.
1250034d LC	124	((_ \"/\" _ _ _ _)
f535dcbe	125	#f)
1250034d LC	126	;; Ignore these types of file systems, except if they
	127	;; correspond to a parent file system.
	128	((_ mount (or \"tmpfs\" \"proc\" \"sysfs\" \"devtmpfs\"
	129	\"devpts\" \"cgroup\" \"mqueue\") _ _ _)
7cdec6a9	130	(and (string-prefix? (getcwd) mount)
1250034d	131	mount))
f535dcbe DT	132	((_ mount _ _ _ _)
	133	mount)))
	134	(string-split (call-with-input-file \"/proc/mounts\" read-string)
	135	#\newline)))
	136
	137	(for-each (lambda (mount)
	138	(display mount)
	139	(newline))
	140	mappings)"
	141
	142	guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	143	-- guile -c "$mount_test_code" > $tmpdir/mounts
	144
855038b2	145	cat "$tmpdir/mounts"
779aa003	146	test `wc -l < $tmpdir/mounts` -eq 4
f535dcbe	147
c8855b99 LC	148	current_dir="`cd $PWD; pwd -P`"
c8855b99 LC	149	grep -e "$current_dir$" $tmpdir/mounts # current directory
f535dcbe DT	150	grep $(guix build guile-bootstrap) $tmpdir/mounts
	151	grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash
	152
	153	rm $tmpdir/mounts
82e64fc1	154
9b65281d	155	# Make sure 'GUIX_ENVIRONMENT' is set to '~/.guix-profile' when requested
07ec3492 MG	156	# within a container.
07ec3492 MG	157	(
9b65281d LC	158	linktest='
	159	(exit (and (string=? (getenv "GUIX_ENVIRONMENT")
	160	(string-append (getenv "HOME") "/.guix-profile"))
	161	(string-prefix? "'"$NIX_STORE_DIR"'"
	162	(readlink (string-append (getenv "HOME")
	163	"/.guix-profile")))))'
07ec3492 MG	164
	165	cd "$tmpdir" \
	166	&& guix environment --bootstrap --container --link-profile \
	167	--ad-hoc guile-bootstrap --pure \
	168	-- guile -c "$linktest"
	169	)
	170
e37944d8 MG	171	# Test that user can be mocked.
e37944d8 MG	172	usertest='(exit (and (string=? (getenv "HOME") "/home/foognu")
1ccc0f80	173	(string=? (passwd:name (getpwuid 1000)) "foognu")
e37944d8 MG	174	(file-exists? "/home/foognu/umock")))'
	175	touch "$tmpdir/umock"
	176	HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \
	177	--ad-hoc guile-bootstrap --pure \
	178	--share="$tmpdir/umock" \
	179	-- guile -c "$usertest"
	180
75a6f668 LC	181	# if not sharing CWD, chdir home
	182	(
	183	cd "$tmpdir" \
	184	&& guix environment --bootstrap --container --no-cwd --user=foo \
	185	--ad-hoc guile-bootstrap --pure \
	186	-- /bin/sh -c 'test $(pwd) == "/home/foo" -a ! -d '"$tmpdir"
	187	)
e37944d8	188
07ec3492 MG	189	# Check the exit code.
07ec3492 MG	190
13bc8d5e DT	191	abnormal_exit_code="
	192	(use-modules (system foreign))
	193	;; Purposely make Guile crash with a segfault. :)
	194	(pointer->string (make-pointer 123) 123)"
	195
82e64fc1	196	if guix environment --bootstrap --container \
13bc8d5e	197	--ad-hoc guile-bootstrap -- guile -c "$abnormal_exit_code"
82e64fc1 LC	198	then false;
	199	else
	200	test $? -gt 127
	201	fi
c7ba5f38 JK	202
	203	# Test the Filesystem Hierarchy Standard (FHS) container option, --emulate-fhs (-F)
	204
	205	# As this option requires a glibc package (glibc-for-fhs), try to run these
	206	# tests with the user's global store to make it easier to build or download a
	207	# substitute.
	208	storedir="`guile -c '(use-modules (guix config))(display %storedir)'`"
	209	localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
	210	NIX_STORE_DIR="$storedir"
	211	GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
	212	export NIX_STORE_DIR GUIX_DAEMON_SOCKET
	213
	214	if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
	215	then
	216	exit 77
	217	fi
	218
	219	# Test that the container has FHS specific files/directories. Note that /bin
	220	# exists in a non-FHS container as it will contain sh, a symlink to the bash
	221	# package, so we don't test for it.
8b192c55	222	guix shell -C --emulate-fhs --bootstrap guile-bootstrap \
c7ba5f38 JK	223	-- guile -c '(exit (and (file-exists? "/etc/ld.so.cache")
	224	(file-exists? "/lib")
	225	(file-exists? "/sbin")
	226	(file-exists? "/usr/bin")
	227	(file-exists? "/usr/include")
	228	(file-exists? "/usr/lib")
	229	(file-exists? "/usr/libexec")
	230	(file-exists? "/usr/sbin")
	231	(file-exists? "/usr/share")))'
	232
	233	# Test that the ld cache was generated and can be successfully read.
8b192c55	234	guix shell -CF --bootstrap guile-bootstrap \
c7ba5f38	235	-- guile -c '(execlp "ldconfig" "ldconfig" "-p")'
905443ab JK	236
	237	# Test that the package glibc-for-fhs is in the container even if there is the
	238	# regular glibc package from another source. See
	239	# <https://issues.guix.gnu.org/58861>.
	240	guix shell -CF --bootstrap guile-bootstrap glibc \
	241	-- guile -c '(exit (if (string-contains (readlink "/lib/libc.so")
	242	"glibc-for-fhs")
	243	0
	244	1))'
b31ea797	245
3bfbfa29 JK	246	# Test that $PATH inside the container includes the FHS directories.
	247	guix shell -CF coreutils -- env \| grep ^PATH=/bin:/usr/bin:/sbin:/usr/sbin.*
	248
	249	# Make sure '--preserve' is honored for $PATH, which the '--emulate-fhs'
	250	# option modifies. We can't (easily) check the whole $PATH as it will differ
	251	# inside and outside the container, so just check our test $PATH is still
	252	# present. See <https://issues.guix.gnu.org/60566>.
	253	PATH=/foo $(type -P guix) shell -CF -E ^PATH$ coreutils \
	254	-- env \| grep ^PATH=.*:/foo
	255
b31ea797 MC	256	# '--symlink' works.
	257	echo "TESTING SYMLINK IN CONTAINER"
	258	guix shell --bootstrap guile-bootstrap --container \
	259	--symlink=/usr/bin/guile=bin/guile -- \
	260	/usr/bin/guile --version
	261
	262	# A dangling symlink causes the command to fail.
	263	! guix shell --bootstrap -CS /usr/bin/python=bin/python guile-bootstrap -- exit
788602b3 MC	264
	265	# An invalid symlink spec causes the command to fail.
	266	! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap -- exit