tests/guix-environment-container.sh

   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
  27 if ! guile -c '((@ (guix scripts environment) assert-container-features))'
  28 then
  29     # User containers are not supported; skip this test.
  30     exit 77
  31 fi
  32
  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
  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
  55 # Make sure "localhost" resolves.
  56 guix environment --container --ad-hoc --bootstrap guile-bootstrap \
  57      -- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))'
  58
  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
  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
  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
  88 if test "x$USER" = "x"; then USER="`id -un`"; fi
  89
  90 # Check whether /etc/passwd and /etc/group are valid.
  91 guix environment -C --ad-hoc --bootstrap guile-bootstrap \
  92      -- guile -c "(exit (string=? \"$USER\" (passwd:name (getpwuid (getuid)))))"
  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)))))'
  99
 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
 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)
 121                   ;; Ignore the root file system.
 122                   ((_ \"/\" _ _ _ _)
 123                    #f)
 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\") _ _ _)
 128                    (and (string-prefix? (getcwd) mount)
 129                         mount))
 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
 143 cat "$tmpdir/mounts"
 144 test `wc -l < $tmpdir/mounts` -eq 4
 145
 146 current_dir="`cd $PWD; pwd -P`"
 147 grep -e "$current_dir$" $tmpdir/mounts # current directory
 148 grep $(guix build guile-bootstrap) $tmpdir/mounts
 149 grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash
 150
 151 rm $tmpdir/mounts
 152
 153 # Make sure 'GUIX_ENVIRONMENT' is set to '~/.guix-profile' when requested
 154 # within a container.
 155 (
 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")))))'
 162
 163   cd "$tmpdir" \
 164      && guix environment --bootstrap --container --link-profile \
 165              --ad-hoc guile-bootstrap --pure \
 166              -- guile -c "$linktest"
 167 )
 168
 169 # Test that user can be mocked.
 170 usertest='(exit (and (string=? (getenv "HOME") "/home/foognu")
 171                      (string=? (passwd:name (getpwuid 1000)) "foognu")
 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
 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 )
 186
 187 # Check the exit code.
 188
 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
 194 if guix environment --bootstrap --container \
 195         --ad-hoc guile-bootstrap -- guile -c "$abnormal_exit_code"
 196 then false;
 197 else
 198     test $? -gt 127
 199 fi
 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.
 220 guix shell -C --emulate-fhs --bootstrap guile-bootstrap \
 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.
 232 guix shell -CF --bootstrap guile-bootstrap \
 233      -- guile -c '(execlp "ldconfig" "ldconfig" "-p")'