1;;; mm-encode.el --- Functions for encoding MIME things 2 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 7;; MORIOKA Tomohiko <morioka@jaist.ac.jp> 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25;;; Commentary: 26 27;;; Code: 28 29(eval-when-compile (require 'cl)) 30(require 'mail-parse) 31(require 'mailcap) 32(eval-and-compile 33 (autoload 'mm-body-7-or-8 "mm-bodies") 34 (autoload 'mm-long-lines-p "mm-bodies")) 35 36(defcustom mm-content-transfer-encoding-defaults 37 '(("text/x-patch" 8bit) 38 ("text/.*" qp-or-base64) 39 ("message/rfc822" 8bit) 40 ("application/emacs-lisp" qp-or-base64) 41 ("application/x-emacs-lisp" qp-or-base64) 42 ("application/x-patch" qp-or-base64) 43 (".*" base64)) 44 "Alist of regexps that match MIME types and their encodings. 45If the encoding is `qp-or-base64', then either quoted-printable 46or base64 will be used, depending on what is more efficient. 47 48`qp-or-base64' has another effect. It will fold long lines so that 49MIME parts may not be broken by MTA. So do `quoted-printable' and 50`base64'. 51 52Note: It affects body encoding only when a part is a raw forwarded 53message (which will be made by `gnus-summary-mail-forward' with the 54arg 2 for example) or is neither the text/* type nor the message/* 55type. Even though in those cases, you can use the `encoding' MML tag 56to specify encoding of non-ASCII MIME parts." 57 :type '(repeat (list (regexp :tag "MIME type") 58 (choice :tag "encoding" 59 (const 7bit) 60 (const 8bit) 61 (const qp-or-base64) 62 (const quoted-printable) 63 (const base64)))) 64 :group 'mime) 65 66(defvar mm-use-ultra-safe-encoding nil 67 "If non-nil, use encodings aimed at Procrustean bed survival. 68 69This means that textual parts are encoded as quoted-printable if they 70contain lines longer than 76 characters or starting with \"From \" in 71the body. Non-7bit encodings (8bit, binary) are generally disallowed. 72This is to reduce the probability that a broken MTA or MDA changes the 73message. 74 75This variable should never be set directly, but bound before a call to 76`mml-generate-mime' or similar functions.") 77 78(defun mm-insert-rfc822-headers (charset encoding) 79 "Insert text/plain headers with CHARSET and ENCODING." 80 (insert "MIME-Version: 1.0\n") 81 (insert "Content-Type: text/plain; charset=" 82 (mail-quote-string (downcase (symbol-name charset))) "\n") 83 (insert "Content-Transfer-Encoding: " 84 (downcase (symbol-name encoding)) "\n")) 85 86(defun mm-insert-multipart-headers () 87 "Insert multipart/mixed headers." 88 (let ((boundary "=-=-=")) 89 (insert "MIME-Version: 1.0\n") 90 (insert "Content-Type: multipart/mixed; boundary=\"" boundary "\"\n") 91 boundary)) 92 93(defun mm-default-file-encoding (file) 94 "Return a default encoding for FILE." 95 (if (not (string-match "\\.[^.]+$" file)) 96 "application/octet-stream" 97 (mailcap-extension-to-mime (match-string 0 file)))) 98 99(defun mm-safer-encoding (encoding) 100 "Return an encoding similar to ENCODING but safer than it." 101 (cond 102 ((eq encoding '7bit) '7bit) ;; 7bit is considered safe. 103 ((memq encoding '(8bit quoted-printable)) 'quoted-printable) 104 ;; The remaining encodings are binary and base64 (and perhaps some 105 ;; non-standard ones), which are both turned into base64. 106 (t 'base64))) 107 108(defun mm-encode-content-transfer-encoding (encoding &optional type) 109 "Encode the current buffer with ENCODING for MIME type TYPE. 110ENCODING can be: nil (do nothing); one of `quoted-printable', `base64'; 111`7bit', `8bit' or `binary' (all do nothing); a function to do the encoding." 112 (cond 113 ((eq encoding 'quoted-printable) 114 ;; This used to try to make a multibyte buffer unibyte. That's 115 ;; completely wrong, since you'd get QP-encoded emacs-mule. If 116 ;; this gets run on multibyte text it's an error that needs 117 ;; fixing, and the encoding function will signal an error. 118 ;; Likewise base64 below. 119 (quoted-printable-encode-region (point-min) (point-max) t)) 120 ((eq encoding 'base64) 121 (when (string-match "\\`text/" type) 122 (goto-char (point-min)) 123 (while (search-forward "\n" nil t) 124 (replace-match "\r\n" t t))) 125 (base64-encode-region (point-min) (point-max))) 126 ((memq encoding '(7bit 8bit binary)) 127 ;; Do nothing. 128 ) 129 ((null encoding) 130 ;; Do nothing. 131 ) 132 ;; Fixme: Ignoring errors here looks bogus. 133 ((functionp encoding) 134 (ignore-errors (funcall encoding (point-min) (point-max)))) 135 (t 136 (error "Unknown encoding %s" encoding)))) 137 138(defun mm-encode-buffer (type) 139 "Encode the buffer which contains data of MIME type TYPE. 140TYPE is a string or a list of the components. 141The encoding used is returned." 142 (let* ((mime-type (if (stringp type) type (car type))) 143 (encoding 144 (or (and (listp type) 145 (cadr (assq 'encoding type))) 146 (mm-content-transfer-encoding mime-type))) 147 (bits (mm-body-7-or-8))) 148 ;; We force buffers that are 7bit to be unencoded, no matter 149 ;; what the preferred encoding is. 150 ;; Only if the buffers don't contain lone lines. 151 (when (and (eq bits '7bit) (not (mm-long-lines-p 76))) 152 (setq encoding bits)) 153 (mm-encode-content-transfer-encoding encoding mime-type) 154 encoding)) 155 156(defun mm-insert-headers (type encoding &optional file) 157 "Insert headers for TYPE." 158 (insert "Content-Type: " type) 159 (when file 160 (insert ";\n\tname=\"" (file-name-nondirectory file) "\"")) 161 (insert "\n") 162 (insert (format "Content-Transfer-Encoding: %s\n" encoding)) 163 (insert "Content-Disposition: inline") 164 (when file 165 (insert ";\n\tfilename=\"" (file-name-nondirectory file) "\"")) 166 (insert "\n") 167 (insert "\n")) 168 169(defun mm-content-transfer-encoding (type) 170 "Return a CTE suitable for TYPE to encode the current buffer." 171 (let ((rules mm-content-transfer-encoding-defaults)) 172 (catch 'found 173 (while rules 174 (when (string-match (caar rules) type) 175 (throw 'found 176 (let ((encoding 177 (if (eq (cadr (car rules)) 'qp-or-base64) 178 (mm-qp-or-base64) 179 (cadr (car rules))))) 180 (if mm-use-ultra-safe-encoding 181 (mm-safer-encoding encoding) 182 encoding)))) 183 (pop rules))))) 184 185(defun mm-qp-or-base64 () 186 "Return the type with which to encode the buffer. 187This is either `base64' or `quoted-printable'." 188 (if (equal mm-use-ultra-safe-encoding '(sign . "pgp")) 189 ;; perhaps not always accurate? 190 'quoted-printable 191 (save-excursion 192 (let ((limit (min (point-max) (+ 2000 (point-min)))) 193 (n8bit 0)) 194 (goto-char (point-min)) 195 (skip-chars-forward "\x20-\x7f\r\n\t" limit) 196 (while (< (point) limit) 197 (incf n8bit) 198 (forward-char 1) 199 (skip-chars-forward "\x20-\x7f\r\n\t" limit)) 200 (if (or (< (* 6 n8bit) (- limit (point-min))) 201 ;; Don't base64, say, a short line with a single 202 ;; non-ASCII char when splitting parts by charset. 203 (= n8bit 1)) 204 'quoted-printable 205 'base64))))) 206 207(provide 'mm-encode) 208 209;;; arch-tag: 7d01bba4-d469-4851-952b-dc863f84ed66 210;;; mm-encode.el ends here 211