From 40ae02ff50a8f05660a7f9f234320875b6358c9d Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Wed, 30 Oct 2019 14:17:40 -0700
Subject: [PATCH] Fix fileio.c infloops on circular lists

Fix infinite loops in fileio.c when a circular list is the
value of after_insert_file_functions,
buffer-auto-save-file-format, buffer-file-format, or
write-region-annotate-functions.
* src/fileio.c (Finsert_file_contents, build_annotations):
Use FOR_EACH_TAIL to avoid infloop on circular lists.
(build_annotations): Use an EMACS_INT, not an int, to count
nesting level.
* test/src/fileio-tests.el:
(fileio-tests--circular-after-insert-file-functions): New test.
---
 src/fileio.c             | 17 +++++++----------
 test/src/fileio-tests.el |  9 +++++++++
 2 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/src/fileio.c b/src/fileio.c
index f1860e8a930..a3121a26dad 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -4742,7 +4742,7 @@ by calling `format-decode', which see.  */)
       /* For consistency with format-decode call these now iff inserted > 0
 	 (martin 2007-06-28).  */
       p = Vafter_insert_file_functions;
-      while (CONSP (p))
+      FOR_EACH_TAIL (p)
 	{
 	  if (NILP (replace))
 	    {
@@ -4782,9 +4782,6 @@ by calling `format-decode', which see.  */)
 		    inserted = XFIXNAT (insval);
 		}
 	    }
-
-	  maybe_quit ();
-	  p = XCDR (p);
 	}
 
       if (!empty_undo_list_p)
@@ -5375,14 +5372,14 @@ build_annotations (Lisp_Object start, Lisp_Object end)
   Lisp_Object annotations;
   Lisp_Object p, res;
   Lisp_Object original_buffer;
-  int i;
   bool used_global = false;
 
   XSETBUFFER (original_buffer, current_buffer);
 
   annotations = Qnil;
   p = Vwrite_region_annotate_functions;
-  while (CONSP (p))
+ loop_over_p:
+  FOR_EACH_TAIL (p)
     {
       struct buffer *given_buffer = current_buffer;
       if (EQ (Qt, XCAR (p)) && !used_global)
@@ -5391,7 +5388,7 @@ build_annotations (Lisp_Object start, Lisp_Object end)
 	  p = CALLN (Fappend,
 		     Fdefault_value (Qwrite_region_annotate_functions),
 		     XCDR (p));
-	  continue;
+	  goto loop_over_p;
 	}
       Vwrite_region_annotations_so_far = annotations;
       res = call2 (XCAR (p), start, end);
@@ -5411,7 +5408,6 @@ build_annotations (Lisp_Object start, Lisp_Object end)
 	}
       Flength (res);   /* Check basic validity of return value */
       annotations = merge (annotations, res, Qcar_less_than_car);
-      p = XCDR (p);
     }
 
   /* Now do the same for annotation functions implied by the file-format */
@@ -5419,7 +5415,8 @@ build_annotations (Lisp_Object start, Lisp_Object end)
     p = BVAR (current_buffer, auto_save_file_format);
   else
     p = BVAR (current_buffer, file_format);
-  for (i = 0; CONSP (p); p = XCDR (p), ++i)
+  EMACS_INT i = 0;
+  FOR_EACH_TAIL (p)
     {
       struct buffer *given_buffer = current_buffer;
 
@@ -5429,7 +5426,7 @@ build_annotations (Lisp_Object start, Lisp_Object end)
          has written annotations to a temporary buffer, which is now
          current.  */
       res = call5 (Qformat_annotate_function, XCAR (p), start, end,
-		   original_buffer, make_fixnum (i));
+		   original_buffer, make_fixnum (i++));
       if (current_buffer != given_buffer)
 	{
 	  XSETFASTINT (start, BEGV);
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 98d3d6be763..2225897af8c 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -147,3 +147,12 @@ Also check that an encoding error can appear in a symlink."
       (should (file-name-absolute-p (concat "~" user-login-name suffix))))
     (unless (user-full-name "nosuchuser")
       (should (not (file-name-absolute-p (concat "~nosuchuser" suffix)))))))
+
+(ert-deftest fileio-tests--circular-after-insert-file-functions ()
+  "Test after-insert-file-functions as a circular list."
+  (let ((f (make-temp-file "fileio"))
+        (after-insert-file-functions (list 'identity)))
+    (setcdr after-insert-file-functions after-insert-file-functions)
+    (write-region "hello\n" nil f nil 'silent)
+    (should-error (insert-file-contents f) :type 'circular-list)
+    (delete-file f)))
-- 
2.39.5