mime-pgp.el

   1 ;;; mime-pgp.el --- mime-view internal methods for either PGP or GnuPG.
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;;         Katsumi Yamaoka  <yamaoka@jpl.org>
   7 ;; Created: 1995/12/7
   8 ;;      Renamed: 1997/2/27 from tm-pgp.el
   9 ;; Keywords: PGP, GnuPG, 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., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, 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 ;;; Code:
  46
  47 (require 'std11)
  48 (require 'semi-def)
  49 (require 'mime-play)
  50
  51
  52 ;;; @ Internal method for multipart/signed
  53 ;;;
  54 ;;; It is based on RFC 1847 (security-multipart).
  55
  56 (defun mime-verify-multipart/signed (entity situation)
  57   "Internal method to verify multipart/signed."
  58   (mime-play-entity
  59    (nth 1 (mime-entity-children entity)) ; entity-info of signature
  60    (list (assq 'mode situation)) ; play-mode
  61    ))
  62
  63
  64 ;;; @ internal method for application/pgp
  65 ;;;
  66 ;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu).
  67
  68 (defun mime-view-application/pgp (entity situation)
  69   (let* ((p-win (or (get-buffer-window (current-buffer))
  70                     (get-largest-window)))
  71          (new-name
  72           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
  73          (mother (current-buffer))
  74          representation-type)
  75     (set-buffer (get-buffer-create new-name))
  76     (erase-buffer)
  77     (mime-insert-entity entity)
  78     (cond ((progn
  79              (goto-char (point-min))
  80              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
  81            (funcall (pgp-function 'verify))
  82            (goto-char (point-min))
  83            (delete-region
  84             (point-min)
  85             (and
  86              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
  87              (match-end 0)))
  88            (delete-region
  89             (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
  90                  (match-beginning 0))
  91             (point-max))
  92            (goto-char (point-min))
  93            (while (re-search-forward "^- -" nil t)
  94              (replace-match "-")
  95              )
  96            (setq representation-type (if (mime-entity-cooked-p entity)
  97                                          'cooked))
  98            )
  99           ((progn
 100              (goto-char (point-min))
 101              (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
 102            (as-binary-process (funcall (pgp-function 'decrypt)))
 103            (goto-char (point-min))
 104            (delete-region (point-min)
 105                           (and
 106                            (search-forward "\n\n")
 107                            (match-end 0)))
 108            (setq representation-type 'binary)
 109            ))
 110     (setq major-mode 'mime-show-message-mode)
 111     (save-window-excursion (mime-view-buffer nil nil mother
 112                                              nil representation-type))
 113     (set-window-buffer p-win mime-preview-buffer)
 114     ))
 115
 116 (defun mime-pgp-detect-version (entity)
 117   "Detect PGP version from detached signature."
 118   (with-temp-buffer
 119     (mime-insert-entity-content entity)
 120     (std11-narrow-to-header)
 121     (let ((version (std11-fetch-field "Version")))
 122       (cond ((not version)
 123              pgp-version)
 124             ((string-match "GnuPG" version)
 125              'gpg)
 126             ((string-match "5\\.0i" version)
 127              'pgp50)
 128             ((string-match "2\\.6" version)
 129              'pgp)
 130             (t
 131              pgp-version)))))
 132
 133
 134 ;;; @ Internal method for application/pgp-signature
 135 ;;;
 136 ;;; It is based on RFC 2015 (PGP/MIME).
 137
 138 (defcustom mime-pgp-command-alist '((gpg   . "gpg")
 139                                     (pgp50 . "pgp")
 140                                     (pgp   . "pgp"))
 141   "Alist of the schemes and the name of the commands.  Valid SCHEMEs are:
 142
 143    gpg   - GnuPG.
 144    pgp50 - PGP version 5.0i.
 145    pgp   - PGP version 2.6.
 146
 147 COMMAND for `pgp50' must *NOT* have a suffix, like neither \"pgpe\", \"pgpk\",
 148 \"pgps\" nor \"pgpv\"."
 149   :group 'mime
 150   :type '(repeat (cons :format "%v"
 151                        (choice (choice-item :tag "GnuPG" gpg)
 152                                (choice-item :tag "PGP 5.0i" pgp50)
 153                                (choice-item :tag "PGP 2.6" pgp))
 154                        (string :tag "Command"))))
 155
 156 (defcustom mime-pgp-default-language-alist '((gpg   . nil)
 157                                              (pgp50 . us)
 158                                              (pgp   . en))
 159   "Alist of the schemes and the symbol of languages.  It should be ISO 639
 160 2 letter language code such as en, ja, ...  Each element looks like
 161 \(SCHEME . SYMBOL).  See also `mime-pgp-command-alist' for valid SCHEMEs."
 162   :group 'mime
 163   :type '(repeat (cons :format "%v"
 164                        (choice (choice-item :tag "GnuPG" gpg)
 165                                (choice-item :tag "PGP 5.0i" pgp50)
 166                                (choice-item :tag "PGP 2.6" pgp))
 167                        (symbol :tag "Language"))))
 168
 169 (defcustom mime-pgp-good-signature-regexp-alist
 170   '((gpg
 171      (nil "Good signature from.*$" nil)
 172      )
 173     (pgp50
 174      (us "Good signature made .* by key:$"
 175          mime-pgp-good-signature-post-function-pgp50-us)
 176      )
 177     (pgp
 178      (en "Good signature from user.*$" nil)
 179      ))
 180   "Alist of the schemes and alist of the languages and the regexps for
 181 detecting ``Good signature''.  The optional symbol of the post processing
 182 function for arranging the output message can be specified in each element.
 183 It will be called just after re-search is done successfully, and it is
 184 expected that the function returns a string for messaging."
 185   :group 'mime
 186   :type '(repeat (cons :format "%v"
 187                        (choice (choice-item :tag "GnuPG" gpg)
 188                                (choice-item :tag "PGP 5.0i" pgp50)
 189                                (choice-item :tag "PGP 2.6" pgp))
 190                        (repeat (list :format "%v"
 191                                      (symbol :tag "Language")
 192                                      (regexp :tag "Regexp")
 193                                      (function :tag "Post Function"))))))
 194
 195 (defcustom mime-pgp-key-expected-regexp-alist
 196   '((gpg
 197      (nil
 198       .
 199       "key ID \\(\\S +\\)\ngpg: Can't check signature: public key not found")
 200      )
 201     (pgp50
 202      (us . "Signature by unknown keyid: 0x\\(\\S +\\)")
 203      )
 204     (pgp
 205      (en . "Key matching expected Key ID \\(\\S +\\) not found")
 206      ))
 207   "Alist of the schemes and alist of the languages and regexps for detecting
 208 ``Key expected''."
 209   :group 'mime
 210   :type '(repeat (cons :format "%v"
 211                        (choice (choice-item :tag "GnuPG" gpg)
 212                                (choice-item :tag "PGP 5.0i" pgp50)
 213                                (choice-item :tag "PGP 2.6" pgp))
 214                        (repeat (cons :format "%v"
 215                                      (symbol :tag "Language")
 216                                      (regexp :tag "Regexp"))))))
 217
 218 (defmacro mime-pgp-command (&optional suffix)
 219   "Return a suitable command.  SUFFIX should be either \"e\", \"k\", \"s\"
 220 or \"v\" for choosing a command of PGP 5.0i."
 221   (` (let ((command (cdr (assq pgp-version mime-pgp-command-alist))))
 222        (if (and command
 223                 (progn
 224                   (if (eq 'pgp50 pgp-version)
 225                       (setq command (format "%s%s" command (, suffix))))
 226                   (exec-installed-p command)))
 227            command
 228          (error "Please specify the valid command name for `%s'."
 229                 (or pgp-version 'pgp-version))))))
 230
 231 (defmacro mime-pgp-default-language ()
 232   "Return a symbol of language."
 233   '(cond ((eq 'gpg pgp-version)
 234           nil)
 235          ((eq 'pgp50 pgp-version)
 236           (or (cdr (assq pgp-version mime-pgp-default-language-alist)) 'us)
 237           )
 238          (t
 239           (or (cdr (assq pgp-version mime-pgp-default-language-alist)) 'en)
 240           )))
 241
 242 (defmacro mime-pgp-good-signature-regexp ()
 243   "Return a regexp to detect ``Good signature''."
 244   '(nth 1
 245         (assq
 246          (mime-pgp-default-language)
 247          (cdr (assq pgp-version mime-pgp-good-signature-regexp-alist))
 248          )))
 249
 250 (defmacro mime-pgp-good-signature-post-function ()
 251   "Return a post processing function for arranging the message for
 252 ``Good signature''."
 253   '(nth 2
 254         (assq
 255          (mime-pgp-default-language)
 256          (cdr (assq pgp-version mime-pgp-good-signature-regexp-alist))
 257          )))
 258
 259 (defmacro mime-pgp-key-expected-regexp ()
 260   "Return a regexp to detect ``Key expected''."
 261   '(cdr (assq (mime-pgp-default-language)
 262               (cdr (assq pgp-version mime-pgp-key-expected-regexp-alist))
 263               )))
 264
 265 (defun mime-pgp-check-signature (output-buffer orig-file)
 266   (with-current-buffer output-buffer
 267     (erase-buffer)
 268     (setq truncate-lines t))
 269   (let* ((lang (mime-pgp-default-language))
 270          (command (mime-pgp-command 'v))
 271          (args (cond ((eq 'gpg pgp-version)
 272                       (list "--batch" "--verify"
 273                             (concat orig-file ".sig"))
 274                       )
 275                      ((eq 'pgp50 pgp-version)
 276                       (list "+batchmode=1"
 277                             (format "+language=%s" lang)
 278                             (concat orig-file ".sig"))
 279                       )
 280                      ((eq 'pgp pgp-version)
 281                       (list (format "+language=%s" lang) orig-file))
 282                      ))
 283          (regexp (mime-pgp-good-signature-regexp))
 284          (post-function (mime-pgp-good-signature-post-function))
 285          )
 286     (if (zerop (apply 'call-process-region
 287                       (point-min) (point-max) command nil output-buffer nil
 288                       args))
 289         (with-current-buffer output-buffer
 290           (goto-char (point-min))
 291           (cond
 292            ((not (stringp regexp))
 293             (message "Please specify right regexp for specified language")
 294             )
 295            ((re-search-forward regexp nil t)
 296             (message (if post-function
 297                          (funcall post-function)
 298                        (buffer-substring (match-beginning 0) (match-end 0))))
 299             (goto-char (point-min))
 300             )
 301            (t
 302             (message "Bad signature")
 303             ;; PGP 5.0i always returns 0 status, so returns nil
 304             ;; in order for attempt to fetch key.
 305             (not (eq 'pgp50 pgp-version))
 306             ))
 307           )
 308       (message "Bad signature")
 309       nil)))
 310
 311 (defmacro mime-pgp-parse-verify-error (&rest forms)
 312   (` (with-current-buffer mime-echo-buffer-name
 313        (goto-char (point-min))
 314        (prog1
 315            (let ((regexp (mime-pgp-key-expected-regexp)))
 316              (cond
 317               ((not (stringp regexp))
 318                (message "Please specify right regexp for specified language")
 319                nil
 320                )
 321               ((re-search-forward regexp nil t)
 322                (concat "0x" (buffer-substring-no-properties
 323                              (match-beginning 1) (match-end 1)))
 324                )))
 325          (,@ forms)
 326          ))))
 327
 328 (defun mime-pgp-parse-verify-error-for-gpg ()
 329   "Subroutine used for parsing verify error with GnuPG.  Returns expected
 330 key-ID if it is found."
 331   (mime-pgp-parse-verify-error
 332    (set-window-start (get-buffer-window mime-echo-buffer-name) (point-min))
 333    ))
 334
 335 (defun mime-pgp-parse-verify-error-for-pgp50 ()
 336   "Subroutine used for parsing verify error with PGP 5.0i.  Returns expected
 337 key-ID if it is found."
 338   (mime-pgp-parse-verify-error
 339    (goto-char (point-min))
 340    (forward-line 1)
 341    (set-window-start (get-buffer-window mime-echo-buffer-name) (point))
 342    ))
 343
 344 (defun mime-pgp-parse-verify-error-for-pgp ()
 345   "Subroutine used for parsing verify error with PGP 2.6.  Returns expected
 346 key-ID if it is found."
 347   (mime-pgp-parse-verify-error
 348    (goto-char (point-min))
 349    (if (search-forward "\C-g" nil t)
 350        (goto-char (match-beginning 0))
 351      (forward-line 7))
 352    (set-window-start (get-buffer-window mime-echo-buffer-name) (point))
 353    ))
 354
 355 (defun mime-verify-application/pgp-signature (entity situation)
 356   "Internal method to check PGP/MIME signature."
 357   (let* ((entity-node-id (mime-entity-node-id entity))
 358          (mother (mime-entity-parent entity))
 359          (knum (car entity-node-id))
 360          (onum (if (> knum 0)
 361                    (1- knum)
 362                  (1+ knum)))
 363          (orig-entity (nth onum (mime-entity-children mother)))
 364          (basename (expand-file-name "tm" temporary-file-directory))
 365          (orig-file (make-temp-name basename))
 366          (sig-file (concat orig-file ".sig"))
 367          (pgp-version (mime-pgp-detect-version entity))
 368          (parser (intern (format "mime-pgp-parse-verify-error-for-%s"
 369                                  pgp-version)))
 370          pgp-id done)
 371     (mime-write-entity orig-entity orig-file)
 372     (save-current-buffer (mime-show-echo-buffer))
 373     (mime-write-entity-content entity sig-file)
 374     (unwind-protect
 375         (while (not done)
 376           (if (setq done (mime-pgp-check-signature
 377                           mime-echo-buffer-name orig-file))
 378               (let ((other-window-scroll-buffer mime-echo-buffer-name))
 379                 (scroll-other-window
 380                  (cdr (assq pgp-version
 381                             '((gpg . 0) (pgp50 . 1) (pgp . 10)))))
 382                 )
 383             (if (and
 384                  (not pgp-id)
 385                  (setq pgp-id (funcall parser))
 386                  (prog1
 387                      (y-or-n-p (format "Key %s not found; attempt to fetch? "
 388                                        pgp-id))
 389                    (message ""))
 390                  )
 391                 (funcall (pgp-function 'fetch-key) (cons nil pgp-id))
 392               (funcall parser)
 393               (setq done t)
 394               )))
 395       (delete-file orig-file)
 396       (delete-file sig-file)
 397       )))
 398
 399 (defun mime-pgp-good-signature-post-function-pgp50-us ()
 400   (forward-line 2)
 401   (looking-at "\\s +\\(.+\\)$")
 402   (format "Good signature from %s" (match-string 1)))
 403
 404
 405 ;;; @ Internal method for application/pgp-encrypted
 406 ;;;
 407 ;;; It is based on RFC 2015 (PGP/MIME).
 408
 409 (defun mime-decrypt-application/pgp-encrypted (entity situation)
 410   (let* ((entity-node-id (mime-entity-node-id entity))
 411          (mother (mime-entity-parent entity))
 412          (knum (car entity-node-id))
 413          (onum (if (> knum 0)
 414                    (1- knum)
 415                  (1+ knum)))
 416          (orig-entity (nth onum (mime-entity-children mother)))
 417          (pgp-version (mime-pgp-detect-version orig-entity)))
 418     (mime-view-application/pgp orig-entity situation)
 419     ))
 420
 421
 422 ;;; @ Internal method for application/pgp-keys
 423 ;;;
 424 ;;; It is based on RFC 2015 (PGP/MIME).
 425
 426 (defun mime-add-application/pgp-keys (entity situation)
 427   (let* ((start (mime-entity-point-min entity))
 428          (end (mime-entity-point-max entity))
 429          (entity-number (mime-raw-point-to-entity-number start))
 430          (new-name (format "%s-%s" (buffer-name) entity-number))
 431          (encoding (cdr (assq 'encoding situation)))
 432          str)
 433     (setq str (buffer-substring start end))
 434     (switch-to-buffer new-name)
 435     (setq buffer-read-only nil)
 436     (erase-buffer)
 437     (insert str)
 438     (goto-char (point-min))
 439     (if (re-search-forward "^\n" nil t)
 440         (delete-region (point-min) (match-end 0))
 441       )
 442     (mime-decode-region (point-min)(point-max) encoding)
 443     (funcall (pgp-function 'snarf-keys))
 444     (kill-buffer (current-buffer))
 445     ))
 446
 447
 448 ;;; @ end
 449 ;;;
 450
 451 (provide 'mime-pgp)
 452
 453 (run-hooks 'mime-pgp-load-hook)
 454
 455 ;;; mime-pgp.el ends here