mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-13 16:38:14 +00:00
Code Issues Releases Activity

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

Browse Source 
* 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.
This commit is contained in:
Paul Eggert 2015-09-14 09:31:23 -07:00
parent 560022a5b6
commit 1ee47d477d
2 changed files with 39 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
doc/misc/url.texi
View File

@ -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
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
@samp{mailto:@var{mailbox}[?@var{header}=@var{contents}[&@var{header}=@var{contents}]]}

42
lisp/mail/mailclient.el
View File

@ -62,10 +62,9 @@ supported. Defaults to non-nil on Windows, nil otherwise."
(mapcar
(lambda (char)
(cond
((eq char ?\x20) "%20") ;; space
((eq char ?\n) "%0D%0A") ;; newline
((string-match "[-a-zA-Z0-9_:/.@]" (char-to-string char))
(char-to-string char)) ;; printable
((string-match "[-a-zA-Z0-9._~]" (char-to-string char))
(char-to-string char)) ;; unreserved as per RFC 6068
(t ;; everything else
(format "%%%02x" char)))) ;; escape
;; Convert string to list of chars
@ -125,6 +124,13 @@ The mail client is taken to be the handler of mailto URLs."
(< (point) delimline))
(replace-match "\n"))
(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
;; message.
(browse-url-mailto-function nil))
@ -135,6 +141,15 @@ The mail client is taken to be the handler of mailto URLs."
(concat
(save-excursion
(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
"mailto:"
;; some of the headers according to RFC822
@ -171,7 +186,26 @@ The mail client is taken to be the handler of mailto URLs."
"*** E-Mail body has been placed on clipboard, "
"please paste it here! ***"))
;; 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)