Skip to main content
1 of 2
Ajned
  • 794
  • 4
  • 22

This is a long and ugly solution which does work. Instead of messing around with mu4e-action-view-in-browser the unsafelinks function can be inserted into gnus-article-browse-html-parts and redefine it like so

(defun gnus-article-browse-html-parts (list &optional header)
  "View all \"text/html\" parts from LIST.
Recurse into multiparts.  The optional HEADER that should be a decoded
message header will be added to the bodies of the \"text/html\" parts."
  ;; Internal function used by `gnus-article-browse-html-article'.
  (let (type file charset content cid-dir tmp-file showed)
    ;; Find and show the html-parts.
    (dolist (handle list)
      ;; If HTML, show it:
      (cond ((not (listp handle)))
        ((or (equal (car (setq type (mm-handle-type handle))) "text/html")
         (and (equal (car type) "message/external-body")
              (or header
              (setq file (mm-handle-filename handle)))
              (or (mm-handle-cache handle)
              (condition-case code
                  (progn (mm-extern-cache-contents handle) t)
                (error
                 (gnus-message 3 "%s" (error-message-string code))
                 (when (>= gnus-verbose 3) (sit-for 2))
                 nil)))
              (progn
            (setq handle (mm-handle-cache handle)
                  type (mm-handle-type handle))
            (equal (car type) "text/html"))))
         (setq charset (mail-content-type-get type 'charset)
           content (mm-get-part handle))
         (with-temp-buffer
           (if (eq charset 'gnus-decoded)
           (mm-enable-multibyte)
         (mm-disable-multibyte))
           (insert content)
           (unsafelinks)        ; <<<<insert this
           ;; resolve cid contents
           (let ((case-fold-search t)
             st base regexp cid-file)
         (goto-char (point-min))
         (when (and (re-search-forward "<head[\t\n >]" nil t)
                (progn
                  (setq st (match-end 0))
                  (re-search-forward "</head[\t\n >]" nil t))
                (re-search-backward "<base\
\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*>" st t))
           (setq base (match-string 1))
           (replace-match "<!--\\&-->")
           (setq st (point))
           (dolist (tag '(("a" . "href") ("form" . "action")
                  ("img" . "src")))
             (setq regexp (concat "<" (car tag)
                      "\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+"
                      (cdr tag) "=\"\\([^\"]+\\)"))
             (while (re-search-forward regexp nil t)
               (insert (prog1
                   (condition-case nil
                       (save-match-data
                     (url-expand-file-name (match-string 1)
                                   base))
                     (error (match-string 1)))
                 (delete-region (match-beginning 1)
                        (match-end 1)))))
             (goto-char st)))
         (while (re-search-forward "\
<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
                       nil t)
           (unless cid-dir
             (setq cid-dir (make-temp-file "cid" t))
             (add-to-list 'gnus-article-browse-html-temp-list cid-dir))
           (setq file nil
             content nil)
           (when (setq cid-file
                   (gnus-article-browse-html-save-cid-content
                (match-string 2)
                (with-current-buffer gnus-article-buffer
                  gnus-article-mime-handles)
                cid-dir))
             (replace-match cid-file nil nil nil 1))))
           (unless content (setq content (buffer-string))))
         (when (or charset header (not file))
           (setq tmp-file (make-temp-file
                   ;; Do we need to care for 8.3 filenames?
                   "mm-" nil ".html")))
         ;; Add a meta html tag to specify charset and a header.
         (cond
          (header
           (let (title eheader body hcharset coding)
         (with-temp-buffer
           (mm-enable-multibyte)
           (setq case-fold-search t)
           (insert header "\n")
           (setq title (message-fetch-field "subject"))
           (unsafelinks)        ; <<<<insert this
           (goto-char (point-min))
           (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|\\(&\\)\\|\n"
                         nil t)
             (replace-match (cond ((match-beginning 1) "&lt;")
                      ((match-beginning 2) "&gt;")
                      ((match-beginning 3) "&amp;")
                      (t "<br>\n"))))
           (goto-char (point-min))
           (while (re-search-forward "^[\t ]+" nil t)
             (dotimes (i (prog1
                     (current-column)
                   (delete-region (match-beginning 0)
                          (match-end 0))))
               (insert "&nbsp;")))
           (goto-char (point-min))
           (insert "<div align=\"left\">\n")
           (goto-char (point-max))
           (insert "</div>\n<hr>\n")
           ;; We have to examine charset one by one since
           ;; charset specified in parts might be different.
           (if (eq charset 'gnus-decoded)
               (setq charset 'utf-8
                 eheader (encode-coding-string (buffer-string)
                               charset)
                 title (when title
                     (encode-coding-string title charset))
                 body (encode-coding-string content charset))
             (setq hcharset (mm-find-mime-charset-region (point-min)
                                 (point-max)))
             (cond ((= (length hcharset) 1)
                (setq hcharset (car hcharset)
                  coding (mm-charset-to-coding-system
                      hcharset nil t)))
               ((> (length hcharset) 1)
                (setq hcharset 'utf-8
                  coding hcharset)))
             (if coding
             (if charset
                 (progn
                   (setq body
                     (mm-charset-to-coding-system charset
                                  nil t))
                   (if (eq coding body)
                   (setq eheader (encode-coding-string
                          (buffer-string) coding)
                     title (when title
                         (encode-coding-string
                          title coding))
                     body content)
                 (setq charset 'utf-8
                       eheader (encode-coding-string
                        (buffer-string) charset)
                       title (when title
                           (encode-coding-string
                        title charset))
                       body (encode-coding-string
                         (decode-coding-string
                          content body)
                         charset))))
               (setq charset hcharset
                 eheader (encode-coding-string
                      (buffer-string) coding)
                 title (when title
                     (encode-coding-string
                      title coding))
                 body content))
               (setq eheader (encode-coding-string
                      (buffer-string) 'utf-8)
                 body content)))
           (erase-buffer)
           (mm-disable-multibyte)
           (insert body)
           (unsafelinks)        ; <<<<insert this
           (when charset
             (mm-add-meta-html-tag handle charset t))
           (when title
             (goto-char (point-min))
             (unless (search-forward "<title>" nil t)
               (re-search-forward "<head>\\s-*" nil t)
               (insert "<title>" title "</title>\n")))
           (goto-char (point-min))
           (or (re-search-forward
            "<body\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)
               (re-search-forward
            "</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t))
           (insert eheader)
           (mm-write-region (point-min) (point-max)
                    tmp-file nil nil nil 'binary t))))
          (charset
           (mm-with-unibyte-buffer
         (insert (if (eq charset 'gnus-decoded)
                 (encode-coding-string content
                           (setq charset 'utf-8))
               content))
         (if (or (mm-add-meta-html-tag handle charset)
             (not file))
             (mm-write-region (point-min) (point-max)
                      tmp-file nil nil nil 'binary t)
           (setq tmp-file nil))))
          (tmp-file
           (mm-save-part-to-file handle tmp-file)))
         (when tmp-file
           (add-to-list 'gnus-article-browse-html-temp-list tmp-file))
         (add-hook 'gnus-summary-prepare-exit-hook
               'gnus-article-browse-delete-temp-files)
         (add-hook 'gnus-exit-gnus-hook
               (lambda  ()
             (gnus-article-browse-delete-temp-files t)))
         ;; FIXME: Warn if there's an <img> tag?
         (browse-url-of-file (or tmp-file (expand-file-name file)))
         (setq showed t))
        ;; If multipart, recurse
        ((equal (mm-handle-media-supertype handle) "multipart")
         (when (gnus-article-browse-html-parts handle header)
           (setq showed t)))
        ((equal (mm-handle-media-type handle) "message/rfc822")
         (mm-with-multibyte-buffer
           (mm-insert-part handle)
           (setq handle (mm-dissect-buffer t t))
           (when (and (bufferp (car handle))
              (stringp (car (mm-handle-type handle))))
         (setq handle (list handle)))
           (when header
         (article-decode-encoded-words)
         (let ((gnus-visible-headers
            (or (get 'gnus-visible-headers 'standard-value)
                gnus-visible-headers)))
           (article-hide-headers))
         (goto-char (point-min))
         (search-forward "\n\n" nil 'move)
         (skip-chars-backward "\t\n ")
         (setq header (buffer-substring (point-min) (point)))))
         (when (prog1
               (gnus-article-browse-html-parts handle header)
             (mm-destroy-parts handle))
           (setq showed t)))))
    showed))
Ajned
  • 794
  • 4
  • 22