code.delx.au - gnu-emacs/blob - lisp/gnus/mm-view.el

   1 ;;; mm-view.el --- functions for viewing MIME objects
   2
   3 ;; Copyright (C) 1998-2016 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 <http://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 (defvar mm-w3m-standalone-supports-m17n-p 'undecided
 202   "*T means the w3m command supports the m17n feature.")
 203
 204 (defun mm-w3m-standalone-supports-m17n-p ()
 205   "Say whether the w3m command supports the m17n feature."
 206   (cond ((eq mm-w3m-standalone-supports-m17n-p t) t)
 207         ((eq mm-w3m-standalone-supports-m17n-p nil) nil)
 208         ((condition-case nil
 209              (let ((coding-system-for-write 'iso-2022-jp)
 210                    (coding-system-for-read 'iso-2022-jp)
 211                    (str (decode-coding-string "\
 212 \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)))
 213                (mm-with-multibyte-buffer
 214                  (insert str)
 215                  (call-process-region
 216                   (point-min) (point-max) "w3m" t t nil "-dump"
 217                   "-T" "text/html" "-I" "iso-2022-jp" "-O" "iso-2022-jp")
 218                  (goto-char (point-min))
 219                  (search-forward str nil t)))
 220            (error nil))
 221          (setq mm-w3m-standalone-supports-m17n-p t))
 222         (t
 223          ;;(message "You had better upgrade your w3m command")
 224          (setq mm-w3m-standalone-supports-m17n-p nil))))
 225
 226 (defun mm-inline-text-html-render-with-w3m-standalone (handle)
 227   "Render a text/html part using w3m."
 228   (if (mm-w3m-standalone-supports-m17n-p)
 229       (let ((source (mm-get-part handle))
 230             (charset (or (mail-content-type-get (mm-handle-type handle)
 231                                                 'charset)
 232                          (symbol-name mail-parse-charset)))
 233             cs)
 234         (if (and charset
 235                  (setq cs (mm-charset-to-coding-system charset nil t))
 236                  (not (eq cs 'ascii)))
 237             (setq charset (format "%s" (mm-coding-system-to-mime-charset cs)))
 238           ;; The default.
 239           (setq charset "iso-8859-1"
 240                 cs 'iso-8859-1))
 241         (mm-insert-inline
 242          handle
 243          (mm-with-unibyte-buffer
 244            (insert source)
 245            (mm-enable-multibyte)
 246            (let ((coding-system-for-write 'binary)
 247                  (coding-system-for-read cs))
 248              (call-process-region
 249               (point-min) (point-max)
 250               "w3m" t t nil "-dump" "-T" "text/html"
 251               "-I" charset "-O" charset))
 252            (buffer-string))))
 253     (mm-inline-render-with-stdin handle nil "w3m" "-dump" "-T" "text/html")))
 254
 255 (defun mm-links-remove-leading-blank ()
 256   ;; Delete the annoying three spaces preceding each line of links
 257   ;; output.
 258   (goto-char (point-min))
 259   (while (re-search-forward "^   " nil t)
 260     (delete-region (match-beginning 0) (match-end 0))))
 261
 262 (defun mm-inline-wash-with-file (post-func cmd &rest args)
 263   (let ((file (make-temp-file
 264                (expand-file-name "mm" mm-tmp-directory))))
 265     (let ((coding-system-for-write 'binary))
 266       (write-region (point-min) (point-max) file nil 'silent))
 267     (delete-region (point-min) (point-max))
 268     (unwind-protect
 269         (apply 'call-process cmd nil t nil (mapcar 'eval args))
 270       (delete-file file))
 271     (and post-func (funcall post-func))))
 272
 273 (defun mm-inline-wash-with-stdin (post-func cmd &rest args)
 274   (let ((coding-system-for-write 'binary))
 275     (apply 'call-process-region (point-min) (point-max)
 276            cmd t t nil args))
 277   (and post-func (funcall post-func)))
 278
 279 (defun mm-inline-render-with-file (handle post-func cmd &rest args)
 280   (let ((source (mm-get-part handle)))
 281     (mm-insert-inline
 282      handle
 283      (mm-with-unibyte-buffer
 284        (insert source)
 285        (apply 'mm-inline-wash-with-file post-func cmd args)
 286        (buffer-string)))))
 287
 288 (defun mm-inline-render-with-stdin (handle post-func cmd &rest args)
 289   (let ((source (mm-get-part handle)))
 290     (mm-insert-inline
 291      handle
 292      (mm-with-unibyte-buffer
 293        (insert source)
 294        (apply 'mm-inline-wash-with-stdin post-func cmd args)
 295        (buffer-string)))))
 296
 297 (defun mm-inline-render-with-function (handle func &rest args)
 298   (let ((source (mm-get-part handle))
 299         (charset (or (mail-content-type-get (mm-handle-type handle) 'charset)
 300                      mail-parse-charset)))
 301     (mm-insert-inline
 302      handle
 303      (mm-with-multibyte-buffer
 304        (insert (if charset
 305                    (mm-decode-string source charset)
 306                  source))
 307        (apply func args)
 308        (buffer-string)))))
 309
 310 (defun mm-inline-text-html (handle)
 311   (if (stringp (car handle))
 312       (mapcar 'mm-inline-text-html (cdr handle))
 313     (let* ((func mm-text-html-renderer)
 314            (entry (assq func mm-text-html-renderer-alist))
 315            (inhibit-read-only t))
 316       (if entry
 317           (setq func (cdr entry)))
 318       (cond
 319        ((functionp func)
 320         (funcall func handle))
 321        (t
 322         (apply (car func) handle (cdr func)))))))
 323
 324 (defun mm-inline-text-vcard (handle)
 325   (let ((inhibit-read-only t))
 326     (mm-insert-inline
 327      handle
 328      (concat "\n-- \n"
 329              (ignore-errors
 330                (if (fboundp 'vcard-pretty-print)
 331                    (vcard-pretty-print (mm-get-part handle))
 332                  (vcard-format-string
 333                   (vcard-parse-string (mm-get-part handle)
 334                                       'vcard-standard-filter))))))))
 335
 336 (defun mm-inline-text (handle)
 337   (let ((b (point))
 338         (type (mm-handle-media-subtype handle))
 339         (charset (mail-content-type-get
 340                   (mm-handle-type handle) 'charset))
 341         (inhibit-read-only t))
 342     (if (or (eq charset 'gnus-decoded)
 343             ;; This is probably not entirely correct, but
 344             ;; makes rfc822 parts with embedded multiparts work.
 345             (eq mail-parse-charset 'gnus-decoded))
 346         (save-restriction
 347           (narrow-to-region (point) (point))
 348           (mm-insert-part handle)
 349           (goto-char (point-max)))
 350       (mm-display-inline-fontify handle))
 351     (when (and mm-fill-flowed
 352                (equal type "plain")
 353                (equal (cdr (assoc 'format (mm-handle-type handle)))
 354                       "flowed"))
 355       (save-restriction
 356         (narrow-to-region b (point))
 357         (goto-char b)
 358         (fill-flowed nil (equal (cdr (assoc 'delsp (mm-handle-type handle)))
 359                                 "yes"))
 360         (goto-char (point-max))))
 361     (save-restriction
 362       (narrow-to-region b (point))
 363       (when (member type '("enriched" "richtext"))
 364         (set-text-properties (point-min) (point-max) nil)
 365         (ignore-errors
 366           (enriched-decode (point-min) (point-max))))
 367       (mm-handle-set-undisplayer
 368        handle
 369        `(lambda ()
 370           (let ((inhibit-read-only t))
 371             (delete-region ,(copy-marker (point-min) t)
 372                            ,(point-max-marker))))))))
 373
 374 (defun mm-insert-inline (handle text)
 375   "Insert TEXT inline from HANDLE."
 376   (let ((b (point)))
 377     (insert text)
 378     (unless (bolp)
 379       (insert "\n"))
 380     (mm-handle-set-undisplayer
 381      handle
 382      `(lambda ()
 383         (let ((inhibit-read-only t))
 384           (delete-region ,(copy-marker b t)
 385                          ,(point-marker)))))))
 386
 387 (defun mm-inline-audio (handle)
 388   (message "Not implemented"))
 389
 390 (defun mm-view-message ()
 391   (mm-enable-multibyte)
 392   (let (handles)
 393     (let (gnus-article-mime-handles)
 394       ;; Double decode problem may happen.  See mm-inline-message.
 395       (run-hooks 'gnus-article-decode-hook)
 396       (gnus-article-prepare-display)
 397       (setq handles gnus-article-mime-handles))
 398     (when handles
 399       (setq gnus-article-mime-handles
 400             (mm-merge-handles gnus-article-mime-handles handles))))
 401   (fundamental-mode)
 402   (goto-char (point-min)))
 403
 404 (defun mm-inline-message (handle)
 405   (let ((b (point))
 406         (bolp (bolp))
 407         (charset (mail-content-type-get
 408                   (mm-handle-type handle) 'charset))
 409         gnus-displaying-mime handles)
 410     (when (and charset
 411                (stringp charset))
 412       (setq charset (intern (downcase charset)))
 413       (when (eq charset 'us-ascii)
 414         (setq charset nil)))
 415     (save-excursion
 416       (save-restriction
 417         (narrow-to-region b b)
 418         (mm-insert-part handle)
 419         (let (gnus-article-mime-handles
 420               ;; disable prepare hook
 421               gnus-article-prepare-hook
 422               (gnus-newsgroup-charset
 423                (unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
 424                  (or charset gnus-newsgroup-charset))))
 425           (let ((gnus-original-article-buffer (mm-handle-buffer handle)))
 426             (run-hooks 'gnus-article-decode-hook))
 427           (gnus-article-prepare-display)
 428           (setq handles gnus-article-mime-handles))
 429         (goto-char (point-min))
 430         (unless bolp
 431           (insert "\n"))
 432         (goto-char (point-max))
 433         (unless (bolp)
 434           (insert "\n"))
 435         (insert "----------\n\n")
 436         (when handles
 437           (setq gnus-article-mime-handles
 438                 (mm-merge-handles gnus-article-mime-handles handles)))
 439         (mm-handle-set-undisplayer
 440          handle
 441          `(lambda ()
 442             (let ((inhibit-read-only t))
 443               (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
 444
 445 ;; Shut up byte-compiler.
 446 (defvar font-lock-mode-hook)
 447 (defun mm-display-inline-fontify (handle &optional mode)
 448   "Insert HANDLE inline fontifying with MODE.
 449 If MODE is not set, try to find mode automatically."
 450   (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset))
 451         text coding-system)
 452     (unless (eq charset 'gnus-decoded)
 453       (mm-with-unibyte-buffer
 454         (mm-insert-part handle)
 455         (mm-decompress-buffer
 456          (mm-handle-filename handle)
 457          t t)
 458         (unless charset
 459           (setq coding-system (mm-find-buffer-file-coding-system)))
 460         (setq text (buffer-string))))
 461     (with-temp-buffer
 462       (buffer-disable-undo)
 463       (mm-enable-multibyte)
 464       (insert (cond ((eq charset 'gnus-decoded)
 465                      (with-current-buffer (mm-handle-buffer handle)
 466                        (buffer-string)))
 467                     (coding-system
 468                      (decode-coding-string text coding-system))
 469                     (charset
 470                      (mm-decode-string text charset))
 471                     (t
 472                      text)))
 473       (require 'font-lock)
 474       ;; I find font-lock a bit too verbose.
 475       (let ((font-lock-verbose nil)
 476             (font-lock-support-mode nil))
 477         ;; Disable support modes, e.g., jit-lock, lazy-lock, etc.
 478         ;; Note: XEmacs people use `font-lock-mode-hook' to run those modes.
 479         (set (make-local-variable 'font-lock-mode-hook) nil)
 480         (setq buffer-file-name (mm-handle-filename handle))
 481         (set (make-local-variable 'enable-local-variables) nil)
 482         (with-demoted-errors
 483           (if mode
 484               (save-window-excursion
 485                 (switch-to-buffer (current-buffer))
 486                 (funcall mode))
 487             (let ((auto-mode-alist
 488                    (delq (rassq 'doc-view-mode-maybe auto-mode-alist)
 489                          (copy-sequence auto-mode-alist))))
 490               (set-auto-mode)))
 491           ;; The mode function might have already turned on font-lock.
 492           ;; Do not fontify if the guess mode is fundamental.
 493           (unless (or font-lock-mode
 494                       (eq major-mode 'fundamental-mode))
 495             (font-lock-ensure))))
 496       (setq text (buffer-string))
 497       ;; Set buffer unmodified to avoid confirmation when killing the
 498       ;; buffer.
 499       (set-buffer-modified-p nil))
 500     (mm-insert-inline handle text)))
 501
 502 ;; Shouldn't these functions check whether the user even wants to use
 503 ;; font-lock?  Also, it would be nice to change for the size of the
 504 ;; fontified region.
 505
 506 (defun mm-display-patch-inline (handle)
 507   (mm-display-inline-fontify handle 'diff-mode))
 508
 509 (defun mm-display-elisp-inline (handle)
 510   (mm-display-inline-fontify handle 'emacs-lisp-mode))
 511
 512 (defun mm-display-dns-inline (handle)
 513   (mm-display-inline-fontify handle 'dns-mode))
 514
 515 (defun mm-display-org-inline (handle)
 516   "Show an Org mode text from HANDLE inline."
 517   (mm-display-inline-fontify handle 'org-mode))
 518
 519 (defun mm-display-shell-script-inline (handle)
 520   "Show a shell script from HANDLE inline."
 521   (mm-display-inline-fontify handle 'shell-script-mode))
 522
 523 (defun mm-display-javascript-inline (handle)
 524   "Show JavsScript code from HANDLE inline."
 525   (mm-display-inline-fontify handle 'javascript-mode))
 526
 527 ;;      id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 528 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 }
 529 (defvar mm-pkcs7-signed-magic
 530   (concat
 531     "0"
 532     "\\(\\(\x80\\)"
 533     "\\|\\(\x81\\(.\\|\n\\)\\{1\\}\\)"
 534     "\\|\\(\x82\\(.\\|\n\\)\\{2\\}\\)"
 535     "\\|\\(\x83\\(.\\|\n\\)\\{3\\}\\)"
 536     "\\)"
 537     "\x06\x09\\*\x86H\x86\xf7\x0d\x01\x07\x02"))
 538
 539 ;;      id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 540 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
 541 (defvar mm-pkcs7-enveloped-magic
 542   (concat
 543     "0"
 544     "\\(\\(\x80\\)"
 545     "\\|\\(\x81\\(.\\|\n\\)\\{1\\}\\)"
 546     "\\|\\(\x82\\(.\\|\n\\)\\{2\\}\\)"
 547     "\\|\\(\x83\\(.\\|\n\\)\\{3\\}\\)"
 548     "\\)"
 549     "\x06\x09\\*\x86H\x86\xf7\x0d\x01\x07\x03"))
 550
 551 (defun mm-view-pkcs7-get-type (handle)
 552   (mm-with-unibyte-buffer
 553     (mm-insert-part handle)
 554     (cond ((looking-at mm-pkcs7-enveloped-magic)
 555            'enveloped)
 556           ((looking-at mm-pkcs7-signed-magic)
 557            'signed)
 558           (t
 559            (error "Could not identify PKCS#7 type")))))
 560
 561 (defun mm-view-pkcs7 (handle &optional from)
 562   (case (mm-view-pkcs7-get-type handle)
 563     (enveloped (mm-view-pkcs7-decrypt handle from))
 564     (signed (mm-view-pkcs7-verify handle))
 565     (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
 566
 567 (defun mm-view-pkcs7-verify (handle)
 568   (let ((verified nil))
 569     (with-temp-buffer
 570       (insert "MIME-Version: 1.0\n")
 571       (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
 572       (insert-buffer-substring (mm-handle-buffer handle))
 573       (setq verified (smime-verify-region (point-min) (point-max))))
 574     (goto-char (point-min))
 575     (mm-insert-part handle)
 576     (if (search-forward "Content-Type: " nil t)
 577         (delete-region (point-min) (match-beginning 0)))
 578     (goto-char (point-max))
 579     (if (re-search-backward "--\r?\n?" nil t)
 580         (delete-region (match-end 0) (point-max)))
 581     (unless verified
 582       (insert-buffer-substring smime-details-buffer)))
 583   (goto-char (point-min))
 584   (while (search-forward "\r\n" nil t)
 585     (replace-match "\n"))
 586   t)
 587
 588 (autoload 'epg-decrypt-string "epg")
 589
 590 (defun mm-view-pkcs7-decrypt (handle &optional from)
 591   (insert-buffer-substring (mm-handle-buffer handle))
 592   (goto-char (point-min))
 593   (if (eq mml-smime-use 'epg)
 594       ;; Use EPG/gpgsm
 595       (let ((part (base64-decode-string (buffer-string))))
 596         (erase-buffer)
 597         (insert (epg-decrypt-string (epg-make-context 'CMS) part)))
 598     ;; Use openssl
 599     (insert "MIME-Version: 1.0\n")
 600     (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
 601     (smime-decrypt-region
 602      (point-min) (point-max)
 603      (if (= (length smime-keys) 1)
 604          (cadar smime-keys)
 605        (smime-get-key-by-email
 606         (gnus-completing-read
 607          "Decipher using key"
 608          smime-keys nil nil nil (car-safe (car-safe smime-keys)))))
 609      from))
 610   (goto-char (point-min))
 611   (while (search-forward "\r\n" nil t)
 612     (replace-match "\n"))
 613   (goto-char (point-min)))
 614
 615 (provide 'mm-view)
 616
 617 ;;; mm-view.el ends here