[PATCH] Module assertions: check for garbage collections

[PATCH] Module assertions: check for garbage collections

[Philipp Stephani]

It's technically possible to write a user pointer finalizer that calls
into Emacs module functions.  This would be disastrous because it
would allow arbitrary Lisp code to run during garbage collection.
Therefore extend the module assertions to check for this case.

* src/emacs-module.c (module_assert_thread): Also check whether a
garbage collection is in progress.

* test/data/emacs-module/mod-test.c (invalid_finalizer)
(Fmod_test_invalid_finalizer): New test module functions.
(emacs_module_init): Register new test function.

* test/src/emacs-module-tests.el (module--test-assertion)
(module--with-temp-directory): New helper macros.
(module--test-assertions--load-non-live-object): Rename existing
unit test, use helper macros.
(module--test-assertions--call-emacs-from-gc): New unit test.
---
 src/emacs-module.c                |  6 ++-
 test/data/emacs-module/mod-test.c | 23 +++++++++++
 test/src/emacs-module-tests.el    | 87 ++++++++++++++++++++++++++-------------
 3 files changed, 85 insertions(+), 31 deletions(-)

diff --git a/src/emacs-module.c b/src/emacs-module.c
index 7b1a402eef..b80aa23abc 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -817,9 +817,11 @@ in_current_thread (void)
 static void
 module_assert_thread (void)
 {
-  if (! module_assertions || in_current_thread ())
+  if (! module_assertions || (in_current_thread () && ! gc_in_progress))
     return;
-  module_abort ("Module function called from outside the current Lisp thread");
+  module_abort (gc_in_progress ?
+                "Module function called during garbage collection" :
+                "Module function called from outside the current Lisp thread");
 }
 
 static void
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index eee9466c5d..42e1c2bd4a 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -235,6 +235,27 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
   return invalid_stored_value;
 }
 
+/* An invalid finalizer: Finalizers are run during garbage collection,
+   where Lisp code can’t be executed.  -module-assertions tests for
+   this case.  */
+
+static emacs_env *current_env;
+
+static void
+invalid_finalizer (void *ptr)
+{
+  current_env->intern (current_env, "nil");
+}
+
+static emacs_value
+Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+                             void *data)
+{
+  current_env = env;
+  env->make_user_ptr (env, invalid_finalizer, NULL);
+  return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL);
+}
+
 
 /* Lisp utilities for easier readability (simple wrappers).  */
 
@@ -300,6 +321,8 @@ emacs_module_init (struct emacs_runtime *ert)
   DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
   DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL);
   DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL);
+  DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0,
+         NULL, NULL);
 
 #undef DEFUN
 
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index a4994b6223..988a7a178c 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -182,37 +182,66 @@ multiply-string
   (should (equal (help-function-arglist #'mod-test-sum)
                  '(arg1 arg2))))
 
-(ert-deftest module--test-assertions ()
-  "Check that -module-assertions work."
+(defmacro module--with-temp-directory (name &rest body)
+  "Bind NAME to the name of a temporary directory and evaluate BODY.
+NAME must be a symbol.  Delete the temporary directory after BODY
+exits normally or non-locally.  NAME will be bound to the
+directory name (not the directory file name) of the temporary
+directory."
+  (declare (indent 1))
+  (cl-check-type name symbol)
+  `(let ((,name (file-name-as-directory
+                 (make-temp-file "emacs-module-test" :directory))))
+     (unwind-protect
+         (progn ,@body)
+       (delete-directory ,name :recursive))))
+
+(defmacro module--test-assertion (pattern &rest body)
+  "Test that PATTERN matches the assertion triggered by BODY.
+Run Emacs as a subprocess, load the test module `mod-test-file',
+and evaluate BODY.  Verify that Emacs aborts and prints a module
+assertion message that matches PATTERN.  PATTERN is evaluated and
+must evaluate to a regular expression string."
+  (declare (indent 1))
+  ;; To contain any core dumps.
+  `(module--with-temp-directory tempdir
+     (with-temp-buffer
+       (let* ((default-directory tempdir)
+              (status (call-process mod-test-emacs nil t nil
+                                    "-batch" "-Q" "-module-assertions" "-eval"
+                                    ,(prin1-to-string
+                                      `(progn
+                                         (require 'mod-test ,mod-test-file)
+                                         ,@body)))))
+         (should (stringp status))
+         ;; eg "Aborted" or "Abort trap: 6"
+         (should (string-prefix-p "Abort" status))
+         (search-backward "Emacs module assertion: ")
+         (goto-char (match-end 0))
+         (should (string-match-p ,pattern
+                                 (buffer-substring-no-properties
+                                  (point) (point-max))))))))
+
+(ert-deftest module--test-assertions--load-non-live-object ()
+  "Check that -module-assertions verify that non-live objects
+aren’t accessed."
   (skip-unless (file-executable-p mod-test-emacs))
   ;; This doesn’t yet cause undefined behavior.
   (should (eq (mod-test-invalid-store) 123))
-  ;; To contain any core dumps.
-  (let ((tempdir (make-temp-file "emacs-module-test" t)))
-    (unwind-protect
-        (with-temp-buffer
-          (should (string-match-p
-                   "Abort" ; eg "Aborted" or "Abort trap: 6"
-                   (let ((default-directory tempdir))
-                     (call-process mod-test-emacs nil t nil
-                                   "-batch" "-Q" "-module-assertions" "-eval"
-                                   (prin1-to-string
-                                    `(progn
-                                       (require 'mod-test ,mod-test-file)
-                                       ;; Storing and reloading a local
-                                       ;; value causes undefined behavior,
-                                       ;; which should be detected by the
-                                       ;; module assertions.
-                                       (mod-test-invalid-store)
-                                       (mod-test-invalid-load)))))))
-          (search-backward "Emacs module assertion:")
-          (should (string-match-p (rx bos "Emacs module assertion: "
-                                      "Emacs value not found in "
-                                      (+ digit) " values of "
-                                      (+ digit) " environments" eos)
-                                  (buffer-substring-no-properties
-                                   (line-beginning-position)
-                                   (line-end-position)))))
-      (delete-directory tempdir t))))
+  (module--test-assertion (rx "Emacs value not found in "
+                              (+ digit) " values of "
+                              (+ digit) " environments\n" eos)
+    ;; Storing and reloading a local value causes undefined behavior,
+    ;; which should be detected by the module assertions.
+    (mod-test-invalid-store)
+    (mod-test-invalid-load)))
+
+(ert-deftest module--test-assertions--call-emacs-from-gc ()
+  "Check that -module-assertions prevents calling Emacs functions
+during garbage collection."
+  (skip-unless (file-executable-p mod-test-emacs))
+  (module--test-assertion
+      (rx "Module function called during garbage collection\n" eos)
+    (mod-test-invalid-finalizer)))
 
 ;;; emacs-module-tests.el ends here
-- 
2.13.2

Re: [PATCH] Module assertions: check for garbage collections

[Philipp Stephani]

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

Philipp Stephani <p.stephani2@gmail.com> schrieb am Di., 4. Juli 2017 um
22:55 Uhr:

> It's technically possible to write a user pointer finalizer that calls
> into Emacs module functions.  This would be disastrous because it
> would allow arbitrary Lisp code to run during garbage collection.
> Therefore extend the module assertions to check for this case.


Pushed as b7dab24b79.

[-- Attachment #2: Type: text/html, Size: 681 bytes --]