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