master 9a431e431ad: (Fcall_interactively): Fix use-after-free bug#81110

branch: master
commit 9a431e431ad92f94f4290c3f0bf043b0f97a7b56
Author: Stefan Monnier <[email protected]>
Commit: Stefan Monnier <[email protected]>

    (Fcall_interactively): Fix use-after-free bug#81110
    
    * src/callint.c (Fcall_interactively): Don't use alloca'd vars after we
    `unbind_to` and don't bind `current-minibuffer-command`.
    * src/minibuf.c (read_minibuf): Bind `current-minibuffer-command` here.
    * test/src/callint-tests.el (test-many-interactive-args):
    New test (authored by Pip Cet <[email protected]>).
---
 src/callint.c             | 18 ++++++++----------
 src/minibuf.c             |  4 ++++
 test/src/callint-tests.el |  9 +++++++++
 3 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/src/callint.c b/src/callint.c
index 1746dd57704..dd7e546df99 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -272,22 +272,17 @@ invoke it (via an `interactive' spec that contains, for instance, an
 `this-command-keys-vector' is used.  */)
   (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
 {
-  specpdl_ref speccount = SPECPDL_INDEX ();
-
   bool arg_from_tty = false;
   ptrdiff_t key_count;
   bool record_then_fail = false;
 
+  /* FIXME: We should probably specbind these vars in recursive
+     _edit instead so they're automatically saved&restored as needed.  */
   Lisp_Object save_this_command = Vthis_command;
   Lisp_Object save_this_original_command = Vthis_original_command;
   Lisp_Object save_real_this_command = Vreal_this_command;
   Lisp_Object save_last_command = KVAR (current_kboard, Vlast_command);
 
-  /* Bound recursively so that code can check the current command from
-     code running from minibuffer hooks (and the like), without being
-     overwritten by subsequent minibuffer calls.  */
-  specbind (Qcurrent_minibuffer_command, Vthis_command);
-
   if (NILP (keys))
     keys = this_command_keys, key_count = this_command_key_count;
   else
@@ -342,8 +337,7 @@ invoke it (via an `interactive' spec that contains, for instance, an
       Vreal_this_command = save_real_this_command;
       kset_last_command (current_kboard, save_last_command);
 
-      return unbind_to (speccount, CALLN (Fapply, Qfuncall_interactively,
-					  function, specs));
+      return CALLN (Fapply, Qfuncall_interactively, function, specs);
     }
 
   /* SPECS is set to a string; use it as an interactive prompt.
@@ -448,6 +442,8 @@ invoke it (via an `interactive' spec that contains, for instance, an
 
   memclear (args, nargs * (2 * word_size + 1));
 
+  specpdl_ref speccount = SPECPDL_INDEX ();
+
   if (!NILP (enable))
     specbind (Qenable_recursive_minibuffers, Qt);
 
@@ -801,7 +797,9 @@ invoke it (via an `interactive' spec that contains, for instance, an
   specbind (Qcommand_debug_status, Qnil);
 
   Lisp_Object val = Ffuncall (nargs, args);
-  return SAFE_FREE_UNBIND_TO (speccount, val);
+  unbind_to (speccount, Qnil);
+  SAFE_FREE ();
+  return val;
 }
 
 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
diff --git a/src/minibuf.c b/src/minibuf.c
index 8f0297adf0b..c03ac7ac098 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -590,6 +590,10 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
 
   specbind (Qminibuffer_default, defalt);
   specbind (Qinhibit_read_only, Qnil);
+  /* Bound recursively so that code can check the current command from
+     code running from minibuffer hooks (and the like), without being
+     overwritten by subsequent minibuffer calls.  */
+  specbind (Qcurrent_minibuffer_command, Vthis_command);
 
   /* If Vminibuffer_completing_file_name is `lambda' on entry, it was t
      in previous recursive minibuffer, but was not set explicitly
diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el
index a09fb40b3f8..91890500344 100644
--- a/test/src/callint-tests.el
+++ b/test/src/callint-tests.el
@@ -65,4 +65,13 @@
     (should (= (call-interactively 'callint-test-int-args t) 3))
     (should (equal command-history '((callint-test-int-args 1 10 11))))))
 
+(ert-deftest test-many-interactive-args ()
+  "Test that `'call-interactively' does not crash due to bug#81110"
+  (dotimes (_ 10)
+    (let ((str (apply #'concat (make-list 4096 "pp\n"))))
+      (call-interactively (eval `(lambda (&rest args)
+                                   (interactive ,str)
+                                   (length args))
+                                t)))))
+
 ;;; callint-tests.el ends here