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

# GNU Guix --- Functional package management for GNU
# Copyright © 2015 David Thompson <davet@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")'
Commit	Line	Data
f535dcbe DT	1	# GNU Guix --- Functional package management for GNU
	2	# Copyright © 2015 David Thompson <davet@gnu.org>
	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 'guix environment'.
	21	#
	22
	23	set -e
	24
	25	guix environment --version
	26
90f496be	27	if ! guile -c '((@ (guix scripts environment) assert-container-features))'
6493fd04 LC	28	then
	29	# User containers are not supported; skip this test.
	30	exit 77
	31	fi
	32
f535dcbe DT	33	tmpdir="t-guix-environment-$$"
	34	trap 'rm -r "$tmpdir"' EXIT
	35
	36	mkdir "$tmpdir"
	37
	38	# Make sure the exit value is preserved.
	39	if guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	40	-- guile -c '(exit 42)'
	41	then
	42	false
	43	else
	44	test $? = 42
	45	fi
	46
10208952 LC	47	# Try '--root' and '--profile'.
	48	root="$tmpdir/root"
	49	guix environment -C --ad-hoc --bootstrap guile-bootstrap -r "$root" -- guile --version
	50	guix environment -C -p "$root" --bootstrap -- guile --version
	51	path1=$(guix environment -C -p "$root" --bootstrap -- guile -c '(display (getenv "PATH"))')
	52	path2=$(guix environment -C --ad-hoc --bootstrap guile-bootstrap -- guile -c '(display (getenv "PATH"))')
	53	test "$path1" = "$path2"
	54
0f53c801 LC	55	# Make sure "localhost" resolves.
	56	guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	57	-- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))'
	58
b68d4106 LC	59	# We should get ECONNREFUSED, not ENETUNREACH, which would indicate that "lo"
	60	# is down.
	61	guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	62	-- guile -c "(exit (= ECONNREFUSED
	63	(catch 'system-error
	64	(lambda ()
	65	(let ((sock (socket AF_INET SOCK_STREAM 0)))
	66	(connect sock AF_INET INADDR_LOOPBACK 12345)))
	67	(lambda args
	68	(pk 'errno (system-error-errno args))))))"
	69
5a02f8e3 LC	70	# Make sure '--preserve' is honored.
	71	result="`FOOBAR=42; export FOOBAR; guix environment -C --ad-hoc --bootstrap \
	72	guile-bootstrap -E ^FOO -- guile -c '(display (getenv \"FOOBAR\"))'`"
	73	test "$result" = "42"
	74
1ccc0f80 LC	75	# By default, the UID inside the container should be the same as outside.
	76	uid="`id -u`"
	77	inner_uid="`guix environment -C --ad-hoc --bootstrap guile-bootstrap \
	78	-- guile -c '(display (getuid))'`"
	79	test $inner_uid = $uid
	80
	81	# When '--user' is passed, the UID should be 1000. (Note: Use a separate HOME
	82	# so that we don't run into problems when the test directory is under /home.)
	83	export tmpdir
	84	inner_uid="`HOME=$tmpdir guix environment -C --ad-hoc --bootstrap guile-bootstrap \
	85	--user=gnu-guix -- guile -c '(display (getuid))'`"
	86	test $inner_uid = 1000
	87
8a9922bd LC	88	if test "x$USER" = "x"; then USER="`id -un`"; fi
8a9922bd LC	89
952afb6f	90	# Check whether /etc/passwd and /etc/group are valid.
8a9922bd LC	91	guix environment -C --ad-hoc --bootstrap guile-bootstrap \
8a9922bd LC	92	-- guile -c "(exit (string=? \"$USER\" (passwd:name (getpwuid (getuid)))))"
952afb6f LC	93	guix environment -C --ad-hoc --bootstrap guile-bootstrap \
	94	-- guile -c '(exit (string? (group:name (getgrgid (getgid)))))'
	95	guix environment -C --ad-hoc --bootstrap guile-bootstrap \
	96	-- guile -c '(use-modules (srfi srfi-1))
	97	(exit (every group:name
	98	(map getgrgid (vector->list (getgroups)))))'
8a9922bd	99
c06f6db7 LC	100	# Make sure file-not-found errors in mounts are reported.
	101	if guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	102	--expose=/does-not-exist -- guile -c 1 2> "$tmpdir/error"
	103	then
	104	false
	105	else
	106	grep "/does-not-exist" "$tmpdir/error"
	107	grep "[Nn]o such file" "$tmpdir/error"
	108	fi
	109
f535dcbe DT	110	# Make sure that the right directories are mapped.
	111	mount_test_code="
	112	(use-modules (ice-9 rdelim)
	113	(ice-9 match)
	114	(srfi srfi-1))
	115
	116	(define mappings
	117	(filter-map (lambda (line)
	118	(match (string-split line #\space)
	119	;; Empty line.
	120	((\"\") #f)
1250034d LC	121	;; Ignore the root file system.
1250034d LC	122	((_ \"/\" _ _ _ _)
f535dcbe	123	#f)
1250034d LC	124	;; Ignore these types of file systems, except if they
	125	;; correspond to a parent file system.
	126	((_ mount (or \"tmpfs\" \"proc\" \"sysfs\" \"devtmpfs\"
	127	\"devpts\" \"cgroup\" \"mqueue\") _ _ _)
7cdec6a9	128	(and (string-prefix? (getcwd) mount)
1250034d	129	mount))
f535dcbe DT	130	((_ mount _ _ _ _)
	131	mount)))
	132	(string-split (call-with-input-file \"/proc/mounts\" read-string)
	133	#\newline)))
	134
	135	(for-each (lambda (mount)
	136	(display mount)
	137	(newline))
	138	mappings)"
	139
	140	guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	141	-- guile -c "$mount_test_code" > $tmpdir/mounts
	142
855038b2	143	cat "$tmpdir/mounts"
779aa003	144	test `wc -l < $tmpdir/mounts` -eq 4
f535dcbe	145
c8855b99 LC	146	current_dir="`cd $PWD; pwd -P`"
c8855b99 LC	147	grep -e "$current_dir$" $tmpdir/mounts # current directory
f535dcbe DT	148	grep $(guix build guile-bootstrap) $tmpdir/mounts
	149	grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash
	150
	151	rm $tmpdir/mounts
82e64fc1	152
9b65281d	153	# Make sure 'GUIX_ENVIRONMENT' is set to '~/.guix-profile' when requested
07ec3492 MG	154	# within a container.
07ec3492 MG	155	(
9b65281d LC	156	linktest='
	157	(exit (and (string=? (getenv "GUIX_ENVIRONMENT")
	158	(string-append (getenv "HOME") "/.guix-profile"))
	159	(string-prefix? "'"$NIX_STORE_DIR"'"
	160	(readlink (string-append (getenv "HOME")
	161	"/.guix-profile")))))'
07ec3492 MG	162
	163	cd "$tmpdir" \
	164	&& guix environment --bootstrap --container --link-profile \
	165	--ad-hoc guile-bootstrap --pure \
	166	-- guile -c "$linktest"
	167	)
	168
e37944d8 MG	169	# Test that user can be mocked.
e37944d8 MG	170	usertest='(exit (and (string=? (getenv "HOME") "/home/foognu")
1ccc0f80	171	(string=? (passwd:name (getpwuid 1000)) "foognu")
e37944d8 MG	172	(file-exists? "/home/foognu/umock")))'
	173	touch "$tmpdir/umock"
	174	HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \
	175	--ad-hoc guile-bootstrap --pure \
	176	--share="$tmpdir/umock" \
	177	-- guile -c "$usertest"
	178
75a6f668 LC	179	# if not sharing CWD, chdir home
	180	(
	181	cd "$tmpdir" \
	182	&& guix environment --bootstrap --container --no-cwd --user=foo \
	183	--ad-hoc guile-bootstrap --pure \
	184	-- /bin/sh -c 'test $(pwd) == "/home/foo" -a ! -d '"$tmpdir"
	185	)
e37944d8	186
07ec3492 MG	187	# Check the exit code.
07ec3492 MG	188
13bc8d5e DT	189	abnormal_exit_code="
	190	(use-modules (system foreign))
	191	;; Purposely make Guile crash with a segfault. :)
	192	(pointer->string (make-pointer 123) 123)"
	193
82e64fc1	194	if guix environment --bootstrap --container \
13bc8d5e	195	--ad-hoc guile-bootstrap -- guile -c "$abnormal_exit_code"
82e64fc1 LC	196	then false;
	197	else
	198	test $? -gt 127
	199	fi
c7ba5f38 JK	200
	201	# Test the Filesystem Hierarchy Standard (FHS) container option, --emulate-fhs (-F)
	202
	203	# As this option requires a glibc package (glibc-for-fhs), try to run these
	204	# tests with the user's global store to make it easier to build or download a
	205	# substitute.
	206	storedir="`guile -c '(use-modules (guix config))(display %storedir)'`"
	207	localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
	208	NIX_STORE_DIR="$storedir"
	209	GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
	210	export NIX_STORE_DIR GUIX_DAEMON_SOCKET
	211
	212	if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
	213	then
	214	exit 77
	215	fi
	216
	217	# Test that the container has FHS specific files/directories. Note that /bin
	218	# exists in a non-FHS container as it will contain sh, a symlink to the bash
	219	# package, so we don't test for it.
8b192c55	220	guix shell -C --emulate-fhs --bootstrap guile-bootstrap \
c7ba5f38 JK	221	-- guile -c '(exit (and (file-exists? "/etc/ld.so.cache")
	222	(file-exists? "/lib")
	223	(file-exists? "/sbin")
	224	(file-exists? "/usr/bin")
	225	(file-exists? "/usr/include")
	226	(file-exists? "/usr/lib")
	227	(file-exists? "/usr/libexec")
	228	(file-exists? "/usr/sbin")
	229	(file-exists? "/usr/share")))'
	230
	231	# Test that the ld cache was generated and can be successfully read.
8b192c55	232	guix shell -CF --bootstrap guile-bootstrap \
c7ba5f38	233	-- guile -c '(execlp "ldconfig" "ldconfig" "-p")'