Make shr respect privacy when viewing documents with SVG images

(shr-tag-svg): Respect `shr-inhibit-images'.
(shr-dom-to-xml): Respect `shr-blocked-images'.

Fixes: debbugs:15882

2 files changed, 13 insertions, 3 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9b7e338e187..f17cbb7441f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -2,6 +2,8 @@
 
         * net/shr.el (shr-generic): Make into a defsubst to make the stack
         depth shallower (bug#16587).
+        (shr-tag-svg): Respect `shr-inhibit-images'.
+        (shr-dom-to-xml): Respect `shr-blocked-images' (bug#15882).
 
 2014-01-31  Dmitry Gutov  <dgutov@yandex.ru>
 
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index dba0f71bfe1..f23faaa3437 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -972,11 +972,18 @@ ones, in case fg and bg are nil."
 (defun shr-dom-to-xml (dom)
   "Convert DOM into a string containing the xml representation."
   (let ((arg " ")
-        (text ""))
+        (text "")
+        url)
     (dolist (sub (cdr dom))
       (cond
        ((listp (cdr sub))
-        (setq text (concat text (shr-dom-to-xml sub))))
+        ;; Ignore external image definitions if required.
+        ;; <image xlink:href="http://TRACKING_URL/"/>
+        (when (or (not (eq (car sub) 'image))
+                  (not (setq url (cdr (assq ':xlink:href (cdr sub)))))
+                  (not shr-blocked-images)
+                  (not (string-match shr-blocked-images url)))
+          (setq text (concat text (shr-dom-to-xml sub)))))
        ((eq (car sub) 'text)
         (setq text (concat text (cdr sub))))
        (t
@@ -990,7 +997,8 @@ ones, in case fg and bg are nil."
             (car dom))))
 
 (defun shr-tag-svg (cont)
-  (when (image-type-available-p 'svg)
+  (when (and (image-type-available-p 'svg)
+             (not shr-inhibit-images))
     (funcall shr-put-image-function
              (shr-dom-to-xml (cons 'svg cont))
              "SVG Image")))