Make shr stop descending into the dom before `max-specpdl-size' stops us

* net/shr.el (shr-descend): Don't descend further than
`max-specpdl-size' allows (bug#16587).
(shr-depth): New variable.
(shr-warning): New variable.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 652bc537ee5cde4985741fb4c0da7ac3217df20a..12e98657af0158d25ed7da79f49fe60a3861d52a 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2014-11-13  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * net/shr.el (shr-descend): Don't descend further than
+       `max-specpdl-size' allows (bug#16587).
+       (shr-depth): New variable.
+       (shr-warning): New variable.
+
 2014-11-13  Ivan Shmakov  <ivan@siamics.net>
 
        * net/shr.el (shr-parse-base): Handle <base href=""> correctly.

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index cc90097102a8751d377d26e7bb553eb16974978d..a4b004d7c1b84d9cc9e60a0df181c8f6cfea51cc 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -137,6 +137,8 @@ cid: URL as the argument.")
 (defvar shr-table-depth 0)
 (defvar shr-stylesheet nil)
 (defvar shr-base nil)
+(defvar shr-depth 0)
+(defvar shr-warning nil)
 (defvar shr-ignore-cache nil)
 (defvar shr-external-rendering-functions nil)
 (defvar shr-target-id nil)
@@ -198,9 +200,13 @@ DOM should be a parse tree as generated by
        (shr-state nil)
        (shr-start nil)
        (shr-base nil)
+       (shr-depth 0)
+       (shr-warning nil)
        (shr-internal-width (or shr-width (1- (window-width)))))
     (shr-descend (shr-transform-dom dom))
-    (shr-remove-trailing-whitespace start (point))))
+    (shr-remove-trailing-whitespace start (point))
+    (when shr-warning
+      (message "%s" shr-warning))))
 
 (defun shr-remove-trailing-whitespace (start end)
   (let ((width (window-width)))
@@ -406,29 +412,34 @@ size, and full-buffer size."
          (intern (concat "shr-tag-" (symbol-name (car dom))) obarray)))
        (style (cdr (assq :style (cdr dom))))
        (shr-stylesheet shr-stylesheet)
+       (shr-depth (1+ shr-depth))
        (start (point)))
-    (when style
-      (if (string-match "color\\|display\\|border-collapse" style)
-         (setq shr-stylesheet (nconc (shr-parse-style style)
-                                     shr-stylesheet))
-       (setq style nil)))
-    ;; If we have a display:none, then just ignore this part of the DOM.
-    (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
-      (if (fboundp function)
-         (funcall function (cdr dom))
-       (shr-generic (cdr dom)))
-      (when (and shr-target-id
-                (equal (cdr (assq :id (cdr dom))) shr-target-id))
-       ;; If the element was empty, we don't have anything to put the
-       ;; anchor on.  So just insert a dummy character.
-       (when (= start (point))
-         (insert "*"))
-       (put-text-property start (1+ start) 'shr-target-id shr-target-id))
-      ;; If style is set, then this node has set the color.
+    ;; shr uses about 12 frames per nested node.
+    (if (> shr-depth (/ max-specpdl-size 12))
+       (setq shr-warning "Too deeply nested to render properly; consider increasing `max-specpdl-size'")
       (when style
-       (shr-colorize-region start (point)
-                            (cdr (assq 'color shr-stylesheet))
-                            (cdr (assq 'background-color shr-stylesheet)))))))
+       (if (string-match "color\\|display\\|border-collapse" style)
+           (setq shr-stylesheet (nconc (shr-parse-style style)
+                                       shr-stylesheet))
+         (setq style nil)))
+      ;; If we have a display:none, then just ignore this part of the DOM.
+      (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
+       (if (fboundp function)
+           (funcall function (cdr dom))
+         (shr-generic (cdr dom)))
+       (when (and shr-target-id
+                  (equal (cdr (assq :id (cdr dom))) shr-target-id))
+         ;; If the element was empty, we don't have anything to put the
+         ;; anchor on.  So just insert a dummy character.
+         (when (= start (point))
+           (insert "*"))
+         (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+       ;; If style is set, then this node has set the color.
+       (when style
+         (shr-colorize-region
+          start (point)
+          (cdr (assq 'color shr-stylesheet))
+          (cdr (assq 'background-color shr-stylesheet))))))))
 
 (defmacro shr-char-breakable-p (char)
   "Return non-nil if a line can be broken before and after CHAR."