lisp/gnus/mm-view.el

   1 ;;; mm-view.el --- functions for viewing MIME objects
   2
   3 ;; Copyright (C) 1998-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software: you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;;; Code:
  24
  25 (eval-when-compile (require 'cl))
  26 (require 'mail-parse)
  27 (require 'mailcap)
  28 (require 'mm-bodies)
  29 (require 'mm-decode)
  30 (require 'smime)
  31 (require 'mml-smime)
  32
  33 (autoload 'gnus-completing-read "gnus-util")
  34 (autoload 'gnus-article-prepare-display "gnus-art")
  35 (autoload 'vcard-parse-string "vcard")
  36 (autoload 'vcard-format-string "vcard")
  37 (autoload 'fill-flowed "flow-fill")
  38 (autoload 'html2text "html2text" nil t)
  39
  40 (defvar gnus-article-mime-handles)
  41 (defvar gnus-newsgroup-charset)
  42 (defvar smime-keys)
  43 (defvar w3m-cid-retrieve-function-alist)
  44 (defvar w3m-current-buffer)
  45 (defvar w3m-display-inline-images)
  46 (defvar w3m-minor-mode-map)
  47
  48 (defvar mm-text-html-renderer-alist
  49   '((shr . mm-shr)
  50     (w3m . mm-inline-text-html-render-with-w3m)
  51     (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone)
  52     (gnus-w3m . gnus-article-html)
  53     (links mm-inline-render-with-file
  54            mm-links-remove-leading-blank
  55            "links" "-dump" file)
  56     (lynx mm-inline-render-with-stdin nil
  57           "lynx" "-dump" "-force_html" "-stdin" "-nolist")
  58     (html2text mm-inline-render-with-function html2text))
  59   "The attributes of renderer types for text/html.")
  60
  61 (defcustom mm-fill-flowed t
  62   "If non-nil a format=flowed article will be displayed flowed."
  63   :type 'boolean
  64   :version "22.1"
  65   :group 'mime-display)
  66
  67 (defcustom mm-inline-large-images-proportion 0.9
  68   "Maximum proportion of large image resized when
  69 `mm-inline-large-images' is set to resize."
  70   :type 'float
  71   :version "24.1"
  72   :group 'mime-display)
  73
  74 ;;; Internal variables.
  75
  76 ;;;
  77 ;;; Functions for displaying various formats inline
  78 ;;;
  79
  80 (autoload 'gnus-rescale-image "gnus-util")
  81
  82 (defun mm-inline-image (handle)
  83   (let ((b (point-marker))
  84         (inhibit-read-only t))
  85     (put-image
  86      (let ((image (mm-get-image handle)))
  87        (if (eq mm-inline-large-images 'resize)
  88            (gnus-rescale-image
  89             image
  90             (let ((edges (window-inside-pixel-edges
  91                           (get-buffer-window (current-buffer)))))
  92               (cons (truncate (* mm-inline-large-images-proportion
  93                                  (- (nth 2 edges) (nth 0 edges))))
  94                     (truncate (* mm-inline-large-images-proportion
  95                                  (- (nth 3 edges) (nth 1 edges)))))))
  96          image))
  97      b)
  98     (insert "\n")
  99     (mm-handle-set-undisplayer
 100      handle
 101      `(lambda ()
 102         (let ((b ,b)
 103               (inhibit-read-only t))
 104           (remove-images b b)
 105           (delete-region b (1+ b)))))))
 106
 107 (defvar mm-w3m-setup nil
 108   "Whether gnus-article-mode has been setup to use emacs-w3m.")
 109
 110 ;; External.
 111 (declare-function w3m-detect-meta-charset "ext:w3m" ())
 112 (declare-function w3m-region "ext:w3m" (start end &optional url charset))
 113
 114 (defun mm-setup-w3m ()
 115   "Setup gnus-article-mode to use emacs-w3m."
 116   (unless mm-w3m-setup
 117     (require 'w3m)
 118     (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist)
 119       (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
 120             w3m-cid-retrieve-function-alist))
 121     (setq mm-w3m-setup t))
 122   (setq w3m-display-inline-images (not mm-html-inhibit-images)))
 123
 124 (defun mm-w3m-cid-retrieve-1 (url handle)
 125   (dolist (elem handle)
 126     (when (consp elem)
 127       (when (equal url (mm-handle-id elem))
 128         (mm-insert-part elem)
 129         (throw 'found-handle (mm-handle-media-type elem)))
 130       (when (and (stringp (car elem))
 131                  (equal "multipart" (mm-handle-media-supertype elem)))
 132         (mm-w3m-cid-retrieve-1 url elem)))))
 133
 134 (defun mm-w3m-cid-retrieve (url &rest args)
 135   "Insert a content pointed by URL if it has the cid: scheme."
 136   (when (string-match "\\`cid:" url)
 137     (or (catch 'found-handle
 138           (mm-w3m-cid-retrieve-1
 139            (setq url (concat "<" (substring url (match-end 0)) ">"))
 140            (with-current-buffer w3m-current-buffer
 141              gnus-article-mime-handles)))
 142         (prog1
 143             nil
 144           (message "Failed to find \"Content-ID: %s\"" url)))))
 145
 146 (defun mm-inline-text-html-render-with-w3m (handle)
 147   "Render a text/html part using emacs-w3m."
 148   (mm-setup-w3m)
 149   (let ((text (mm-get-part handle))
 150         (b (point))
 151         (charset (or (mail-content-type-get (mm-handle-type handle) 'charset)
 152                      mail-parse-charset)))
 153     (save-excursion
 154       (insert (if charset (mm-decode-string text charset) text))
 155       (save-restriction
 156         (narrow-to-region b (point))
 157         (unless charset
 158           (goto-char (point-min))
 159           (when (setq charset (w3m-detect-meta-charset))
 160             (delete-region (point-min) (point-max))
 161             (insert (mm-decode-string text charset))))
 162         (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
 163               w3m-force-redisplay)
 164           (w3m-region (point-min) (point-max) nil charset))
 165         ;; Put the mark meaning this part was rendered by emacs-w3m.
 166         (put-text-property (point-min) (point-max)
 167                            'mm-inline-text-html-with-w3m t)
 168         (when (and mm-inline-text-html-with-w3m-keymap
 169                    (boundp 'w3m-minor-mode-map)
 170                    w3m-minor-mode-map)
 171           (if (and (boundp 'w3m-link-map)
 172                    w3m-link-map)
 173               (let* ((start (point-min))
 174                      (end (point-max))
 175                      (on (get-text-property start 'w3m-href-anchor))
 176                      (map (copy-keymap w3m-link-map))
 177                      next)
 178                 (set-keymap-parent map w3m-minor-mode-map)
 179                 (while (< start end)
 180                   (if on
 181                       (progn
 182                         (setq next (or (text-property-any start end
 183                                                           'w3m-href-anchor nil)
 184                                        end))
 185                         (put-text-property start next 'keymap map))
 186                     (setq next (or (text-property-not-all start end
 187                                                           'w3m-href-anchor nil)
 188                                    end))
 189                     (put-text-property start next 'keymap w3m-minor-mode-map))
 190                   (setq start next
 191                         on (not on))))
 192             (put-text-property (point-min) (point-max)
 193                                'keymap w3m-minor-mode-map)))
 194         (mm-handle-set-undisplayer
 195          handle
 196          `(lambda ()
 197             (let ((inhibit-read-only t))
 198               (delete-region ,(point-min-marker)
 199                              ,(point-max-marker)))))))))
 200
 201 (defcustom mm-w3m-standalone-supports-m17n-p 'undecided
 202   "T means the w3m command supports the m17n feature."
 203   :type '(choice (const nil) (const t) (other :tag "detect" undecided))
 204   :group 'mime-display)
 205
 206 (defun mm-w3m-standalone-supports-m17n-p ()
 207   "Say whether the w3m command supports the m17n feature."
 208   (cond ((eq mm-w3m-standalone-supports-m17n-p t) t)
 209         ((eq mm-w3m-standalone-supports-m17n-p nil) nil)
 210         ((condition-case nil
 211              (let ((coding-system-for-write 'iso-2022-jp)
 212                    (coding-system-for-read 'iso-2022-jp)
 213                    (str (decode-coding-string "\
 214 \e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t!!#m#1#7#n!)\e(B" 'iso-2022-jp)))
 215                (mm-with-multibyte-buffer
 216                  (insert str)
 217                  (call-process-region
 218                   (point-min) (point-max) "w3m" t t nil "-dump"
 219                   "-T" "text/html" "-I" "iso-2022-jp" "-O" "iso-2022-jp")
 220                  (goto-char (point-min))
 221                  (search-forward str nil t)))
 222            (error nil))
 223          (setq mm-w3m-standalone-supports-m17n-p t))
 224         (t
 225          ;;(message "You had better upgrade your w3m command")
 226          (setq mm-w3m-standalone-supports-m17n-p nil))))
 227
 228 (defun mm-inline-text-html-render-with-w3m-standalone (handle)
 229   "Render a text/html part using w3m."
 230   (if (mm-w3m-standalone-supports-m17n-p)
 231       (let ((source (mm-get-part handle))
 232             (charset (or (mail-content-type-get (mm-handle-type handle)
 233                                                 'charset)
 234                          (symbol-name mail-parse-charset)))
 235             cs)
 236         (if (and charset
 237                  (setq cs (mm-charset-to-coding-system charset nil t))
 238                  (not (eq cs 'ascii)))
 239             (setq charset (format "%s" (mm-coding-system-to-mime-charset cs)))
 240           ;; The default.
 241           (setq charset "iso-8859-1"
 242                 cs 'iso-8859-1))
 243         (mm-insert-inline
 244          handle
 245          (mm-with-unibyte-buffer
 246            (insert source)
 247            (mm-enable-multibyte)
 248            (let ((coding-system-for-write 'binary)
 249                  (coding-system-for-read cs))
 250              (call-process-region
 251               (point-min) (point-max)
 252               "w3m" t t nil "-dump" "-T" "text/html"
 253               "-I" charset "-O" charset))
 254            (buffer-string))))
 255     (mm-inline-render-with-stdin handle nil "w3m" "-dump" "-T" "text/html")))
 256
 257 (defun mm-links-remove-leading-blank ()
 258   ;; Delete the annoying three spaces preceding each line of links
 259   ;; output.
 260   (goto-char (point-min))
 261   (while (re-search-forward "^   " nil t)
 262     (delete-region (match-beginning 0) (match-end 0))))
 263
 264 (defun mm-inline-wash-with-file (post-func cmd &rest args)
 265   (let ((file (make-temp-file
 266                (expand-file-name "mm" mm-tmp-directory))))
 267     (let ((coding-system-for-write 'binary))
 268       (write-region (point-min) (point-max) file nil 'silent))
 269     (delete-region (point-min) (point-max))
 270     (unwind-protect
 271         (apply 'call-process cmd nil t nil (mapcar 'eval args))
 272       (delete-file file))
 273     (and post-func (funcall post-func))))
 274
 275 (defun mm-inline-wash-with-stdin (post-func cmd &rest args)
 276   (let ((coding-system-for-write 'binary))
 277     (apply 'call-process-region (point-min) (point-max)
 278            cmd t t nil args))
 279   (and post-func (funcall post-func)))
 280
 281 (defun mm-inline-render-with-file (handle post-func cmd &rest args)
 282   (let ((source (mm-get-part handle)))
 283     (mm-insert-inline
 284      handle
 285      (mm-with-unibyte-buffer
 286        (insert source)
 287        (apply 'mm-inline-wash-with-file post-func cmd args)
 288        (buffer-string)))))
 289
 290 (defun mm-inline-render-with-stdin (handle post-func cmd &rest args)
 291   (let ((source (mm-get-part handle)))
 292     (mm-insert-inline
 293      handle
 294      (mm-with-unibyte-buffer
 295        (insert source)
 296        (apply 'mm-inline-wash-with-stdin post-func cmd args)
 297        (buffer-string)))))
 298
 299 (defun mm-inline-render-with-function (handle func &rest args)
 300   (let ((source (mm-get-part handle))
 301         (charset (or (mail-content-type-get (mm-handle-type handle) 'charset)
 302                      mail-parse-charset)))
 303     (mm-insert-inline
 304      handle
 305      (mm-with-multibyte-buffer
 306        (insert (if charset
 307                    (mm-decode-string source charset)
 308                  source))
 309        (apply func args)
 310        (buffer-string)))))
 311
 312 (defun mm-inline-text-html (handle)
 313   (if (stringp (car handle))
 314       (mapcar 'mm-inline-text-html (cdr handle))
 315     (let* ((func mm-text-html-renderer)
 316            (entry (assq func mm-text-html-renderer-alist))
 317            (inhibit-read-only t))
 318       (if entry
 319           (setq func (cdr entry)))
 320       (cond
 321        ((functionp func)
 322         (funcall func handle))
 323        (t
 324         (apply (car func) handle (cdr func)))))))
 325
 326 (defun mm-inline-text-vcard (handle)
 327   (let ((inhibit-read-only t))
 328     (mm-insert-inline
 329      handle
 330      (concat "\n-- \n"
 331              (ignore-errors
 332                (if (fboundp 'vcard-pretty-print)
 333                    (vcard-pretty-print (mm-get-part handle))
 334                  (vcard-format-string
 335                   (vcard-parse-string (mm-get-part handle)
 336                                       'vcard-standard-filter))))))))
 337
 338 (defun mm-inline-text (handle)
 339   (let ((b (point))
 340         (type (mm-handle-media-subtype handle))
 341         (charset (mail-content-type-get
 342                   (mm-handle-type handle) 'charset))
 343         (inhibit-read-only t))
 344     (if (or (eq charset 'gnus-decoded)
 345             ;; This is probably not entirely correct, but
 346             ;; makes rfc822 parts with embedded multiparts work.
 347             (eq mail-parse-charset 'gnus-decoded))
 348         (save-restriction
 349           (narrow-to-region (point) (point))
 350           (mm-insert-part handle)
 351           (goto-char (point-max)))
 352       (mm-display-inline-fontify handle))
 353     (when (and mm-fill-flowed
 354                (equal type "plain")
 355                (equal (cdr (assoc 'format (mm-handle-type handle)))
 356                       "flowed"))
 357       (save-restriction
 358         (narrow-to-region b (point))
 359         (goto-char b)
 360         (fill-flowed nil (equal (cdr (assoc 'delsp (mm-handle-type handle)))
 361                                 "yes"))
 362         (goto-char (point-max))))
 363     (save-restriction
 364       (narrow-to-region b (point))
 365       (when (member type '("enriched" "richtext"))
 366         (set-text-properties (point-min) (point-max) nil)
 367         (ignore-errors
 368           (enriched-decode (point-min) (point-max))))
 369       (mm-handle-set-undisplayer
 370        handle
 371        `(lambda ()
 372           (let ((inhibit-read-only t))
 373             (delete-region ,(copy-marker (point-min) t)
 374                            ,(point-max-marker))))))))
 375
 376 (defun mm-insert-inline (handle text)
 377   "Insert TEXT inline from HANDLE."
 378   (let ((b (point)))
 379     (insert text)
 380     (unless (bolp)
 381       (insert "\n"))
 382     (mm-handle-set-undisplayer
 383      handle
 384      `(lambda ()
 385         (let ((inhibit-read-only t))
 386           (delete-region ,(copy-marker b t)
 387                          ,(point-marker)))))))
 388
 389 (defun mm-inline-audio (handle)
 390   (message "Not implemented"))
 391
 392 (defun mm-view-message ()
 393   (mm-enable-multibyte)
 394   (let (handles)
 395     (let (gnus-article-mime-handles)
 396       ;; Double decode problem may happen.  See mm-inline-message.
 397       (run-hooks 'gnus-article-decode-hook)
 398       (gnus-article-prepare-display)
 399       (setq handles gnus-article-mime-handles))
 400     (when handles
 401       (setq gnus-article-mime-handles
 402             (mm-merge-handles gnus-article-mime-handles handles))))
 403   (fundamental-mode)
 404   (goto-char (point-min)))
 405
 406 (defun mm-inline-message (handle)
 407   (let ((b (point))
 408         (bolp (bolp))
 409         (charset (mail-content-type-get
 410                   (mm-handle-type handle) 'charset))
 411         gnus-displaying-mime handles)
 412     (when (and charset
 413                (stringp charset))
 414       (setq charset (intern (downcase charset)))
 415       (when (eq charset 'us-ascii)
 416         (setq charset nil)))
 417     (save-excursion
 418       (save-restriction
 419         (narrow-to-region b b)
 420         (mm-insert-part handle)
 421         (let (gnus-article-mime-handles
 422               ;; disable prepare hook
 423               gnus-article-prepare-hook
 424               (gnus-newsgroup-charset
 425                (unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
 426                  (or charset gnus-newsgroup-charset))))
 427           (let ((gnus-original-article-buffer (mm-handle-buffer handle)))
 428             (run-hooks 'gnus-article-decode-hook))
 429           (gnus-article-prepare-display)
 430           (setq handles gnus-article-mime-handles))
 431         (goto-char (point-min))
 432         (unless bolp
 433           (insert "\n"))
 434         (goto-char (point-max))
 435         (unless (bolp)
 436           (insert "\n"))
 437         (insert "----------\n\n")
 438         (when handles
 439           (setq gnus-article-mime-handles
 440                 (mm-merge-handles gnus-article-mime-handles handles)))
 441         (mm-handle-set-undisplayer
 442          handle
 443          `(lambda ()
 444             (let ((inhibit-read-only t))
 445               (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
 446
 447 ;; Shut up byte-compiler.
 448 (defvar font-lock-mode-hook)
 449 (defun mm-display-inline-fontify (handle &optional mode)
 450   "Insert HANDLE inline fontifying with MODE.
 451 If MODE is not set, try to find mode automatically."
 452   (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset))
 453         text coding-system)
 454     (unless (eq charset 'gnus-decoded)
 455       (mm-with-unibyte-buffer
 456         (mm-insert-part handle)
 457         (mm-decompress-buffer
 458          (mm-handle-filename handle)
 459          t t)
 460         (unless charset
 461           (setq coding-system (mm-find-buffer-file-coding-system)))
 462         (setq text (buffer-string))))
 463     (with-temp-buffer
 464       (buffer-disable-undo)
 465       (mm-enable-multibyte)
 466       (insert (cond ((eq charset 'gnus-decoded)
 467                      (with-current-buffer (mm-handle-buffer handle)
 468                        (buffer-string)))
 469                     (coding-system
 470                      (decode-coding-string text coding-system))
 471                     (charset
 472                      (mm-decode-string text charset))
 473                     (t
 474                      text)))
 475       (require 'font-lock)
 476       ;; I find font-lock a bit too verbose.
 477       (let ((font-lock-verbose nil)
 478             (font-lock-support-mode nil)
 479             (enable-local-variables nil))
 480         ;; Disable support modes, e.g., jit-lock, lazy-lock, etc.
 481         ;; Note: XEmacs people use `font-lock-mode-hook' to run those modes.
 482         (set (make-local-variable 'font-lock-mode-hook) nil)
 483         (setq buffer-file-name (mm-handle-filename handle))
 484         (with-demoted-errors
 485           (if mode
 486               (save-window-excursion
 487                 (switch-to-buffer (current-buffer))
 488                 (funcall mode))
 489             (let ((auto-mode-alist
 490                    (delq (rassq 'doc-view-mode-maybe auto-mode-alist)
 491                          (copy-sequence auto-mode-alist))))
 492               (set-auto-mode)))
 493           ;; The mode function might have already turned on font-lock.
 494           ;; Do not fontify if the guess mode is fundamental.
 495           (unless (or font-lock-mode
 496                       (eq major-mode 'fundamental-mode))
 497             (font-lock-ensure))))
 498       (setq text (buffer-string))
 499       ;; Set buffer unmodified to avoid confirmation when killing the
 500       ;; buffer.
 501       (set-buffer-modified-p nil))
 502     (mm-insert-inline handle text)))
 503
 504 ;; Shouldn't these functions check whether the user even wants to use
 505 ;; font-lock?  Also, it would be nice to change for the size of the
 506 ;; fontified region.
 507
 508 (defun mm-display-patch-inline (handle)
 509   (mm-display-inline-fontify handle 'diff-mode))
 510
 511 (defun mm-display-elisp-inline (handle)
 512   (mm-display-inline-fontify handle 'emacs-lisp-mode))
 513
 514 (defun mm-display-dns-inline (handle)
 515   (mm-display-inline-fontify handle 'dns-mode))
 516
 517 (defun mm-display-org-inline (handle)
 518   "Show an Org mode text from HANDLE inline."
 519   (mm-display-inline-fontify handle 'org-mode))
 520
 521 (defun mm-display-shell-script-inline (handle)
 522   "Show a shell script from HANDLE inline."
 523   (mm-display-inline-fontify handle 'shell-script-mode))
 524
 525 (defun mm-display-javascript-inline (handle)
 526   "Show JavsScript code from HANDLE inline."
 527   (mm-display-inline-fontify handle 'javascript-mode))
 528
 529 ;;      id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 530 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 }
 531 (defvar mm-pkcs7-signed-magic
 532   (concat
 533     "0"
 534     "\\(\\(\x80\\)"
 535     "\\|\\(\x81\\(.\\|\n\\)\\{1\\}\\)"
 536     "\\|\\(\x82\\(.\\|\n\\)\\{2\\}\\)"
 537     "\\|\\(\x83\\(.\\|\n\\)\\{3\\}\\)"
 538     "\\)"
 539     "\x06\x09\\*\x86H\x86\xf7\x0d\x01\x07\x02"))
 540
 541 ;;      id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 542 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
 543 (defvar mm-pkcs7-enveloped-magic
 544   (concat
 545     "0"
 546     "\\(\\(\x80\\)"
 547     "\\|\\(\x81\\(.\\|\n\\)\\{1\\}\\)"
 548     "\\|\\(\x82\\(.\\|\n\\)\\{2\\}\\)"
 549     "\\|\\(\x83\\(.\\|\n\\)\\{3\\}\\)"
 550     "\\)"
 551     "\x06\x09\\*\x86H\x86\xf7\x0d\x01\x07\x03"))
 552
 553 (defun mm-view-pkcs7-get-type (handle)
 554   (mm-with-unibyte-buffer
 555     (mm-insert-part handle)
 556     (cond ((looking-at mm-pkcs7-enveloped-magic)
 557            'enveloped)
 558           ((looking-at mm-pkcs7-signed-magic)
 559            'signed)
 560           (t
 561            (error "Could not identify PKCS#7 type")))))
 562
 563 (defun mm-view-pkcs7 (handle &optional from)
 564   (case (mm-view-pkcs7-get-type handle)
 565     (enveloped (mm-view-pkcs7-decrypt handle from))
 566     (signed (mm-view-pkcs7-verify handle))
 567     (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
 568
 569 (defun mm-view-pkcs7-verify (handle)
 570   (let ((verified nil))
 571     (with-temp-buffer
 572       (insert "MIME-Version: 1.0\n")
 573       (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
 574       (insert-buffer-substring (mm-handle-buffer handle))
 575       (setq verified (smime-verify-region (point-min) (point-max))))
 576     (goto-char (point-min))
 577     (mm-insert-part handle)
 578     (if (search-forward "Content-Type: " nil t)
 579         (delete-region (point-min) (match-beginning 0)))
 580     (goto-char (point-max))
 581     (if (re-search-backward "--\r?\n?" nil t)
 582         (delete-region (match-end 0) (point-max)))
 583     (unless verified
 584       (insert-buffer-substring smime-details-buffer)))
 585   (goto-char (point-min))
 586   (while (search-forward "\r\n" nil t)
 587     (replace-match "\n"))
 588   t)
 589
 590 (autoload 'epg-decrypt-string "epg")
 591
 592 (defun mm-view-pkcs7-decrypt (handle &optional from)
 593   (insert-buffer-substring (mm-handle-buffer handle))
 594   (goto-char (point-min))
 595   (if (eq mml-smime-use 'epg)
 596       ;; Use EPG/gpgsm
 597       (let ((part (base64-decode-string (buffer-string))))
 598         (erase-buffer)
 599         (insert (epg-decrypt-string (epg-make-context 'CMS) part)))
 600     ;; Use openssl
 601     (insert "MIME-Version: 1.0\n")
 602     (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
 603     (smime-decrypt-region
 604      (point-min) (point-max)
 605      (if (= (length smime-keys) 1)
 606          (cadar smime-keys)
 607        (smime-get-key-by-email
 608         (gnus-completing-read
 609          "Decipher using key"
 610          smime-keys nil nil nil (car-safe (car-safe smime-keys)))))
 611      from))
 612   (goto-char (point-min))
 613   (while (search-forward "\r\n" nil t)
 614     (replace-match "\n"))
 615   (goto-char (point-min)))
 616
 617 (provide 'mm-view)
 618
 619 ;;; mm-view.el ends here