cgit.sxemacs.org Git - gnus/blob - lisp/mm-decode.el

   1 ;;; mm-decode.el --- Functions for decoding MIME things
   2
   3 ;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;;; Code:
  25
  26 ;; For Emacs <22.2 and XEmacs.
  27 (eval-and-compile
  28   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  29
  30 (require 'mail-parse)
  31 (require 'mm-bodies)
  32 (eval-when-compile (require 'cl)
  33                    (require 'term))
  34
  35 (autoload 'gnus-map-function "gnus-util")
  36 (autoload 'gnus-replace-in-string "gnus-util")
  37 (autoload 'gnus-read-shell-command "gnus-util")
  38
  39 (autoload 'mm-inline-partial "mm-partial")
  40 (autoload 'mm-inline-external-body "mm-extern")
  41 (autoload 'mm-extern-cache-contents "mm-extern")
  42 (autoload 'mm-insert-inline "mm-view")
  43
  44 (autoload 'mm-archive-decoders "mm-archive")
  45 (autoload 'mm-archive-dissect-and-inline "mm-archive")
  46 (autoload 'mm-dissect-archive "mm-archive")
  47
  48 (defvar gnus-current-window-configuration)
  49
  50 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
  51
  52 (defgroup mime-display ()
  53   "Display of MIME in mail and news articles."
  54   :link '(custom-manual "(emacs-mime)Display Customization")
  55   :version "21.1"
  56   :group 'mail
  57   :group 'news
  58   :group 'multimedia)
  59
  60 (defgroup mime-security ()
  61   "MIME security in mail and news articles."
  62   :link '(custom-manual "(emacs-mime)Display Customization")
  63   :group 'mail
  64   :group 'news
  65   :group 'multimedia)
  66
  67 ;;; Convenience macros.
  68
  69 (defmacro mm-handle-buffer (handle)
  70   `(nth 0 ,handle))
  71 (defmacro mm-handle-type (handle)
  72   `(nth 1 ,handle))
  73 (defsubst mm-handle-media-type (handle)
  74   (if (stringp (car handle))
  75       (car handle)
  76     (car (mm-handle-type handle))))
  77 (defsubst mm-handle-media-supertype (handle)
  78   (car (split-string (mm-handle-media-type handle) "/")))
  79 (defsubst mm-handle-media-subtype (handle)
  80   (cadr (split-string (mm-handle-media-type handle) "/")))
  81 (defmacro mm-handle-encoding (handle)
  82   `(nth 2 ,handle))
  83 (defmacro mm-handle-undisplayer (handle)
  84   `(nth 3 ,handle))
  85 (defmacro mm-handle-set-undisplayer (handle function)
  86   `(setcar (nthcdr 3 ,handle) ,function))
  87 (defmacro mm-handle-disposition (handle)
  88   `(nth 4 ,handle))
  89 (defmacro mm-handle-description (handle)
  90   `(nth 5 ,handle))
  91 (defmacro mm-handle-cache (handle)
  92   `(nth 6 ,handle))
  93 (defmacro mm-handle-set-cache (handle contents)
  94   `(setcar (nthcdr 6 ,handle) ,contents))
  95 (defmacro mm-handle-id (handle)
  96   `(nth 7 ,handle))
  97 (defmacro mm-handle-multipart-original-buffer (handle)
  98   `(get-text-property 0 'buffer (car ,handle)))
  99 (defmacro mm-handle-multipart-from (handle)
 100   `(get-text-property 0 'from (car ,handle)))
 101 (defmacro mm-handle-multipart-ctl-parameter (handle parameter)
 102   `(get-text-property 0 ,parameter (car ,handle)))
 103
 104 (defmacro mm-make-handle (&optional buffer type encoding undisplayer
 105                                     disposition description cache
 106                                     id)
 107   `(list ,buffer ,type ,encoding ,undisplayer
 108          ,disposition ,description ,cache ,id))
 109
 110 (defcustom mm-text-html-renderer
 111   (cond ((fboundp 'libxml-parse-html-region) 'shr)
 112         ((executable-find "w3m") 'gnus-w3m)
 113         ((executable-find "links") 'links)
 114         ((executable-find "lynx") 'lynx)
 115         ((locate-library "w3") 'w3)
 116         ((locate-library "html2text") 'html2text)
 117         (t nil))
 118   "Render of HTML contents.
 119 It is one of defined renderer types, or a rendering function.
 120 The defined renderer types are:
 121 `shr': use the built-in Gnus HTML renderer;
 122 `gnus-w3m': use Gnus renderer based on w3m;
 123 `w3m': use emacs-w3m;
 124 `w3m-standalone': use plain w3m;
 125 `links': use links;
 126 `lynx': use lynx;
 127 `w3': use Emacs/W3;
 128 `html2text': use html2text;
 129 nil    : use external viewer (default web browser)."
 130   :version "24.1"
 131   :type '(choice (const shr)
 132                  (const gnus-w3m)
 133                  (const w3)
 134                  (const w3m :tag "emacs-w3m")
 135                  (const w3m-standalone :tag "standalone w3m" )
 136                  (const links)
 137                  (const lynx)
 138                  (const html2text)
 139                  (const nil :tag "External viewer")
 140                  (function))
 141   :group 'mime-display)
 142
 143 (defcustom mm-inline-text-html-with-images nil
 144   "If non-nil, Gnus will allow retrieving images in HTML contents with
 145 the <img> tags.  It has no effect on Emacs/w3.  See also the
 146 documentation for the `mm-w3m-safe-url-regexp' variable."
 147   :version "22.1"
 148   :type 'boolean
 149   :group 'mime-display)
 150
 151 (defcustom mm-w3m-safe-url-regexp "\\`cid:"
 152   "Regexp matching URLs which are considered to be safe.
 153 Some HTML mails might contain a nasty trick used by spammers, using
 154 the <img> tag which is far more evil than the [Click Here!] button.
 155 It is most likely intended to check whether the ominous spam mail has
 156 reached your eyes or not, in which case the spammer knows for sure
 157 that your email address is valid.  It is done by embedding an
 158 identifier string into a URL that you might automatically retrieve
 159 when displaying the image.  The default value is \"\\\\`cid:\" which only
 160 matches parts embedded to the Multipart/Related type MIME contents and
 161 Gnus will never connect to the spammer's site arbitrarily.  You may
 162 set this variable to nil if you consider all urls to be safe."
 163   :version "22.1"
 164   :type '(choice (regexp :tag "Regexp")
 165                  (const :tag "All URLs are safe" nil))
 166   :group 'mime-display)
 167
 168 (defcustom mm-inline-text-html-with-w3m-keymap t
 169   "If non-nil, use emacs-w3m command keys in the article buffer."
 170   :version "22.1"
 171   :type 'boolean
 172   :group 'mime-display)
 173
 174 (defcustom mm-enable-external t
 175   "Indicate whether external MIME handlers should be used.
 176
 177 If t, all defined external MIME handlers are used.  If nil, files are saved by
 178 `mailcap-save-binary-file'.  If it is the symbol `ask', you are prompted
 179 before the external MIME handler is invoked."
 180   :version "22.1"
 181   :type '(choice (const :tag "Always" t)
 182                  (const :tag "Never" nil)
 183                  (const :tag "Ask" ask))
 184   :group 'mime-display)
 185
 186 (defcustom mm-inline-media-tests
 187   '(("image/p?jpeg"
 188      mm-inline-image
 189      (lambda (handle)
 190        (mm-valid-and-fit-image-p 'jpeg handle)))
 191     ("image/png"
 192      mm-inline-image
 193      (lambda (handle)
 194        (mm-valid-and-fit-image-p 'png handle)))
 195     ("image/gif"
 196      mm-inline-image
 197      (lambda (handle)
 198        (mm-valid-and-fit-image-p 'gif handle)))
 199     ("image/tiff"
 200      mm-inline-image
 201      (lambda (handle)
 202        (mm-valid-and-fit-image-p 'tiff handle)))
 203     ("image/xbm"
 204      mm-inline-image
 205      (lambda (handle)
 206        (mm-valid-and-fit-image-p 'xbm handle)))
 207     ("image/x-xbitmap"
 208      mm-inline-image
 209      (lambda (handle)
 210        (mm-valid-and-fit-image-p 'xbm handle)))
 211     ("image/xpm"
 212      mm-inline-image
 213      (lambda (handle)
 214        (mm-valid-and-fit-image-p 'xpm handle)))
 215     ("image/x-xpixmap"
 216      mm-inline-image
 217      (lambda (handle)
 218        (mm-valid-and-fit-image-p 'xpm handle)))
 219     ("image/bmp"
 220      mm-inline-image
 221      (lambda (handle)
 222        (mm-valid-and-fit-image-p 'bmp handle)))
 223     ("image/x-portable-bitmap"
 224      mm-inline-image
 225      (lambda (handle)
 226        (mm-valid-and-fit-image-p 'pbm handle)))
 227     ("text/plain" mm-inline-text identity)
 228     ("text/enriched" mm-inline-text identity)
 229     ("text/richtext" mm-inline-text identity)
 230     ("text/x-patch" mm-display-patch-inline identity)
 231     ;; In case mime.types uses x-diff (as does Debian's mime-support-3.40).
 232     ("text/x-diff" mm-display-patch-inline identity)
 233     ("application/emacs-lisp" mm-display-elisp-inline identity)
 234     ("application/x-emacs-lisp" mm-display-elisp-inline identity)
 235     ("application/x-shellscript" mm-display-shell-script-inline identity)
 236     ("application/x-sh" mm-display-shell-script-inline identity)
 237     ("text/x-sh" mm-display-shell-script-inline identity)
 238     ("application/javascript" mm-display-javascript-inline identity)
 239     ("text/dns" mm-display-dns-inline identity)
 240     ("text/x-org" mm-display-org-inline identity)
 241     ("text/html"
 242      mm-inline-text-html
 243      (lambda (handle)
 244        mm-text-html-renderer))
 245     ("text/x-vcard"
 246      mm-inline-text-vcard
 247      (lambda (handle)
 248        (or (featurep 'vcard)
 249            (locate-library "vcard"))))
 250     ("message/delivery-status" mm-inline-text identity)
 251     ("message/rfc822" mm-inline-message identity)
 252     ("message/partial" mm-inline-partial identity)
 253     ("message/external-body" mm-inline-external-body identity)
 254     ("text/.*" mm-inline-text identity)
 255     ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
 256     ("application/zip" mm-archive-dissect-and-inline identity)
 257     ("audio/wav" mm-inline-audio
 258      (lambda (handle)
 259        (and (or (featurep 'nas-sound) (featurep 'native-sound))
 260             (device-sound-enabled-p))))
 261     ("audio/au"
 262      mm-inline-audio
 263      (lambda (handle)
 264        (and (or (featurep 'nas-sound) (featurep 'native-sound))
 265             (device-sound-enabled-p))))
 266     ("application/pgp-signature" ignore identity)
 267     ("application/x-pkcs7-signature" ignore identity)
 268     ("application/pkcs7-signature" ignore identity)
 269     ("application/x-pkcs7-mime" ignore identity)
 270     ("application/pkcs7-mime" ignore identity)
 271     ("multipart/alternative" ignore identity)
 272     ("multipart/mixed" ignore identity)
 273     ("multipart/related" ignore identity)
 274     ("image/.*"
 275      mm-inline-image
 276      (lambda (handle)
 277        (and (mm-valid-image-format-p 'imagemagick)
 278             (mm-with-unibyte-buffer
 279               (mm-insert-part handle)
 280               (let ((image
 281                      (ignore-errors
 282                        (if (fboundp 'create-image)
 283                            (create-image (buffer-string) 'imagemagick 'data-p)
 284                          (mm-create-image-xemacs
 285                           (mm-handle-media-subtype handle))))))
 286                 (when image
 287                   (setcar (cdr handle) (list "image/imagemagick"))
 288                   (mm-image-fit-p handle)))))))
 289     ;; Disable audio and image
 290     ("audio/.*" ignore ignore)
 291     ("image/.*" ignore ignore)
 292     ;; Default to displaying as text
 293     (".*" mm-inline-text mm-readable-p))
 294   "Alist of media types/tests saying whether types can be displayed inline."
 295   :type '(repeat (list (regexp :tag "MIME type")
 296                        (function :tag "Display function")
 297                        (function :tag "Display test")))
 298   :group 'mime-display)
 299
 300 (defcustom mm-inlined-types
 301   '("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
 302     "message/partial" "message/external-body" "application/emacs-lisp"
 303     "application/x-emacs-lisp"
 304     "application/pgp-signature" "application/x-pkcs7-signature"
 305     "application/pkcs7-signature" "application/x-pkcs7-mime"
 306     "application/pkcs7-mime"
 307     "application/x-gtar-compressed"
 308     "application/x-tar"
 309     "application/zip"
 310     ;; Mutt still uses this even though it has already been withdrawn.
 311     "application/pgp")
 312   "List of media types that are to be displayed inline.
 313 See also `mm-inline-media-tests', which says how to display a media
 314 type inline."
 315   :type '(repeat regexp)
 316   :group 'mime-display)
 317
 318 (defcustom mm-keep-viewer-alive-types
 319   '("application/postscript" "application/msword" "application/vnd.ms-excel"
 320     "application/pdf" "application/x-dvi")
 321   "List of media types for which the external viewer will not be killed
 322 when selecting a different article."
 323   :version "22.1"
 324   :type '(repeat regexp)
 325   :group 'mime-display)
 326
 327 (defcustom mm-automatic-display
 328   '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim"
 329     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
 330     "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature"
 331     "application/emacs-lisp" "application/x-emacs-lisp"
 332     "application/x-pkcs7-signature"
 333     "application/pkcs7-signature" "application/x-pkcs7-mime"
 334     "application/pkcs7-mime"
 335     ;; Mutt still uses this even though it has already been withdrawn.
 336     "application/pgp\\'"
 337      "text/x-org")
 338   "A list of MIME types to be displayed automatically."
 339   :type '(repeat regexp)
 340   :group 'mime-display)
 341
 342 (defcustom mm-attachment-override-types '("text/x-vcard"
 343                                           "application/pkcs7-mime"
 344                                           "application/x-pkcs7-mime"
 345                                           "application/pkcs7-signature"
 346                                           "application/x-pkcs7-signature")
 347   "Types to have \"attachment\" ignored if they can be displayed inline."
 348   :type '(repeat regexp)
 349   :group 'mime-display)
 350
 351 (defcustom mm-inline-override-types nil
 352   "Types to be treated as attachments even if they can be displayed inline."
 353   :type '(repeat regexp)
 354   :group 'mime-display)
 355
 356 (defcustom mm-automatic-external-display nil
 357   "List of MIME type regexps that will be displayed externally automatically."
 358   :type '(repeat regexp)
 359   :group 'mime-display)
 360
 361 (defcustom mm-discouraged-alternatives nil
 362   "List of MIME types that are discouraged when viewing multipart/alternative.
 363 Viewing agents are supposed to view the last possible part of a message,
 364 as that is supposed to be the richest.  However, users may prefer other
 365 types instead, and this list says what types are most unwanted.  If,
 366 for instance, text/html parts are very unwanted, and text/richtext are
 367 somewhat unwanted, then the value of this variable should be set
 368 to:
 369
 370  (\"text/html\" \"text/richtext\")
 371
 372 Adding \"image/.*\" might also be useful.  Spammers use it as the
 373 preferred part of multipart/alternative messages.  See also
 374 `gnus-buttonized-mime-types', to which adding \"multipart/alternative\"
 375 enables you to choose manually one of two types those mails include."
 376   :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'.
 377   :group 'mime-display)
 378
 379 (defcustom mm-tmp-directory
 380   (if (fboundp 'temp-directory)
 381       (temp-directory)
 382     (if (boundp 'temporary-file-directory)
 383         temporary-file-directory
 384       "/tmp/"))
 385   "Where mm will store its temporary files."
 386   :type 'directory
 387   :group 'mime-display)
 388
 389 (defcustom mm-inline-large-images nil
 390   "If t, then all images fit in the buffer.
 391 If 'resize, try to resize the images so they fit."
 392   :type '(radio
 393           (const :tag "Inline large images as they are." t)
 394           (const :tag "Resize large images." resize)
 395           (const :tag "Do not inline large images." nil))
 396   :group 'mime-display)
 397
 398 (defcustom mm-file-name-rewrite-functions
 399   '(mm-file-name-delete-control mm-file-name-delete-gotchas)
 400   "List of functions used for rewriting file names of MIME parts.
 401 Each function takes a file name as input and returns a file name.
 402
 403 Ready-made functions include `mm-file-name-delete-control',
 404 `mm-file-name-delete-gotchas' (you should not remove these two
 405 functions), `mm-file-name-delete-whitespace',
 406 `mm-file-name-trim-whitespace', `mm-file-name-collapse-whitespace',
 407 `mm-file-name-replace-whitespace', `capitalize', `downcase',
 408 `upcase', and `upcase-initials'."
 409   :type '(list (set :inline t
 410                     (const mm-file-name-delete-control)
 411                     (const mm-file-name-delete-gotchas)
 412                     (const mm-file-name-delete-whitespace)
 413                     (const mm-file-name-trim-whitespace)
 414                     (const mm-file-name-collapse-whitespace)
 415                     (const mm-file-name-replace-whitespace)
 416                     (const capitalize)
 417                     (const downcase)
 418                     (const upcase)
 419                     (const upcase-initials)
 420                (repeat :inline t
 421                        :tag "Function"
 422                        function)))
 423   :version "23.1" ;; No Gnus
 424   :group 'mime-display)
 425
 426
 427 (defvar mm-path-name-rewrite-functions nil
 428   "*List of functions for rewriting the full file names of MIME parts.
 429 This is used when viewing parts externally, and is meant for
 430 transforming the absolute name so that non-compliant programs can find
 431 the file where it's saved.
 432
 433 Each function takes a file name as input and returns a file name.")
 434
 435 (defvar mm-file-name-replace-whitespace nil
 436   "String used for replacing whitespace characters; default is `\"_\"'.")
 437
 438 (defcustom mm-default-directory nil
 439   "The default directory where mm will save files.
 440 If not set, `default-directory' will be used."
 441   :type '(choice directory (const :tag "Default" nil))
 442   :group 'mime-display)
 443
 444 (defcustom mm-attachment-file-modes 384
 445   "Set the mode bits of saved attachments to this integer."
 446   :version "22.1"
 447   :type 'integer
 448   :group 'mime-display)
 449
 450 (defcustom mm-external-terminal-program "xterm"
 451   "The program to start an external terminal."
 452   :version "22.1"
 453   :type 'string
 454   :group 'mime-display)
 455
 456 ;;; Internal variables.
 457
 458 (defvar mm-last-shell-command "")
 459 (defvar mm-content-id-alist nil)
 460 (defvar mm-p