From b7dab24b7953f7a31b806f83e15043c94aaa7745 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 4 Jul 2017 22:50:46 +0200 Subject: [PATCH] Module assertions: check for garbage collections 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 7b1a402eeff..b80aa23abce 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 eee9466c5d6..42e1c2bd4ae 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 a4994b6223b..988a7a178c6 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -182,37 +182,66 @@ changes." (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.39.2