Protect against segfaults in copy-keymap

* src/keymap.c (copy_keymap_1): Factor out and refuse to recurse
infinitely (bug#7496).
(Fcopy_keymap): ... from here.
(copy_keymap_item): Pass on the depth parameter.

diff --git a/src/keymap.c b/src/keymap.c
index da2786c84495501bd3bd095e0b51a4cd1c2f68a1..5aed4129bb74ceecd61905ca5dc7cb6a2d22287e 100644 (file)
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -912,8 +912,10 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
   return def;
 }
 
+static Lisp_Object copy_keymap_1 (Lisp_Object keymap, int depth);
+
 static Lisp_Object
-copy_keymap_item (Lisp_Object elt)
+copy_keymap_item (Lisp_Object elt, int depth)
 {
   Lisp_Object res, tem;
 
@@ -943,7 +945,7 @@ copy_keymap_item (Lisp_Object elt)
          elt = XCDR (elt);
          tem = XCAR (elt);
          if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
-           XSETCAR (elt, Fcopy_keymap (tem));
+           XSETCAR (elt, copy_keymap_1 (tem, depth));
          tem = XCDR (elt);
        }
     }
@@ -964,40 +966,29 @@ copy_keymap_item (Lisp_Object elt)
              tem = XCDR (elt);
            }
          if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
-           XSETCDR (elt, Fcopy_keymap (tem));
+           XSETCDR (elt, copy_keymap_1 (tem, depth));
        }
       else if (EQ (XCAR (tem), Qkeymap))
-       res = Fcopy_keymap (elt);
+       res = copy_keymap_1 (elt, depth);
     }
   return res;
 }
 
 static void
-copy_keymap_1 (Lisp_Object chartable, Lisp_Object idx, Lisp_Object elt)
+copy_keymap_set_char_table (Lisp_Object chartable, Lisp_Object idx,
+                           Lisp_Object elt)
 {
-  Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
+  Fset_char_table_range (chartable, idx, copy_keymap_item (elt, 0));
 }
 
-DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
-       doc: /* Return a copy of the keymap KEYMAP.
-
-Note that this is almost never needed.  If you want a keymap that's like
-another yet with a few changes, you should use map inheritance rather
-than copying.  I.e. something like:
-
-    (let ((map (make-sparse-keymap)))
-      (set-keymap-parent map <theirmap>)
-      (define-key map ...)
-      ...)
-
-After performing `copy-keymap', the copy starts out with the same definitions
-of KEYMAP, but changing either the copy or KEYMAP does not affect the other.
-Any key definitions that are subkeymaps are recursively copied.
-However, a key definition which is a symbol whose definition is a keymap
-is not copied.  */)
-  (Lisp_Object keymap)
+static Lisp_Object
+copy_keymap_1 (Lisp_Object keymap, int depth)
 {
   Lisp_Object copy, tail;
+
+  if (depth > 100)
+    error ("Possible infinite recursion when copying keymap");
+
   keymap = get_keymap (keymap, 1, 0);
   copy = tail = list1 (Qkeymap);
   keymap = XCDR (keymap);              /* Skip the `keymap' symbol.  */
@@ -1008,22 +999,22 @@ is not copied.  */)
       if (CHAR_TABLE_P (elt))
        {
          elt = Fcopy_sequence (elt);
-         map_char_table (copy_keymap_1, Qnil, elt, elt);
+         map_char_table (copy_keymap_set_char_table, Qnil, elt, elt);
        }
       else if (VECTORP (elt))
        {
          int i;
          elt = Fcopy_sequence (elt);
          for (i = 0; i < ASIZE (elt); i++)
-           ASET (elt, i, copy_keymap_item (AREF (elt, i)));
+           ASET (elt, i, copy_keymap_item (AREF (elt, i), depth + 1));
        }
       else if (CONSP (elt))
        {
          if (EQ (XCAR (elt), Qkeymap))
            /* This is a sub keymap.  */
-           elt = Fcopy_keymap (elt);
+           elt = copy_keymap_1 (elt, depth + 1);
          else
-           elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
+           elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt), depth + 1));
        }
       XSETCDR (tail, list1 (elt));
       tail = XCDR (tail);
@@ -1032,6 +1023,29 @@ is not copied.  */)
   XSETCDR (tail, keymap);
   return copy;
 }
+
+DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
+       doc: /* Return a copy of the keymap KEYMAP.
+
+Note that this is almost never needed.  If you want a keymap that's like
+another yet with a few changes, you should use map inheritance rather
+than copying.  I.e. something like:
+
+    (let ((map (make-sparse-keymap)))
+      (set-keymap-parent map <theirmap>)
+      (define-key map ...)
+      ...)
+
+After performing `copy-keymap', the copy starts out with the same definitions
+of KEYMAP, but changing either the copy or KEYMAP does not affect the other.
+Any key definitions that are subkeymaps are recursively copied.
+However, a key definition which is a symbol whose definition is a keymap
+is not copied.  */)
+  (Lisp_Object keymap)
+{
+  return copy_keymap_1 (keymap, 0);
+}
+
 \f
 /* Simple Keymap mutators and accessors.                               */