]> git.eshelyaron.com Git - emacs.git/commitdiff
Don’t double-encode non-ASCII for mail client
authorPaul Eggert <eggert@cs.ucla.edu>
Mon, 14 Sep 2015 16:31:23 +0000 (09:31 -0700)
committerPaul Eggert <eggert@cs.ucla.edu>
Mon, 14 Sep 2015 16:33:02 +0000 (09:33 -0700)
* 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.

doc/misc/url.texi
lisp/mail/mailclient.el

index d94b19f77b60c346dcaa436f795af1911366c478..95fe5eabc33f1cbf92ec2fdd475602e397f56356 100644 (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}]]}
index 31da6ee2eb320ee8f0f401f88226d7d98ecc1cce..bef20380b33560c5ab28917149e52c59fd6950f9 100644 (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)