gnu: epiphany: Enable tests.

[jackhill/guix/guix.git] / tests / syscalls.scm

diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 22ca2a0..7fe0cd1 100644 (file)
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -60,6 +60,19 @@
   (any (cute member <> (mount-points))
        '("/" "/proc" "/sys" "/dev")))
 
+(false-if-exception (delete-file temp-file))
+(test-equal "utime with AT_SYMLINK_NOFOLLOW"
+  '(0 0)
+  (begin
+    ;; Test libguile's utime with AT_SYMLINK_NOFOLLOW, which libguile does not
+    ;; define as of Guile 2.2.4.
+    (symlink "/nowhere" temp-file)
+    (utime temp-file 0 0 0 0 AT_SYMLINK_NOFOLLOW)
+    (let ((st (lstat temp-file)))
+      (delete-file temp-file)
+      ;; Note: 'utimensat' does not change 'ctime'.
+      (list (stat:mtime st) (stat:atime st)))))
+
 (test-assert "swapon, ENOENT/EPERM"
   (catch 'system-error
     (lambda ()
@@ -148,23 +161,22 @@
              (waitpid fork-pid)
              result))))))))
 
-;; XXX: Skip this test when running Linux > 4.7.5 to work around
-;; <https://bugzilla.kernel.org/show_bug.cgi?id=183461>.
-(when (or (not perform-container-tests?)
-          (version>? (utsname:release (uname)) "4.7.5"))
+(when (not perform-container-tests?)
   (test-skip 1))
 (test-equal "pivot-root"
-  #t
-  (match (pipe)
-    ((in . out)
+  'success!
+  (match (socketpair AF_UNIX SOCK_STREAM 0)
+    ((parent . child)
      (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD))
        (0
         (dynamic-wind
           (const #t)
           (lambda ()
-            (close in)
+            (close parent)
             (call-with-temporary-directory
              (lambda (root)
+               (display "ready\n" child)
+               (read child)                       ;wait for "go!"
                (let ((put-old (string-append root "/real-root")))
                  (mount "none" root "tmpfs")
                  (mkdir put-old)
@@ -173,18 +185,32 @@
                      (display "testing\n" port)))
                  (pivot-root root put-old)
                  ;; The test file should now be located inside the root directory.
-                 (write (file-exists? "/test") out)
-                 (close out)))))
+                 (write (and (file-exists? "/test") 'success!) child)
+                 (close child)))))
           (lambda ()
             (primitive-exit 0))))
        (pid
-        (close out)
-        (let ((result (read in)))
-          (close in)
-          (and (zero? (match (waitpid pid)
-                        ((_ . status)
-                         (status:exit-val status))))
-               (eq? #t result))))))))
+        (close child)
+        (match (read parent)
+          ('ready
+           ;; Set up the UID/GID mapping so that we can mkdir on the tmpfs:
+           ;; <https://bugzilla.kernel.org/show_bug.cgi?id=183461>.
+           (call-with-output-file (format #f "/proc/~d/setgroups" pid)
+             (lambda (port)
+               (display "deny" port)))
+           (call-with-output-file (format #f "/proc/~d/uid_map" pid)
+             (lambda (port)
+               (format port "0 ~d 1" (getuid))))
+           (call-with-output-file (format #f "/proc/~d/gid_map" pid)
+             (lambda (port)
+               (format port "0 ~d 1" (getgid))))
+           (display "go!\n" parent)
+           (let ((result (read parent)))
+             (close parent)
+             (and (zero? (match (waitpid pid)
+                           ((_ . status)
+                            (status:exit-val status))))
+                  result)))))))))
 
 (test-equal "scandir*, ENOENT"
   ENOENT
@@ -519,6 +545,9 @@
   (> (terminal-columns (open-input-string "Join us now, share the software!"))
      0))
 
+(test-assert "terminal-rows"
+  (> (terminal-rows) 0))
+
 (test-assert "utmpx-entries"
   (match (utmpx-entries)
     (((? utmpx? entries) ...)
@@ -545,6 +574,19 @@
   (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx)))
     (or (utmpx? result) (eof-object? result))))
 
+(when (zero? (getuid))
+  (test-skip 1))
+(test-equal "add-to-entropy-count"
+  EPERM
+  (call-with-output-file "/dev/urandom"
+    (lambda (port)
+      (catch 'system-error
+        (lambda ()
+          (add-to-entropy-count port 77)
+          #f)
+        (lambda args
+          (system-error-errno args))))))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))