0

I am a newbie at handling MIME lists in emacs. I want to edit the mu4e-action-view-in-browser function so that before an email is displayed on a web browser all of its Microsoft Safelinks urls are filtered. I have developed an elisp function called unsafelinks to do this operation (both functions written below). Find here an edited raw email with a link for testing purposes. Here is another example of a message which cannot be decoded by a simple hook of the unsafelinks function to the gnus-article-decode-hook (as suggested by @db48x). I am currently reading the documentation on how to bypass the "=" linebreak format of this last message.

(defun mu4e-action-view-in-browser (msg)
  "Show current MSG in browser if it includes an HTML-part.
The variables `browse-url-browser-function',
`browse-url-handlers', and `browse-url-default-handlers'
determine which browser function to use."
  (with-temp-buffer
    (insert-file-contents-literally
     (mu4e-message-field msg :path) nil nil nil t)
    (run-hooks 'gnus-article-decode-hook)
    (let ((header (cl-loop for field in '("from" "to" "cc" "date" "subject")
               when (message-fetch-field field)
               concat (format "%s: %s\n" (capitalize field) it)))
      (parts (mm-dissect-buffer t t)))
      ;; If singlepart, enforce a list.
      (when (and (bufferp (car parts))
         (stringp (car (mm-handle-type parts))))
    (setq parts (list parts)))
      ;; Process the list
      (unless (gnus-article-browse-html-parts parts header)
    (mu4e-warn "Message does not contain a \"text/html\" part"))
      (mm-destroy-parts parts))))
(defun unsafelinks ()
  "This function filters MS safelinks from a message buffer"
  (interactive)
  (beginning-of-buffer)
  (let ((simple-url-regexp "https?://") urls)
    (save-excursion
      ;; edit text URLs
      (while (search-forward-regexp simple-url-regexp nil t)
    (when-let ((url (thing-at-point 'url))
           (bounds (thing-at-point-bounds-of-url-at-point)))
      (delete-region (car bounds) (cdr bounds))
      (insert (my-decode-safelink url)))))))

(require 'url-parse)
(defun my-decode-safelink (url)
  ;; (print url)
  "Given a url string this function returns the corresponding decoded url"
  (if (string-match-p (regexp-quote "safelinks.protection") url)
      (let* ((query (url-filename (url-generic-parse-url url)))
             (url (cadr (assoc ".*/?url" (url-parse-query-string query) (lambda (pat x) (string-match-p x pat)))))
             (path (replace-regexp-in-string "3Dhttps" "https" (url-unhex-string url))))
        (url-encode-url (replace-regexp-in-string (rx "/" (>= 20 (any "#$%&*^@"))) "" path)))
    url))

2 Answers 2

1

I don’t think you need to edit this function at all. It calls the hook functions stored in gnus-article-decode-hook. You could add unsafelinks to that list with (add-hook 'gnus-article-decode-hook 'unsafelinks).

8
  • Thanks. It is not working yet. Shouldn't the function be placed at the end of the hook list to ensure that it will be the last operation run?
    – Ajned
    Oct 16, 2021 at 8:37
  • If you want. add-hook has an option for that.
    – db48x
    Oct 16, 2021 at 8:40
  • Indeed, (add-hook 'gnus-article-decode-hook 'unsafelinks t) does it, but it still does not work, i.e., the links in the browser are not filtered. It would be really great to have such a simple one-line solution.
    – Ajned
    Oct 16, 2021 at 8:47
  • I assume that unsafelinks works if you just call it on a buffer containing the message? You can call it with M-: (unsafelinks).
    – db48x
    Oct 16, 2021 at 8:55
  • Correct, that is how it works and it simply searches and replaces for any MS urls in the current buffer. It might have to be changed slightly to account for the fact that this is a gnus article MIME message?
    – Ajned
    Oct 16, 2021 at 9:03
0

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 redefined 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))
3
  • I strongly recommend against redefining any function. Use the provided hooks, or use advice. Redefining the function will only create a maintenance burden for you, as every upgrade will likely break your code. Also, this particular function is really written very badly. It desperately needs to be broken up into multiple much smaller functions that each do just one thing. Don’t make the problem worse!
    – db48x
    Oct 16, 2021 at 12:21
  • Indeed, this is a bad habit of mine as an elisp newbie :-). I probably need to rewrite the unsafelinks function and then add it to the appropriate hooks. Thanks.
    – Ajned
    Oct 17, 2021 at 5:14
  • The one thing you have definitely done correctly is to jump into the source code to figure out how it works. Most people ask questions before they even try doing that. (the old story: “I’ve tried nothing and it still doesn’t work!”)
    – db48x
    Oct 17, 2021 at 5:35

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.