Commit 1ee47d47 authored by Paul Eggert's avatar Paul Eggert
Browse files

Don’t double-encode non-ASCII for mail client

* lisp/mail/mailclient.el (mailclient-encode-string-as-url):
Use RFC 6068’s list of unreserved characters.
(mailclient-send-it): When encoding the body as a URL,
first decode it as per Content-Type: and Content-Transfer-Encoding:,
as URLs must use percent-encoded UTF-8 (Bug#21471).

* doc/misc/url.texi (mailto): Update RFC number.
parent 560022a5
...@@ -593,7 +593,7 @@ sending a message to @samp{foo@@bar.com}. The ``retrieval method'' ...@@ -593,7 +593,7 @@ sending a message to @samp{foo@@bar.com}. The ``retrieval method''
for such URLs is to open a mail composition buffer in which the for such URLs is to open a mail composition buffer in which the
appropriate content (e.g., the recipient address) has been filled in. appropriate content (e.g., the recipient address) has been filled in.
As defined in RFC 2368, a @code{mailto} URL has the form As defined in RFC 6068, a @code{mailto} URL can have the form
@example @example
@samp{mailto:@var{mailbox}[?@var{header}=@var{contents}[&@var{header}=@var{contents}]]} @samp{mailto:@var{mailbox}[?@var{header}=@var{contents}[&@var{header}=@var{contents}]]}
......
...@@ -62,10 +62,9 @@ supported. Defaults to non-nil on Windows, nil otherwise." ...@@ -62,10 +62,9 @@ supported. Defaults to non-nil on Windows, nil otherwise."
(mapcar (mapcar
(lambda (char) (lambda (char)
(cond (cond
((eq char ?\x20) "%20") ;; space
((eq char ?\n) "%0D%0A") ;; newline ((eq char ?\n) "%0D%0A") ;; newline
((string-match "[-a-zA-Z0-9_:/.@]" (char-to-string char)) ((string-match "[-a-zA-Z0-9._~]" (char-to-string char))
(char-to-string char)) ;; printable (char-to-string char)) ;; unreserved as per RFC 6068
(t ;; everything else (t ;; everything else
(format "%%%02x" char)))) ;; escape (format "%%%02x" char)))) ;; escape
;; Convert string to list of chars ;; Convert string to list of chars
...@@ -125,6 +124,13 @@ The mail client is taken to be the handler of mailto URLs." ...@@ -125,6 +124,13 @@ The mail client is taken to be the handler of mailto URLs."
(< (point) delimline)) (< (point) delimline))
(replace-match "\n")) (replace-match "\n"))
(let ((case-fold-search t) (let ((case-fold-search t)
(mime-charset-pattern
(concat
"^content-type:[ \t]*text/plain;"
"\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
"[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"))
coding-system
character-coding
;; Use the external browser function to send the ;; Use the external browser function to send the
;; message. ;; message.
(browse-url-mailto-function nil)) (browse-url-mailto-function nil))
...@@ -135,6 +141,15 @@ The mail client is taken to be the handler of mailto URLs." ...@@ -135,6 +141,15 @@ The mail client is taken to be the handler of mailto URLs."
(concat (concat
(save-excursion (save-excursion
(narrow-to-region (point-min) delimline) (narrow-to-region (point-min) delimline)
(goto-char (point-min))
(setq coding-system
(if (re-search-forward mime-charset-pattern nil t)
(coding-system-from-name (match-string 1))
'undecided))
(setq character-coding
(mail-fetch-field "content-transfer-encoding"))
(when character-coding
(setq character-coding (downcase character-coding)))
(concat (concat
"mailto:" "mailto:"
;; some of the headers according to RFC822 ;; some of the headers according to RFC822
...@@ -171,7 +186,26 @@ The mail client is taken to be the handler of mailto URLs." ...@@ -171,7 +186,26 @@ The mail client is taken to be the handler of mailto URLs."
"*** E-Mail body has been placed on clipboard, " "*** E-Mail body has been placed on clipboard, "
"please paste it here! ***")) "please paste it here! ***"))
;; else ;; else
(buffer-substring (+ 1 delimline) (point-max)))))))))))) (let ((body (buffer-substring (+ 1 delimline) (point-max))))
(if (null character-coding)
body
;; mailto: requires UTF-8 and cannot deal with
;; Content-Transfer-Encoding or Content-Type.
;; FIXME: There is a lot of code duplication here
;; with rmail.el.
(erase-buffer)
(set-buffer-multibyte nil)
(insert body)
(cond
((string= character-coding "quoted-printable")
(mail-unquote-printable-region (point-min) (point-max)
nil nil 'unibyte))
((string= character-coding "base64")
(base64-decode-region (point-min) (point-max)))
(t (error "unsupported Content-Transfer-Encoding: %s"
character-coding)))
(decode-coding-region (point-min) (point-max)
coding-system t)))))))))))))
(provide 'mailclient) (provide 'mailclient)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment