1 files changed, 263 insertions, 0 deletions
diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el
new file mode 100644
index 00000000000..ac08e055b55
--- /dev/null
+++ b/test/src/emacs-tests.el
@@ -0,0 +1,263 @@
+;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2021 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 '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))))
+
+(cl-defmacro emacs-tests--with-temp-file
+    (var (prefix &optional suffix text) &rest body)
+  "Evaluate BODY while a new temporary file exists.
+Bind VAR to the name of the file.  Pass PREFIX, SUFFIX, and TEXT
+to `make-temp-file', which see."
+  (declare (indent 2) (debug (symbolp (form form form) body)))
+  (cl-check-type var symbol)
+  ;; Use an uninterned symbol so that the code still works if BODY
+  ;; changes VAR.
+  (let ((filename (make-symbol "filename")))
+    `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text)))
+       (unwind-protect
+           (let ((,var ,filename))
+             ,@body)
+         (delete-file ,filename)))))
+
+(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))
+    (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".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))
+    (emacs-tests--with-temp-file
+        filter ("seccomp-too-large-" ".bpf"
+                (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))
+    (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf"
+                                         "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