;;; 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