mime-pgp.el

   1 ;;; mime-pgp.el --- mime-view internal methods for PGP.
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;;      Daiki Ueno <ueno@unixuser.org>
   7 ;; Created: 1995/12/7
   8 ;;      Renamed: 1997/2/27 from tm-pgp.el
   9 ;; Keywords: PGP, security, MIME, multimedia, mail, news
  10
  11 ;; This file is part of SEMI (Secure Emacs MIME Interface).
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29
  30 ;;; Code:
  31
  32 (require 'mime-play)
  33 (require 'epg)
  34 (require 'epa)
  35
  36 ;;; @ Internal method for multipart/signed
  37
  38 (defun mime-verify-multipart/signed (entity situation)
  39   "Internal method to verify multipart/signed."
  40   (mime-play-entity
  41    (nth 1 (mime-entity-children entity)) ; entity-info of signature
  42    (list (assq 'mode situation)) ; play-mode
  43    ))
  44
  45
  46 ;;; @ Internal method for application/*-signature
  47
  48 (defun mime-verify-application/*-signature (entity situation)
  49   (let* ((mother (mime-entity-parent entity))
  50          (orig-entity (car (mime-entity-children mother)))
  51          (protocol (cdr (assoc "protocol" (mime-entity-parameters mother))))
  52          (context (epg-make-context
  53                    (if (equal protocol "application/pgp-signature")
  54                        'OpenPGP
  55                      (if (string-match
  56                           "\\`application/\\(x-\\)?pkcs7-signature\\'"
  57                           protocol)
  58                        'CMS
  59                        (error "Unknown protocol: %s" protocol)))))
  60          verify-result)
  61     (epg-verify-string context
  62                        (mime-entity-content entity)
  63                        (with-temp-buffer
  64                          (if (fboundp 'set-buffer-multibyte)
  65                              (set-buffer-multibyte nil))
  66                          (mime-insert-entity orig-entity)
  67                          (goto-char (point-min))
  68                          (while (search-forward "\n" nil t)
  69                            (replace-match "\r\n"))
  70                          (buffer-substring (point-min) (point-max))))
  71     (setq verify-result (epg-context-result-for context 'verify))
  72     (if (> (length verify-result) 1)
  73         (mime-show-echo-buffer (epg-verify-result-to-string verify-result))
  74       (if verify-result
  75           (epa-display-verify-result verify-result)))))
  76
  77
  78 ;;; @ Internal method for application/pgp-encrypted
  79
  80 (defun mime-decrypt-application/pgp-encrypted (entity situation)
  81   (let* ((mother (mime-entity-parent entity))
  82          (encrypted-entity (nth 1 (mime-entity-children mother)))
  83          (p-win (or (get-buffer-window (current-buffer))
  84                     (get-largest-window)))
  85          (new-name
  86           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
  87          (mother (current-buffer))
  88          (preview-buffer (concat "*Preview-" (buffer-name) "*"))
  89          representation-type message-buf context plain verify-result)
  90     (set-buffer (setq message-buf (get-buffer-create new-name)))
  91     (erase-buffer)
  92     (mime-insert-entity encrypted-entity)
  93     (goto-char (point-min))
  94     (setq context (epg-make-context)
  95           plain (decode-coding-string
  96                  (epg-decrypt-string
  97                   context
  98                   (buffer-substring (point-min)(point-max)))
  99                  'raw-text))
 100     (delete-region (point-min)(point-max))
 101     (insert plain)
 102     (setq representation-type 'binary
 103           major-mode 'mime-show-message-mode)
 104     (save-window-excursion
 105       (mime-view-buffer nil preview-buffer mother
 106                         nil representation-type)
 107       (make-local-variable 'mime-view-temp-message-buffer)
 108       (setq mime-view-temp-message-buffer message-buf))
 109     (set-window-buffer p-win preview-buffer)
 110     (setq verify-result (epg-context-result-for context 'verify))
 111     (if (> (length verify-result) 1)
 112         (mime-show-echo-buffer (epg-verify-result-to-string verify-result))
 113       (if verify-result
 114           (epa-display-verify-result verify-result)))))
 115
 116
 117 ;;; @ Internal method for application/pgp-keys
 118
 119 (defun mime-add-application/pgp-keys (entity situation)
 120   (epg-import-keys-from-string (epg-make-context)
 121                                (mime-entity-content entity)))
 122
 123
 124 ;;; @ Internal method for application/pkcs7-mime
 125
 126 (defun mime-view-application/pkcs7-mime (entity situation)
 127   (let* ((p-win (or (get-buffer-window (current-buffer))
 128                     (get-largest-window)))
 129          (new-name
 130           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
 131          (mother (current-buffer))
 132          (preview-buffer (concat "*Preview-" (buffer-name) "*"))
 133          (context (epg-make-context 'CMS))
 134          message-buf)
 135     (when (memq (or (cdr (assq 'smime-type situation)) 'enveloped-data)
 136                 '(enveloped-data signed-data))
 137       (set-buffer (setq message-buf (get-buffer-create new-name)))
 138       (let ((inhibit-read-only t)
 139             buffer-read-only)
 140         (erase-buffer)
 141         (insert (epg-decrypt-string context (mime-entity-content entity))))
 142       (setq major-mode 'mime-show-message-mode)
 143       (save-window-excursion
 144         (mime-view-buffer nil preview-buffer mother
 145                           nil 'binary)
 146         (make-local-variable 'mime-view-temp-message-buffer)
 147         (setq mime-view-temp-message-buffer message-buf))
 148       (set-window-buffer p-win preview-buffer))))
 149
 150
 151 ;;; @ end
 152 ;;;
 153
 154 (provide 'mime-pgp)
 155
 156 (run-hooks 'mime-pgp-load-hook)
 157
 158 ;;; mime-pgp.el ends here