diff options
Diffstat (limited to 'test/src/emacs-tests.el')
| -rw-r--r-- | test/src/emacs-tests.el | 249 |
1 files changed, 249 insertions, 0 deletions
diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el new file mode 100644 index 00000000000..52888135c12 --- /dev/null +++ b/test/src/emacs-tests.el @@ -0,0 +1,249 @@ +;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 Emacs 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 Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for src/emacs.c. + +;;; Code: + +(require 'cl-lib) +(require 'ert) +(require 'ert-x) ; ert-with-temp-file +(require 'rx) +(require 'subr-x) + +(defconst emacs-tests--lib-src + (substitute-in-file-name "$EMACS_TEST_DIRECTORY/../lib-src/") + "Location of the lib-src directory.") + +(ert-deftest emacs-tests/seccomp/absent-file () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (should-not (file-exists-p "/does-not-exist.bpf")) + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + "--seccomp=/does-not-exist.bpf") + 0)))) + +(ert-deftest emacs-tests/seccomp/empty-file () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (ert-with-temp-file filter + :prefix "seccomp-invalid-" :suffix ".bpf" + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; According to the Seccomp man page, a filter must have at + ;; least one element, so Emacs should reject an empty file. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/file-too-large () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil) + ;; This value should be correct on all supported systems. + (ushort-max #xFFFF) + ;; Either 8 or 16, but 16 should be large enough in all cases. + (filter-size 16)) + (skip-unless (file-executable-p emacs)) + (ert-with-temp-file filter + :prefix "seccomp-too-large-" :suffix ".bpf" + :text (make-string (* (1+ ushort-max) filter-size) ?a) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; The filter count must fit into an `unsigned short'. A bigger + ;; file should be rejected. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/invalid-file-size () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (ert-with-temp-file filter + :prefix "seccomp-invalid-" :suffix ".bpf" :text "123456" + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; The Seccomp filter file must have a file size that's a + ;; multiple of the size of struct sock_filter, which is 8 or 16, + ;; but never 6. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/allows-stdout () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (filter (expand-file-name "seccomp-filter.bpf" + emacs-tests--lib-src)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + (with-temp-buffer + (let ((start-time (current-time)) + (status (call-process + emacs nil t nil + "--quick" "--batch" + (concat "--seccomp=" filter) + (format "--eval=%S" '(message "Hi")))) + (end-time (current-time))) + (ert-info ((emacs-tests--seccomp-debug start-time end-time)) + (should (eql status 0))) + (should (equal (string-trim (buffer-string)) "Hi")))))) + +(ert-deftest emacs-tests/seccomp/forbids-subprocess () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (filter (expand-file-name "seccomp-filter.bpf" + emacs-tests--lib-src)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + (with-temp-buffer + (let ((start-time (current-time)) + (status + (call-process + emacs nil t nil + "--quick" "--batch" + (concat "--seccomp=" filter) + (format "--eval=%S" `(call-process ,emacs nil nil nil + "--version")))) + (end-time (current-time))) + (ert-info ((emacs-tests--seccomp-debug start-time end-time)) + (should-not (eql status 0))))))) + +(ert-deftest emacs-tests/bwrap/allows-stdout () + (let ((bash (executable-find "bash")) + (bwrap (executable-find "bwrap")) + (emacs + (expand-file-name invocation-name invocation-directory)) + (filter (expand-file-name "seccomp-filter-exec.bpf" + emacs-tests--lib-src)) + (process-environment nil)) + (skip-unless bash) + (skip-unless bwrap) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + (should-not (file-remote-p bwrap)) + (should-not (file-remote-p emacs)) + (should-not (file-remote-p filter)) + (with-temp-buffer + (let* ((command + (concat + (mapconcat #'shell-quote-argument + `(,(file-name-unquote bwrap) + "--ro-bind" "/" "/" + "--seccomp" "20" + "--" + ,(file-name-unquote emacs) + "--quick" "--batch" + ,(format "--eval=%S" '(message "Hi"))) + " ") + " 20< " + (shell-quote-argument (file-name-unquote filter)))) + (start-time (current-time)) + (status (call-process bash nil t nil "-c" command)) + (end-time (current-time))) + (ert-info ((emacs-tests--seccomp-debug start-time end-time)) + (should (eql status 0))) + (should (equal (string-trim (buffer-string)) "Hi")))))) + +(defun emacs-tests--seccomp-debug (start-time end-time) + "Return potentially useful debugging information for Seccomp. +Assume that the current buffer contains subprocess output for the +failing process. START-TIME and END-TIME are time values between +which the process was running." + ;; Add a bit of slack for the timestamps. + (cl-callf time-subtract start-time 5) + (cl-callf time-add end-time 5) + (with-output-to-string + (princ "Process output:") + (terpri) + (princ (buffer-substring-no-properties (point-min) (point-max))) + ;; Search audit logs for Seccomp messages. + (when-let ((ausearch (executable-find "ausearch"))) + (terpri) + (princ "Potentially relevant Seccomp audit events:") + (terpri) + (let ((process-environment '("LC_TIME=C"))) + (call-process ausearch nil standard-output nil + "--message" "SECCOMP" + "--start" + (format-time-string "%D" start-time) + (format-time-string "%T" start-time) + "--end" + (format-time-string "%D" end-time) + (format-time-string "%T" end-time) + "--interpret"))) + ;; Print coredump information if available. + (when-let ((coredumpctl (executable-find "coredumpctl"))) + (terpri) + (princ "Potentially useful coredump information:") + (terpri) + (call-process coredumpctl nil standard-output nil + "info" + "--since" (format-time-string "%F %T" start-time) + "--until" (format-time-string "%F %T" end-time) + "--no-pager")))) + +;;; emacs-tests.el ends here |