bug#45198: 28.0.50; Sandbox mode

["Mattias Engdegård" <mattiase@acm.org>]

[-- Attachment #1: Type: text/plain, Size: 3936 bytes --]


17 apr. 2021 kl. 21.42 skrev Philipp <p.stephani2@gmail.com>:

>> --- a/lisp/subr.el
> 
> Should this maybe be in a platform-specific file such as ns-fns.el (like dos-fns.el, w32-fns.el)?

Yes, and thank you for noticing. Now moved.

> I don't think we use the "darwin-" prefix anywhere else in Emacs.  Maybe use a "ns-" prefix.

As Alan correctly noted this has nothing with NS to do per se, so I'm staying with darwin- for now.

> Also I think such internal functions commonly have an "internal" piece somewhere in their name, e.g. "ns-enter-sandbox-internal".

Maybe, but there is already a platform-specific prefix and a clear note in the doc string that it's internal. Doesn't that suffice?

>> +    (darwin-sandbox-init
> 
> Can you also refer to the documents listed below, so that readers aren't wondering what this syntax means?

Thank you but that sounds unlikely since the PROFILE argument is described as SBPL in the function doc string.

>> +     (concat "(version 1)\n"
> 
> Since this uses Lisp syntax, maybe use (prin1-to-string `(...))?

I'd rather not, since it's not exactly Emacs Lisp syntax. I'd like to avoiding conflating the two as far as possible. However...

>> +                          (format "(allow file-read* (subpath %S))\n" dir))
> 
> Are you sure that the string quoting syntaxes are compatible?

It had me concerned when I wrote it too but it didn't seem possible to cause a false positive that way -- false negatives (access denial) at worst. In particular, names containing backslashes or double quotes work correctly.

>> +       doc: /* Enter a sandbox whose permitted access is curtailed by PROFILE.
>> +Already open descriptors can be used freely.
>> +PROFILE is a string in the macOS sandbox profile language,
>> +a set of rules in a Lisp-like syntax.
> 
> I'd also refer to the Chromium document here, otherwise C-h f for this function won't be very useful.

I wouldn't worry -- an Emacs developer who doesn't already know it is more likely to duckduckgo "macos sandbox profile language" and get an up-to-date reference.

>> +  if (sandbox_init_with_parameters (SSDATA (profile), 0, NULL, &err) != 0)
> 
> If you're using SSDATA, better check that the string doesn't contain embedded null bytes.

There is really no way that that could ever be a problem but I added a check just in case.

> Also does this need to be encoded somehow?  What happens if the string contains non-Unicode characters like raw bytes?

Then there will be false negatives (permissions not granted) or syntax errors. This is just a system call wrapper; the caller is responsible for using reasonable arguments.

>> +    error ("sandbox error: %s", err);
> 
> This looks like an error that clients could handle, so I'd signal a specific error symbol here.

That error just indicates a programming mistake. Nobody is going to handle it.

>> diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el
> 
> This should probably be in subr-tests.el since it tests a function in subr.el.

Right again, moved to a new file.

> I like tests that are somewhat repetitive but more decoupled and easier to read better than tests with factored-out assertions.

There is merit to such a style but the more important concern in this case is to avoid false positives and negatives, and make the tests robust in that regard.

It is very easy to make a mistake that renders a test meaningless, especially when testing a mechanism that does not alter the value of a computation but merely allows it to proceed or causes it to fail. The test has now been rewritten in a kind of oracular-combinatorial style which is effective in these situations. Doing so also improved coverage.

Thank you very much for your review and comments! I'd like to push the resulting patch but perhaps it and the rest of the sandbox development should go into a separate branch?


[-- Attachment #2: 0001-Add-macOS-sandboxing-bug-45198.patch --]
[-- Type: application/octet-stream, Size: 9382 bytes --]

From c5006dc5260f547ff132fd42c580ea0e0fb227a7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Sat, 17 Apr 2021 20:53:39 +0200
Subject: [PATCH] Add macOS sandboxing (bug#45198)

This is the corresponding low-level sandboxing facility corresponding
to the recently added Seccomp for Linux.  `darwin-sandbox-init` gives
direct access to the system sandboxing call; `darwin-sandbox-enter` is
a wrapper that takes a list of directories under which files can be
read.  These should be considered internal mechanisms for now.

* lisp/darwin-fns.el: New file.
* lisp/loadup.el: Load it.
* src/sysdep.c (Fdarwin_sandbox_init): New function.
* test/lisp/darwin-fns-tests.el: New file.
---
 lisp/darwin-fns.el            | 40 ++++++++++++++++
 lisp/loadup.el                |  2 +
 src/sysdep.c                  | 34 +++++++++++++
 test/lisp/darwin-fns-tests.el | 90 +++++++++++++++++++++++++++++++++++
 4 files changed, 166 insertions(+)
 create mode 100644 lisp/darwin-fns.el
 create mode 100644 test/lisp/darwin-fns-tests.el

diff --git a/lisp/darwin-fns.el b/lisp/darwin-fns.el
new file mode 100644
index 0000000000..e45aaa0c4e
--- /dev/null
+++ b/lisp/darwin-fns.el
@@ -0,0 +1,40 @@
+;;; darwin-fns.el --- Darwin-specific functions  -*- lexical-binding: t -*-
+
+;; Copyright (C) 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/>.
+
+;;; Code:
+
+(defun darwin-sandbox-enter (dirs)
+  "Enter a sandbox only permitting reading files under DIRS.
+DIRS is a list of directory names.  Most other operations such as
+writing files and network access are disallowed.
+Existing open descriptors can still be used freely.
+
+This is not a supported interface and is for internal use only."
+  (darwin-sandbox-init
+   (concat "(version 1)\n"
+           "(deny default)\n"
+           ;; Emacs seems to need /dev/null; allowing it does no harm.
+           "(allow file-read* (path \"/dev/null\"))\n"
+           (mapconcat (lambda (dir)
+                        (format "(allow file-read* (subpath %S))\n" dir))
+                      dirs ""))))
+
+(provide 'darwin-fns)
+
+;;; darwin-fns.el ends here
diff --git a/lisp/loadup.el b/lisp/loadup.el
index d6cfcd6fc8..a6a7251d4b 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -324,6 +324,8 @@
       (load "term/pc-win")
       (load "ls-lisp")
       (load "disp-table"))) ; needed to setup ibm-pc char set, see internal.el
+(if (eq system-type 'darwin)
+    (load "darwin-fns"))
 (if (featurep 'ns)
     (progn
       (load "term/common-win")
diff --git a/src/sysdep.c b/src/sysdep.c
index d940acc4e0..4ea1f0050a 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -4286,8 +4286,42 @@ str_collate (Lisp_Object s1, Lisp_Object s2,
 }
 #endif	/* WINDOWSNT */
 
+#ifdef DARWIN_OS
+
+/* This function prototype is not in the platform header files.
+   See https://reverse.put.as/wp-content/uploads/2011/09/Apple-Sandbox-Guide-v1.0.pdf
+   and https://chromium.googlesource.com/chromium/src/+/master/sandbox/mac/seatbelt_sandbox_design.md */
+int sandbox_init_with_parameters(const char *profile,
+                                 uint64_t flags,
+                                 const char *const parameters[],
+                                 char **errorbuf);
+
+DEFUN ("darwin-sandbox-init", Fdarwin_sandbox_init, Sdarwin_sandbox_init,
+       1, 1, 0,
+       doc: /* Enter a sandbox whose permitted access is curtailed by PROFILE.
+Already open descriptors can be used freely.
+PROFILE is a string in the macOS sandbox profile language,
+a set of rules in a Lisp-like syntax.
+
+This is not a supported interface and is for internal use only. */)
+  (Lisp_Object profile)
+{
+  CHECK_STRING (profile);
+  if (memchr (SSDATA (profile), '\0', SBYTES (profile)))
+    error ("NUL in sandbox profile");
+  char *err = NULL;
+  if (sandbox_init_with_parameters (SSDATA (profile), 0, NULL, &err) != 0)
+    error ("sandbox error: %s", err);
+  return Qnil;
+}
+
+#endif	/* DARWIN_OS */
+
 void
 syms_of_sysdep (void)
 {
   defsubr (&Sget_internal_run_time);
+#ifdef DARWIN_OS
+  defsubr (&Sdarwin_sandbox_init);
+#endif
 }
diff --git a/test/lisp/darwin-fns-tests.el b/test/lisp/darwin-fns-tests.el
new file mode 100644
index 0000000000..1e426407a1
--- /dev/null
+++ b/test/lisp/darwin-fns-tests.el
@@ -0,0 +1,90 @@
+;;; darwin-fns-tests.el --- tests for darwin-fns.el  -*- lexical-binding: t -*-
+
+;; Copyright (C) 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/>.
+
+(require 'ert)
+
+(defun darwin-fns-tests--run-emacs (expr1 expr2)
+  "Run Emacs in batch mode and evaluate EXPR1 and EXPR2.
+Return (EXIT-STATUS . OUTPUT), where OUTPUT is stderr and stdout."
+  (let ((emacs (expand-file-name invocation-name invocation-directory))
+        (process-environment nil))
+    (with-temp-buffer
+      (let ((res (call-process emacs nil t nil
+                               "--quick" "--batch"
+                               (format "--eval=%S" expr1)
+                               (format "--eval=%S" expr2))))
+        (cons res (buffer-string))))))
+
+(ert-deftest darwin-fns-sandbox ()
+  (skip-unless (eq system-type 'darwin))
+  ;; Test file reading and writing under various sandboxing conditions.
+  (let* ((some-text "abcdef")
+         (new-text "ghijkl")
+         (test-file (file-truename (make-temp-file "test")))
+         (file-dir (file-name-directory test-file)))
+    (unwind-protect
+        (dolist (mode '(read write))
+          (ert-info ((symbol-name mode) :prefix "mode: ")
+            (dolist (sandbox '(allow-all deny-all allow-read))
+              (ert-info ((symbol-name sandbox) :prefix "sandbox: ")
+                ;; Prepare initial file contents.
+                (with-temp-buffer
+                  (insert some-text)
+                  (write-file test-file))
+
+                (let* ((sandbox-form
+                        (pcase-exhaustive sandbox
+                          ('allow-all nil)
+                          ('deny-all '(darwin-sandbox-enter nil))
+                          ('allow-read `(darwin-sandbox-enter '(,file-dir)))))
+                       (action-form
+                        (pcase-exhaustive mode
+                          ('read `(progn (find-file-literally ,test-file)
+                                         (message "OK: %s" (buffer-string))))
+                          ('write `(with-temp-buffer
+                                     (insert ,new-text)
+                                     (write-file ,test-file)))))
+                       (allowed (or (eq sandbox 'allow-all)
+                                    (and (eq sandbox 'allow-read)
+                                         (eq mode 'read))))
+                       (res-out (darwin-fns-tests--run-emacs
+                                 sandbox-form action-form))
+                       (exit-status (car res-out))
+                       (output (cdr res-out))
+                       (file-contents
+                        (with-temp-buffer
+                          (insert-file-contents-literally test-file)
+                          (buffer-string))))
+                  (if allowed
+                      (should (equal exit-status 0))
+                    (should-not (equal exit-status 0)))
+                  (when (eq mode 'read)
+                    (if allowed
+                        (should (equal output (format "OK: %s\n" some-text)))
+                      (should-not (string-search some-text output))))
+                  (should (equal file-contents
+                                 (if (and (eq mode 'write) allowed)
+                                     new-text
+                                   some-text))))))))
+
+      ;; Clean up.
+      (ignore-errors (delete-file test-file)))))
+
+
+(provide 'darwin-fns-tests)
-- 
2.21.1 (Apple Git-122.3)