From f7a192cb5c351b2daa448bf6a487581998fcff6c Mon Sep 17 00:00:00 2001
From: Lars Magne Ingebrigtsen <larsi@gnus.org>
Date: Thu, 13 Nov 2014 22:11:51 +0100
Subject: [PATCH] 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.
---
 lisp/ChangeLog  |  7 +++++++
 lisp/net/shr.el | 55 +++++++++++++++++++++++++++++--------------------
 2 files changed, 40 insertions(+), 22 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 652bc537ee5..12e98657af0 100644
--- 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 cc90097102a..a4b004d7c1b 100644
--- 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."
-- 
2.39.5