X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/d123f2f991e0bf6f51e5f207d291fb4c1ceb1245..c26fd5648c2a24dbd71f4c0851f8b5eced75e0f1:/tests/syscalls.scm diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 92e02f3303..7fe0cd1545 100644 --- 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 +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2015 David Thompson ;;; ;;; This file is part of GNU Guix. @@ -24,6 +24,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) + #:use-module (system foreign) + #:use-module ((ice-9 ftw) #:select (scandir)) #:use-module (ice-9 match)) ;; Test the (guix build syscalls) module, although there's not much that can @@ -58,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 () @@ -146,23 +161,22 @@ (waitpid fork-pid) result)))))))) -;; XXX: Skip this test when running Linux > 4.7.5 to work around -;; . -(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) @@ -171,18 +185,90 @@ (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: + ;; . + (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 + (catch 'system-error + (lambda () + (scandir* "/does/not/exist")) + (lambda args + (system-error-errno args)))) + +(test-equal "scandir*, ASCII file names" + (scandir (dirname (search-path %load-path "guix/base32.scm")) + (const #t) stringprocedure int + (dynamic-func "creat" (dynamic-link)) + (list '* int)))) + (creat (string->pointer (string-append directory "/α") + "UTF-8") + #o644) + (creat (string->pointer (string-append directory "/λ") + "UTF-8") + #o644) + (let ((locale (setlocale LC_ALL))) + (dynamic-wind + (lambda () + ;; Make sure that even in a C locale we get the right result. + (setlocale LC_ALL "C")) + (lambda () + (match (scandir* directory) + (((names . properties) ...) + names))) + (lambda () + (setlocale LC_ALL locale)))))))) + +(test-assert "scandir*, properties" + (let ((directory (dirname (search-path %load-path "guix/base32.scm")))) + (every (lambda (entry name) + (match entry + ((name2 . properties) + (and (string=? name2 name) + (let* ((full (string-append directory "/" name)) + (stat (lstat full)) + (inode (assoc-ref properties 'inode)) + (type (assoc-ref properties 'type))) + (and (= inode (stat:ino stat)) + (or (eq? type 'unknown) + (eq? type (stat:type stat))))))))) + (scandir* directory) + (scandir directory (const #t) string (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) ...) (every (lambda (entry) (match (utmpx-user entry) ((? string?) - (> (utmpx-pid entry) 0)) + ;; Ensure we have a valid PID for those entries where it + ;; makes sense. + (or (not (memv (utmpx-login-type entry) + (list (login-type INIT_PROCESS) + (login-type LOGIN_PROCESS) + (login-type USER_PROCESS)))) + (> (utmpx-pid entry) 0))) (#f ;might be DEAD_PROCESS #t))) entries)))) @@ -456,11 +569,24 @@ (eof-object? (read-utmpx (%make-void-port "r")))) (unless (access? "/var/run/utmpx" O_RDONLY) - (tes-skip 1)) + (test-skip 1)) (test-assert "read-utmpx" (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))