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 ;;    This module is based on
  31
  32 ;;      [security-multipart] RFC 1847: "Security Multiparts for MIME:
  33 ;;          Multipart/Signed and Multipart/Encrypted" by
  34 ;;          Jim Galvin <galvin@tis.com>, Sandy Murphy <sandy@tis.com>,
  35 ;;          Steve Crocker <crocker@cybercash.com> and
  36 ;;          Ned Freed <ned@innosoft.com> (1995/10)
  37
  38 ;;      [PGP/MIME] RFC 2015: "MIME Security with Pretty Good Privacy
  39 ;;          (PGP)" by Michael Elkins <elkins@aero.org> (1996/6)
  40
  41 ;;      [PGP-kazu] draft-kazu-pgp-mime-00.txt: "PGP MIME Integration"
  42 ;;          by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
  43 ;;          expired)
  44
  45 ;;      [OpenPGP/MIME] draft-ietf-openpgp-mime-02.txt: "MIME
  46 ;;          Security with OpenPGP" by
  47 ;;          John W. Noerenberg II <jwn2@qualcomm.com>,
  48 ;;          Dave Del Torto <ddt@cryptorights.org> and
  49 ;;          Michael Elkins <michael_elkins@nai.com> (2000/8)
  50
  51 ;;; Code:
  52
  53 (require 'mime-play)
  54
  55 (defvar mime-pgp-use
  56   (condition-case nil
  57       (progn
  58         (require 'epg-config)
  59         (epg-check-configuration (epg-configuration))
  60         (autoload 'epg-make-context "epg")
  61         'epg)
  62     (error
  63      (require 'pgg-def)
  64      (autoload 'pgg-decrypt-region "pgg"
  65        "PGP decryption of current region." t)
  66      (autoload 'pgg-verify-region "pgg"
  67        "PGP verification of current region." t)
  68      (autoload 'pgg-snarf-keys-region "pgg"
  69        "Snarf PGP public keys in current region." t)
  70      'pgg))
  71   "Which PGG library to be used.")
  72
  73 ;;; @ Internal method for multipart/signed
  74 ;;;
  75 ;;; It is based on RFC 1847 (security-multipart).
  76
  77 (defun mime-verify-multipart/signed (entity situation)
  78   "Internal method to verify multipart/signed."
  79   (mime-play-entity
  80    (nth 1 (mime-entity-children entity)) ; entity-info of signature
  81    (list (assq 'mode situation)) ; play-mode
  82    ))
  83
  84
  85 ;;; @ internal method for application/pgp
  86 ;;;
  87 ;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu).
  88
  89 (defun mime-view-application/pgp-with-epg (entity situation)
  90   (let* ((p-win (or (get-buffer-window (current-buffer))
  91                     (get-largest-window)))
  92          (new-name
  93           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
  94          (mother (current-buffer))
  95          (preview-buffer (concat "*Preview-" (buffer-name) "*"))
  96          representation-type message-buf context plain)
  97     (set-buffer (setq message-buf (get-buffer-create new-name)))
  98     (erase-buffer)
  99     (mime-insert-entity entity)
 100     (cond ((progn
 101              (goto-char (point-min))
 102              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
 103            (setq context (epg-make-context))
 104            (epg-verify-string
 105             context
 106             (buffer-substring (match-beginning 0)(point-max)))
 107            (goto-char (point-min))
 108            (delete-region
 109             (point-min)
 110             (and
 111              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
 112              (match-end 0)))
 113            (delete-region
 114             (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
 115                  (match-beginning 0))
 116             (point-max))
 117            (goto-char (point-min))
 118            (while (re-search-forward "^- -" nil t)
 119              (replace-match "-"))
 120            (setq representation-type (if (mime-entity-cooked-p entity)
 121                                          'cooked)))
 122           ((progn
 123              (goto-char (point-min))
 124              (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
 125            (setq context (epg-make-context))
 126            (setq plain
 127                  (decode-coding-string
 128                   (epg-decrypt-string
 129                    context
 130                    (buffer-substring (point-min)(point-max)))
 131                   'raw-text))
 132            (delete-region (point-min)(point-max))
 133            (insert plain)
 134            (setq representation-type 'binary)
 135            ))
 136     (setq major-mode 'mime-show-message-mode)
 137     (save-window-excursion
 138       (mime-view-buffer nil preview-buffer mother
 139                         nil representation-type)
 140       (make-local-variable 'mime-view-temp-message-buffer)
 141       (setq mime-view-temp-message-buffer message-buf))
 142     (set-window-buffer p-win preview-buffer)
 143     (if (and context
 144              (epg-context-result-for context 'verify))
 145         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 146
 147 (defun mime-view-application/pgp-with-pgg (entity situation)
 148   (let* ((p-win (or (get-buffer-window (current-buffer))
 149                     (get-largest-window)))
 150          (new-name
 151           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
 152          (mother (current-buffer))
 153          (preview-buffer (concat "*Preview-" (buffer-name) "*"))
 154          representation-type message-buf)
 155     (set-buffer (setq message-buf (get-buffer-create new-name)))
 156     (erase-buffer)
 157     (mime-insert-entity entity)
 158     (cond ((progn
 159              (goto-char (point-min))
 160              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
 161            (pgg-verify-region (match-beginning 0)(point-max) nil 'fetch)
 162            (goto-char (point-min))
 163            (delete-region
 164             (point-min)
 165             (and
 166              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
 167              (match-end 0)))
 168            (delete-region
 169             (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
 170                  (match-beginning 0))
 171             (point-max))
 172            (goto-char (point-min))
 173            (while (re-search-forward "^- -" nil t)
 174              (replace-match "-"))
 175            (setq representation-type (if (mime-entity-cooked-p entity)
 176                                          'cooked)))
 177           ((progn
 178              (goto-char (point-min))
 179              (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
 180            (pgg-decrypt-region (point-min)(point-max))
 181            (delete-region (point-min)(point-max))
 182            (insert-buffer pgg-output-buffer)
 183            (setq representation-type 'binary)))
 184     (setq major-mode 'mime-show-message-mode)
 185     (save-window-excursion
 186       (mime-view-buffer nil preview-buffer mother
 187                         nil representation-type)
 188       (make-local-variable 'mime-view-temp-message-buffer)
 189       (setq mime-view-temp-message-buffer message-buf))
 190     (set-window-buffer p-win preview-buffer)))
 191
 192
 193 (defun mime-verify-application/*-signature (entity situation)
 194   (if (eq mime-pgp-use 'epg)
 195       (mime-verify-application/*-signature-with-epg entity situation)
 196     (mime-verify-application/*-signature-with-pgg entity situation)))
 197
 198 (defun mime-verify-application/*-signature-with-epg (entity situation)
 199   (let* ((entity-node-id (mime-entity-node-id entity))
 200          (mother (mime-entity-parent entity))
 201          (knum (car entity-node-id))
 202          (onum (if (> knum 0)
 203                    (1- knum)
 204                  (1+ knum)))
 205          (orig-entity (nth onum (mime-entity-children mother)))
 206          (protocol (cdr (assoc "protocol" (mime-entity-parameters mother))))
 207          (context (epg-make-context
 208                    (if (equal protocol "application/pgp-signature")
 209                        'OpenPGP
 210                      (if (string-match
 211                           "\\`application/\\(x-\\)?pkcs7-signature\\'"
 212                           protocol)
 213                        'CMS
 214                        (error "Unknown protocol: %s" protocol))))))
 215     (epg-verify-string context
 216                        (mime-entity-content entity)
 217                        (with-temp-buffer
 218                          (if (fboundp 'set-buffer-multibyte)
 219                              (set-buffer-multibyte nil))
 220                          (mime-insert-entity orig-entity)
 221                          (goto-char (point-min))
 222                          (while (search-forward "\n" nil t)
 223                            (replace-match "\r\n"))
 224                          (buffer-substring (point-min) (point-max))))
 225     (if (epg-context-result-for context 'verify)
 226         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 227
 228 (defun mime-verify-application/*-signature-with-pgg (entity situation)
 229   (let* ((entity-node-id (mime-entity-node-id entity))
 230          (mother (mime-entity-parent entity))
 231          (knum (car entity-node-id))
 232          (onum (if (> knum 0)
 233                    (1- knum)
 234                  (1+ knum)))
 235          (orig-entity (nth onum (mime-entity-children mother)))
 236          (protocol (cdr (assoc "protocol" (mime-entity-parameters mother))))
 237          (sig-file (make-temp-file "tm" nil ".asc")))
 238     (unless (equal protocol "application/pgp-signature")
 239       (error "Not supported protocol: %s" protocol))
 240     (save-excursion
 241       (mime-show-echo-buffer)
 242       (set-buffer mime-echo-buffer-name)
 243       (set-window-start
 244        (get-buffer-window mime-echo-buffer-name)
 245        (point-max)))
 246     (mime-write-entity-content entity sig-file)
 247     (unwind-protect
 248         (with-temp-buffer
 249           (mime-insert-entity orig-entity)
 250           (goto-char (point-min))
 251           (while (progn (end-of-line) (not (eobp)))
 252             (insert "\r")
 253             (forward-line 1))
 254           (pgg-verify-region (point-min)(point-max)
 255                              sig-file 'fetch)
 256           (save-excursion
 257             (set-buffer mime-echo-buffer-name)
 258             (insert-buffer-substring pgg-errors-buffer)))
 259       (delete-file sig-file))))
 260
 261
 262 ;;; @ Internal method for application/pgp-encrypted
 263 ;;;
 264 ;;; It is based on RFC 2015 (PGP/MIME) and
 265 ;;; draft-ietf-openpgp-mime-02.txt (OpenPGP/MIME).
 266
 267 (defun mime-decrypt-application/pgp-encrypted (entity situation)
 268   (let* ((entity-node-id (mime-entity-node-id entity))
 269          (mother (mime-entity-parent entity))
 270          (knum (car entity-node-id))
 271          (onum (if (> knum 0)
 272                    (1- knum)
 273                  (1+ knum)))
 274          (orig-entity (nth onum (mime-entity-children mother))))
 275     (if (eq mime-pgp-use 'epg)
 276         (mime-view-application/pgp-with-epg orig-entity situation)
 277       (mime-view-application/pgp-with-pgg orig-entity situation))))
 278
 279
 280 ;;; @ Internal method for application/pgp-keys
 281 ;;;
 282 ;;; It is based on RFC 2015 (PGP/MIME) and
 283 ;;; draft-ietf-openpgp-mime-02.txt (OpenPGP/MIME).
 284
 285 (defun mime-add-application/pgp-keys (entity situation)
 286   (if (eq mime-pgp-use 'epg)
 287       (mime-add-application/pgp-keys-with-epg entity situation)
 288     (mime-add-application/pgp-keys-with-pgg entity situation)))
 289
 290 (defun mime-add-application/pgp-keys-with-epg (entity situation)
 291   (epg-import-keys-from-string (epg-make-context)
 292                                (mime-entity-content entity)))
 293
 294 (defun mime-add-application/pgp-keys-with-pgg (entity situation)
 295   (save-excursion
 296     (mime-show-echo-buffer)
 297     (set-buffer mime-echo-buffer-name)
 298     (set-window-start
 299      (get-buffer-window mime-echo-buffer-name)
 300      (point-max)))
 301   (with-temp-buffer
 302     (mime-insert-entity-content entity)
 303     (mime-decode-region (point-min) (point-max)
 304                         (cdr (assq 'encoding situation)))
 305     (pgg-snarf-keys-region (point-min)(point-max))
 306     (save-excursion
 307       (set-buffer mime-echo-buffer-name)
 308       (insert-buffer-substring pgg-errors-buffer))))
 309
 310 ;;; @ Internal method for application/pkcs7-mime
 311 ;;;
 312 ;;; It is based on RFC 2633 (S/MIME version 3).
 313
 314 (defun mime-view-application/pkcs7-mime (entity situation)
 315   (let* ((p-win (or (get-buffer-window (current-buffer))
 316                     (get-largest-window)))
 317          (new-name
 318           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
 319          (mother (current-buffer))
 320          (preview-buffer (concat "*Preview-" (buffer-name) "*"))
 321          (context (epg-make-context 'CMS))
 322          message-buf)
 323     (when (memq (or (cdr (assq 'smime-type situation)) 'enveloped-data)
 324                 '(enveloped-data signed-data))
 325       (set-buffer (setq message-buf (get-buffer-create new-name)))
 326       (let ((inhibit-read-only t)
 327             buffer-read-only)
 328         (erase-buffer)
 329         (insert (epg-decrypt-string context (mime-entity-content entity))))
 330       (setq major-mode 'mime-show-message-mode)
 331       (save-window-excursion
 332         (mime-view-buffer nil preview-buffer mother
 333                           nil 'binary)
 334         (make-local-variable 'mime-view-temp-message-buffer)
 335         (setq mime-view-temp-message-buffer message-buf))
 336       (set-window-buffer p-win preview-buffer))))
 337
 338
 339 ;;; @ end
 340 ;;;
 341
 342 (provide 'mime-pgp)
 343
 344 (run-hooks 'mime-pgp-load-hook)
 345
 346 ;;; mime-pgp.el ends here