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 ;;      [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME
  46 ;;          Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO
  47 ;;          <kazu@iijlab.net> (1998/1)
  48
  49 ;;; Code:
  50
  51 (require 'std11)
  52 (require 'semi-def)
  53 (require 'mime-play)
  54
  55 (defgroup mime-pgp nil
  56   "Internal methods for either PGP or GnuPG."
  57   :prefix "mime-pgp-"
  58   :group 'mime)
  59
  60 ;;; @ Internal method for multipart/signed
  61 ;;;
  62 ;;; It is based on RFC 1847 (security-multipart).
  63
  64 (defun mime-verify-multipart/signed (entity situation)
  65   "Internal method to verify multipart/signed."
  66   (mime-play-entity
  67    (nth 1 (mime-entity-children entity)) ; entity-info of signature
  68    (list (assq 'mode situation)) ; play-mode
  69    ))
  70
  71
  72 ;;; @ internal method for application/pgp
  73 ;;;
  74 ;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu).
  75
  76 (defun mime-view-application/pgp (entity situation)
  77   (let* ((p-win (or (get-buffer-window (current-buffer))
  78                     (get-largest-window)))
  79          (new-name
  80           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
  81          (mother (current-buffer))
  82          (preview-buffer (concat "*Preview-" (buffer-name) "*"))
  83          representation-type)
  84     (set-buffer (get-buffer-create new-name))
  85     (erase-buffer)
  86     (mime-insert-entity entity)
  87     (cond ((progn
  88              (goto-char (point-min))
  89              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
  90            (funcall (pgp-function 'verify))
  91            (goto-char (point-min))
  92            (delete-region
  93             (point-min)
  94             (and
  95              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
  96              (match-end 0)))
  97            (delete-region
  98             (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
  99                  (match-beginning 0))
 100             (point-max))
 101            (goto-char (point-min))
 102            (while (re-search-forward "^- -" nil t)
 103              (replace-match "-")
 104              )
 105            (setq representation-type (if (mime-entity-cooked-p entity)
 106                                          'cooked))
 107            )
 108           ((progn
 109              (goto-char (point-min))
 110              (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
 111            (as-binary-process (funcall (pgp-function 'decrypt)))
 112            (goto-char (point-min))
 113            (delete-region (point-min)
 114                           (and
 115                            (search-forward "\n\n")
 116                            (match-end 0)))
 117            (setq representation-type 'binary)
 118            ))
 119     (setq major-mode 'mime-show-message-mode)
 120     (save-window-excursion (mime-view-buffer nil preview-buffer mother
 121                                              nil representation-type))
 122     (set-window-buffer p-win preview-buffer)
 123     ))
 124
 125
 126 ;;; @ Internal method for application/pgp-signature
 127 ;;;
 128 ;;; It is based on RFC 2015 (PGP/MIME) and
 129 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
 130
 131 (defcustom mime-pgp-command-alist '((gpg   . "gpg")
 132                                     (pgp50 . "pgp")
 133                                     (pgp   . "pgp"))
 134   "Alist of the schemes and the name of the commands.  Valid SCHEMEs are:
 135
 136    gpg   - GnuPG.
 137    pgp50 - PGP version 5.0i.
 138    pgp   - PGP version 2.6.
 139
 140 COMMAND for `pgp50' must *NOT* have a suffix, like neither \"pgpe\", \"pgpk\",
 141 \"pgps\" nor \"pgpv\"."
 142   :group 'mime-pgp
 143   :type '(repeat (cons :format "%v"
 144                        (choice (choice-item :tag "GnuPG" gpg)
 145                                (choice-item :tag "PGP 5.0i" pgp50)
 146                                (choice-item :tag "PGP 2.6" pgp))
 147                        (string :tag "Command"))))
 148
 149 (defcustom mime-pgp-default-language-alist '((gpg   . nil)
 150                                              (pgp50 . us)
 151                                              (pgp   . en))
 152   "Alist of the schemes and the symbol of languages.  It should be ISO 639
 153 2 letter language code such as en, ja, ...  Each element looks like
 154 \(SCHEME . SYMBOL).  See also `mime-pgp-command-alist' for valid SCHEMEs."
 155   :group 'mime-pgp
 156   :type '(repeat (cons :format "%v"
 157                        (choice (choice-item :tag "GnuPG" gpg)
 158                                (choice-item :tag "PGP 5.0i" pgp50)
 159                                (choice-item :tag "PGP 2.6" pgp))
 160                        (symbol :tag "Language"))))
 161
 162 (defcustom mime-pgp-good-signature-regexp-alist
 163   '((gpg
 164      (nil "Good signature from.*$" nil)
 165      )
 166     (pgp50
 167      (us "Good signature made .* by key:$"
 168          mime-pgp-good-signature-post-function-pgp50-us)
 169      )
 170     (pgp
 171      (en "Good signature from user.*$" nil)
 172      ))
 173   "Alist of the schemes and alist of the languages and the regexps for
 174 detecting ``Good signature''.  The optional symbol of the post processing
 175 function for arranging the output message can be specified in each element.
 176 It will be called just after re-search is done successfully, and it is
 177 expected that the function returns a string for messaging."
 178   :group 'mime-pgp
 179   :type '(repeat (cons :format "%v"
 180                        (choice (choice-item :tag "GnuPG" gpg)
 181                                (choice-item :tag "PGP 5.0i" pgp50)
 182                                (choice-item :tag "PGP 2.6" pgp))
 183                        (repeat (list :format "%v"
 184                                      (symbol :tag "Language")
 185                                      (regexp :tag "Regexp")
 186                                      (function :tag "Post Function"))))))
 187
 188 (defcustom mime-pgp-bad-signature-regexp-alist
 189   '((gpg
 190      (nil "BAD signature from.*$" nil)
 191      )
 192     (pgp50
 193      (us "BAD signature made .* by key:$"
 194          mime-pgp-bad-signature-post-function-pgp50-us)
 195      )
 196     (pgp
 197      (en "Bad signature from user.*$" nil)
 198      ))
 199   "Alist of the schemes and alist of the languages and the regexps for
 200 detecting ``BAD signature''.  The optional symbol of the post processing
 201 function for arranging the output message can be specified in each element.
 202 It will be called just after re-search is done successfully, and it is
 203 expected that the function returns a string for messaging."
 204   :group 'mime-pgp
 205   :type '(repeat (cons :format "%v"
 206                        (choice (choice-item :tag "GnuPG" gpg)
 207                                (choice-item :tag "PGP 5.0i" pgp50)
 208                                (choice-item :tag "PGP 2.6" pgp))
 209                        (repeat (list :format "%v"
 210                                      (symbol :tag "Language")
 211                                      (regexp :tag "Regexp")
 212                                      (function :tag "Post Function"))))))
 213
 214 (defcustom mime-pgp-key-expected-regexp-alist
 215   '((gpg
 216      (nil
 217       .
 218       "key ID \\(\\S +\\)\ngpg: Can't check signature: public key not found")
 219      )
 220     (pgp50
 221      (us . "Signature by unknown keyid: 0x\\(\\S +\\)")
 222      )
 223     (pgp
 224      (en . "Key matching expected Key ID \\(\\S +\\) not found")
 225      ))
 226   "Alist of the schemes and alist of the languages and regexps for detecting
 227 ``Key expected''."
 228   :group 'mime-pgp
 229   :type '(repeat (cons :format "%v"
 230                        (choice (choice-item :tag "GnuPG" gpg)
 231                                (choice-item :tag "PGP 5.0i" pgp50)
 232                                (choice-item :tag "PGP 2.6" pgp))
 233                        (repeat (cons :format "%v"
 234                                      (symbol :tag "Language")
 235                                      (regexp :tag "Regexp"))))))
 236
 237 (defmacro mime-pgp-command (&optional suffix)
 238   "Return a suitable command.  SUFFIX should be either \"e\", \"k\", \"s\"
 239 or \"v\" for choosing a command of PGP 5.0i."
 240   (` (let ((command (cdr (assq pgp-version mime-pgp-command-alist))))
 241        (if (and command
 242                 (progn
 243                   (if (eq 'pgp50 pgp-version)
 244                       (setq command (format "%s%s" command (, suffix))))
 245                   (exec-installed-p command)))
 246            command
 247          (error "Please specify the valid command name for `%s'."
 248                 (or pgp-version 'pgp-version))))))
 249
 250 (defmacro mime-pgp-default-language ()
 251   "Return a symbol of language."
 252   '(cond ((eq 'gpg pgp-version)
 253           nil)
 254          ((eq 'pgp50 pgp-version)
 255           (or (cdr (assq pgp-version mime-pgp-default-language-alist)) 'us)
 256           )
 257          (t
 258           (or (cdr (assq pgp-version mime-pgp-default-language-alist)) 'en)
 259           )))
 260
 261 (defmacro mime-pgp-good-signature-regexp ()
 262   "Return a regexp to detect ``Good signature''."
 263   '(nth 1
 264         (assq
 265          (mime-pgp-default-language)
 266          (cdr (assq pgp-version mime-pgp-good-signature-regexp-alist))
 267          )))
 268
 269 (defmacro mime-pgp-good-signature-post-function ()
 270   "Return a post processing function for arranging the message for
 271 ``Good signature''."
 272   '(nth 2
 273         (assq
 274          (mime-pgp-default-language)
 275          (cdr (assq pgp-version mime-pgp-good-signature-regexp-alist))
 276          )))
 277
 278 (defmacro mime-pgp-bad-signature-regexp ()
 279   "Return a regexp to detect ``BAD signature''."
 280   '(nth 1
 281         (assq
 282          (mime-pgp-default-language)
 283          (cdr (assq pgp-version mime-pgp-bad-signature-regexp-alist))
 284          )))
 285
 286 (defmacro mime-pgp-bad-signature-post-function ()
 287   "Return a post processing function for arranging the message for
 288 ``BAD signature''."
 289   '(nth 2
 290         (assq
 291          (mime-pgp-default-language)
 292          (cdr (assq pgp-version mime-pgp-bad-signature-regexp-alist))
 293          )))
 294
 295 (defmacro mime-pgp-key-expected-regexp ()
 296   "Return a regexp to detect ``Key expected''."
 297   '(cdr (assq (mime-pgp-default-language)
 298               (cdr (assq pgp-version mime-pgp-key-expected-regexp-alist))
 299               )))
 300
 301 (defun mime-pgp-detect-version ()
 302   "Detect PGP version in the buffer.  The buffer is expected to be narrowed
 303 to just an ascii armor.  However, a few leading garbage lines are allowed."
 304   (let ((version (save-restriction
 305                    (goto-char (point-min))
 306                    (if (re-search-forward "^-+BEGIN PGP " nil t)
 307                        (progn
 308                          (forward-line 1)
 309                          (narrow-to-region (point) (point-max))
 310                          (std11-narrow-to-header)
 311                          (std11-fetch-field "Version")
 312                          )))))
 313     (cond ((not version)
 314            pgp-version)
 315           ((string-match "GnuPG" version)
 316            'gpg)
 317           ((string-match "5\\.0i" version)
 318            'pgp50)
 319           ((string-match "2\\.6" version)
 320            'pgp)
 321           (t
 322            pgp-version))))
 323
 324 (defun mime-entity-detect-pgp-version (entity)
 325   "Detect PGP version from entity content."
 326   (with-temp-buffer
 327     (mime-insert-entity-content entity)
 328     (mime-pgp-detect-version)
 329     ))
 330
 331 (defun mime-pgp-check-signature (output-buffer sig-file orig-file
 332                                                &optional hide-lines)
 333   (with-current-buffer output-buffer
 334     (erase-buffer)
 335     (setq truncate-lines t))
 336   (let* ((lang (mime-pgp-default-language))
 337          (command (mime-pgp-command 'v))
 338          (args (cond ((eq 'gpg pgp-version)
 339                       (list "--batch" "--verify" sig-file)
 340                       )
 341                      ((eq 'pgp50 pgp-version)
 342                       (list "+batchmode=1"
 343                             (format "+language=%s" lang)
 344                             sig-file)
 345                       )
 346                      ((eq 'pgp pgp-version)
 347                       (list (format "+language=%s" lang)
 348                             sig-file orig-file))
 349                      ))
 350          (good-regexp (mime-pgp-good-signature-regexp))
 351          (good-post-function (mime-pgp-good-signature-post-function))
 352          (bad-regexp (mime-pgp-bad-signature-regexp))
 353          (bad-post-function (mime-pgp-bad-signature-post-function))
 354          status start lines
 355          )
 356     (setq status (apply 'call-process-region (point-min) (point-max)
 357                         command nil output-buffer nil args)
 358           )
 359     (with-current-buffer output-buffer
 360       (goto-char (point-min))
 361       (forward-line (or hide-lines 0))
 362       (setq start (point)
 363             lines (count-lines start (point-max)))
 364       (cond ((not (stringp good-regexp))
 365              (message "Please specify right regexp for specified language")
 366              (cons start lines)
 367              )
 368             ((and (zerop status)
 369                   (progn
 370                     (goto-char (point-min))
 371                     (re-search-forward good-regexp nil t)
 372                     ))
 373              (message (if good-post-function
 374                           (funcall good-post-function)
 375                         (buffer-substring (match-beginning 0)
 376                                           (match-end 0))))
 377              (cons start lines)
 378              )
 379             ((not (stringp bad-regexp))
 380              (message "Please specify right regexp for specified language")
 381              (cons start lines)
 382              )
 383             ((progn
 384                (goto-char (point-min))
 385                (re-search-forward bad-regexp nil t)
 386                )
 387              (message (if bad-post-function
 388                           (funcall bad-post-function)
 389                         (buffer-substring (match-beginning 0)
 390                                           (match-end 0))))
 391              (cons start lines)
 392              )
 393             (t
 394              ;; Returns nil in order for attempt to fetch key.
 395              nil
 396              )))))
 397
 398 (defmacro mime-pgp-parse-verify-error (output-buffer &rest forms)
 399   (` (let ((regexp (mime-pgp-key-expected-regexp))
 400            keyid)
 401        (with-current-buffer (, output-buffer)
 402          (goto-char (point-min))
 403          (if (stringp regexp)
 404              (if (re-search-forward regexp nil t)
 405                  (progn
 406                    (setq keyid (concat
 407                                 "0x"
 408                                 (buffer-substring-no-properties
 409                                  (match-beginning 1) (match-end 1))))
 410                    (goto-char (point-min))
 411                    ))
 412            (message "Please specify right regexp for specified language")
 413            )
 414          (,@ forms)
 415          (list keyid (point) (count-lines (point) (point-max)))
 416          ))))
 417
 418 (defun mime-pgp-parse-verify-error-for-gpg (output-buffer)
 419   "Subroutine used for parsing verify error with GnuPG.  Returns the
 420 list of expected key-ID, start position and lines to be shown a result."
 421   (mime-pgp-parse-verify-error output-buffer)
 422   )
 423
 424 (defun mime-pgp-parse-verify-error-for-pgp50 (output-buffer)
 425   "Subroutine used for parsing verify error with PGP 5.0i.  Returns the
 426 list of expected key-ID, start position and lines to be shown a result."
 427   (mime-pgp-parse-verify-error output-buffer (forward-line 1))
 428   )
 429
 430 (defun mime-pgp-parse-verify-error-for-pgp (output-buffer)
 431   "Subroutine used for parsing verify error with PGP 2.6.  Returns the
 432 list of expected key-ID, start position and lines to be shown a result."
 433   (mime-pgp-parse-verify-error
 434    output-buffer
 435    (if (search-forward "\C-g" nil t)
 436        (goto-char (match-beginning 0))
 437      (forward-line 7))
 438    ))
 439
 440 (defmacro mime-pgp-show-echo-buffer (start lines)
 441   (` (let ((mime-echo-window-height
 442             (min (+ 2 (, lines))
 443                  (max window-min-height
 444                       (- (window-height) window-min-height)
 445                       ))))
 446        (set-window-start
 447         (car (save-current-buffer (mime-show-echo-buffer)))
 448         (, start))
 449        )))
 450
 451 (defun mime-verify-application/pgp-signature (entity situation)
 452   "Internal method to check PGP/MIME signature."
 453   (let* ((entity-node-id (mime-entity-node-id entity))
 454          (mother (mime-entity-parent entity))
 455          (knum (car entity-node-id))
 456          (onum (if (> knum 0)
 457                    (1- knum)
 458                  (1+ knum)))
 459          (orig-entity (nth onum (mime-entity-children mother)))
 460          (basename (expand-file-name "tm" temporary-file-directory))
 461          (orig-file (make-temp-name basename))
 462          (sig-file (concat orig-file ".sig"))
 463          (pgp-version (mime-entity-detect-pgp-version entity))
 464          (output-buffer (get-buffer-create mime-echo-buffer-name))
 465          (hide-lines (cdr (assq pgp-version
 466                                 '((gpg . nil) (pgp50 . 1) (pgp . 10)))))
 467          (parser (intern (format "mime-pgp-parse-verify-error-for-%s"
 468                                  pgp-version)))
 469          done return pgp-id)
 470     (mime-write-entity orig-entity orig-file)
 471     (mime-write-entity-content entity sig-file)
 472     (message "Checking signature...")
 473     (unwind-protect
 474         (while (not done)
 475           (if (setq return (mime-pgp-check-signature
 476                             output-buffer sig-file orig-file hide-lines))
 477               (progn
 478                 (mime-pgp-show-echo-buffer (car return) (cdr return))
 479                 (setq done t)
 480                 )
 481             (if (and
 482                  (not pgp-id)
 483                  (progn
 484                    (setq return (funcall parser output-buffer))
 485                    (mime-pgp-show-echo-buffer (nth 1 return)
 486                                               (nth 2 return))
 487                    (setq pgp-id (car return))
 488                    )
 489                  (y-or-n-p (format "Key %s not found; attempt to fetch? "
 490                                    pgp-id))
 491                  )
 492                 (funcall (pgp-function 'fetch-key) (cons nil pgp-id))
 493               (setq return (funcall parser output-buffer))
 494               (mime-pgp-show-echo-buffer (nth 1 return) (nth 2 return))
 495               (setq done t)
 496               (message "Can't check signature")
 497               )))
 498       (delete-file orig-file)
 499       (delete-file sig-file)
 500       )))
 501
 502 (defun mime-pgp-good-signature-post-function-pgp50-us ()
 503   (forward-line 2)
 504   (looking-at "\\s +\\(.+\\)$")
 505   (format "Good signature from %s" (match-string 1)))
 506
 507 (defun mime-pgp-bad-signature-post-function-pgp50-us ()
 508   (forward-line 2)
 509   (looking-at "\\s +\\(.+\\)$")
 510   (format "BAD signature from %s" (match-string 1)))
 511
 512
 513 ;;; @ Internal method for application/pgp-encrypted
 514 ;;;
 515 ;;; It is based on RFC 2015 (PGP/MIME) and
 516 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
 517
 518 (defun mime-decrypt-application/pgp-encrypted (entity situation)
 519   (let* ((entity-node-id (mime-entity-node-id entity))
 520          (mother (mime-entity-parent entity))
 521          (knum (car entity-node-id))
 522          (onum (if (> knum 0)
 523                    (1- knum)
 524                  (1+ knum)))
 525          (orig-entity (nth onum (mime-entity-children mother)))
 526          (pgp-version (mime-entity-detect-pgp-version orig-entity))
 527          )
 528     (mime-view-application/pgp orig-entity situation)
 529     ))
 530
 531 (defun mime-edit-decrypt-application/pgp-encrypted ()
 532   "Decrypt the encrypted part for the function `mime-edit-again'."
 533   (let ((pgp-version (mime-pgp-detect-version)))
 534     ;; The following process should returns a pair (SUCCEEDED . VERIFIED)
 535     ;; where SUCCEEDED is t if the decryption succeeded and VERIFIED is t
 536     ;; if there was a valid signature.
 537     (as-binary-process (funcall (pgp-function 'decrypt)))
 538     ))
 539
 540
 541 ;;; @ Internal method for application/pgp-keys
 542 ;;;
 543 ;;; It is based on RFC 2015 (PGP/MIME) and
 544 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
 545
 546 (defun mime-add-application/pgp-keys (entity situation)
 547   (with-temp-buffer
 548     (mime-insert-entity-content entity)
 549     (mime-decode-region (point-min) (point-max)
 550                         (cdr (assq 'encoding situation)))
 551     (let ((pgp-version (mime-pgp-detect-version)))
 552       (funcall (pgp-function 'snarf-keys))
 553       )))
 554
 555
 556 ;;; @ Internal method for fetching a public key
 557 ;;;
 558
 559 (defcustom mime-pgp-keyserver-url-template "/pks/lookup?op=get&search=%s"
 560   "The URL to pass to the keyserver."
 561   :group 'mime-pgp
 562   :type 'string)
 563
 564 (defcustom mime-pgp-keyserver-address "pgp.nic.ad.jp"
 565   "Host name of keyserver."
 566   :group 'mime-pgp
 567   :type 'string)
 568
 569 (defcustom mime-pgp-keyserver-port 11371
 570   "Port on which the keyserver's HKP daemon lives."
 571   :group 'mime-pgp
 572   :type 'integer)
 573
 574 (defcustom mime-pgp-http-proxy-url-template
 575   "/cgi-bin/pgpsearchkey.pl?op=get&search=%s"
 576   "The URL to pass to the keyserver via HTTP proxy."
 577   :group 'mime-pgp
 578   :type 'string)
 579
 580 (defcustom mime-pgp-http-proxy-server-address nil
 581   "Host name of HTTP proxy server.  If you are behind firewalls, set the
 582 values of this variable and `mime-pgp-http-proxy-server-port' appropriately."
 583   :group 'mime-pgp
 584   :type 'string)
 585
 586 (defcustom mime-pgp-http-proxy-server-port 8080
 587   "Port on which the proxy server's HTTP daemon lives."
 588   :group 'mime-pgp
 589   :type 'integer)
 590
 591 (defcustom mime-pgp-fetch-timeout 20
 592   "Timeout, in seconds, for any particular key fetch operation."
 593   :group 'mime-pgp
 594   :type 'integer)
 595
 596 (defmacro mime-pgp-show-fetched-key (key scroll &rest args)
 597   (` (let ((current-window (selected-window))
 598            keys start hide return window)
 599        (with-temp-buffer
 600          (insert (, key))
 601          (as-binary-process
 602           (call-process-region
 603            (point-min) (point-max) (mime-pgp-command 'v) t t (,@ args))
 604           )
 605          (goto-char (point-min))
 606          (forward-line (, scroll))
 607          (setq keys (buffer-string)
 608                start (point)
 609                hide (count-lines (point) (point-max)))
 610          )
 611        (setq return (mime-show-echo-buffer "%s" keys)
 612              window (car return)
 613              start (1- (+ start (car (cdr return))))
 614              hide (- (window-height window) hide 2))
 615        (if (>= (+ (window-height current-window) hide) window-min-height)
 616            (progn
 617              (select-window window)
 618              (shrink-window hide)
 619              (select-window current-window)
 620              ))
 621        (set-window-start window start)
 622        )))
 623
 624 (defun mime-pgp-show-fetched-key-for-gpg (key)
 625   "Extract KEY and show."
 626   (mime-pgp-show-fetched-key key 0)
 627   )
 628
 629 (defun mime-pgp-show-fetched-key-for-pgp50 (key)
 630   "Extract KEY and show."
 631   (let ((current-window (selected-window))
 632         (process-environment process-environment)
 633         process-connection-type process keys start hide return window)
 634     (setenv "PGPPASSFD" nil)
 635     (with-temp-buffer
 636       (setq process
 637             (start-process "*show fetched keys*"
 638                            (current-buffer) (mime-pgp-command 'v)
 639                            "-f" "+batchmode=0" "+language=us")
 640             )
 641       (set-process-coding-system process 'binary 'binary)
 642       (process-send-string process key)
 643       (process-send-eof process)
 644       (while
 645           (progn
 646             (accept-process-output process 1)
 647             (goto-char (point-min))
 648             (not
 649              (re-search-forward
 650               "^Add these keys to your keyring\\? \\[Y/n\\] "
 651               nil t))
 652             ))
 653       (setq start (match-beginning 0))
 654       (delete-process process)
 655       (delete-region start (point-max))
 656       (goto-char (point-min))
 657       (forward-line 10)
 658       (setq keys (buffer-string)
 659             start (point)
 660             hide (count-lines (point) start))
 661       )
 662     (setq return (mime-show-echo-buffer "%s" keys)
 663           window (car return)
 664           start (1- (+ start (car (cdr return))))
 665           hide (- (window-height window) hide 2))
 666     (if (>= (+ (window-height current-window) hide) window-min-height)
 667         (progn
 668           (select-window window)
 669           (shrink-window hide)
 670           (select-window current-window)
 671           ))
 672     (set-window-start window start)
 673     ))
 674
 675 (defun mime-pgp-show-fetched-key-for-pgp (key)
 676   "Extract KEY and show."
 677   (mime-pgp-show-fetched-key key 7 "-f" "+language=en")
 678   )
 679
 680 (defun mime-pgp-fetch-key (&optional id)
 681   "Attempt to fetch a key for addition to PGP or GnuPG keyring.
 682 Interactively, prompt for string matching key to fetch.
 683
 684 Non-interactively, ID must be a pair.  The CAR must be a bare Email
 685 address and the CDR a keyID (with \"0x\" prefix).  Either, but not
 686 both, may be nil.
 687
 688 Return t if we think we were successful; nil otherwise.  Note that nil
 689 is not necessarily an error, since we may have merely fired off an Email
 690 request for the key.
 691
 692 If you want to use this function for verifying a message of PGP/MIME,
 693 for example, please put the following lines in your startup file:
 694
 695   (eval-after-load \"semi-def\"
 696     '(progn (require 'alist)
 697             (set-alist 'pgp-function-alist 'fetch-key
 698                        '(mime-pgp-fetch-key \"mime-pgp\"))
 699             (autoload 'mime-pgp-fetch-key \"mime-pgp\" nil t)
 700             ))
 701
 702 In addition, if you are behind firewalls, please set the values of
 703 `mime-pgp-http-proxy-server-address' and `mime-pgp-http-proxy-server-port'
 704 appropriately."
 705   (interactive)
 706   (let ((server (or mime-pgp-http-proxy-server-address
 707                     mime-pgp-keyserver-address))
 708         (port (or mime-pgp-http-proxy-server-port
 709                   mime-pgp-keyserver-port))
 710         (url-template
 711          (if mime-pgp-http-proxy-server-address
 712              (concat "http://"
 713                      mime-pgp-keyserver-address
 714                      mime-pgp-http-proxy-url-template
 715                      " HTTP/1.0\r\n")
 716            mime-pgp-keyserver-url-template))
 717         (show-function (intern (format "mime-pgp-show-fetched-key-for-%s"
 718                                        pgp-version)))
 719         (snarf-function (pgp-function 'snarf-keys))
 720         armor case-fold-search process-connection-type process start)
 721     (if (cond ((interactive-p)
 722                (setq id (read-string "Fetch key for: "))
 723                (cond ((string-equal "" id)
 724                       (message "Aborted")
 725                       nil)
 726                      ((string-match "^0[Xx]" id)
 727                       (setq id (cons nil id)))
 728                      (t
 729                       (setq id (cons id nil)))))
 730               ((or (null id)
 731                    (not (or (stringp (car id)) (stringp (cdr id)))))
 732                (message "Aborted")
 733                nil)
 734               (t t))
 735         (progn
 736           (with-temp-buffer
 737             (catch 'mime-pgp-fetch-key-done
 738               (message "Fetching %s via HTTP to %s..."
 739                        (or (cdr id) (car id))
 740                        mime-pgp-keyserver-address)
 741               (condition-case err
 742                   (setq process (open-network-stream-as-binary
 743                                  "*key fetch*" (current-buffer) server port))
 744                 (error
 745                  (message "%s" err)
 746                  (throw 'mime-pgp-fetch-key-done nil)
 747                  ))
 748               (if (not process)
 749                   (progn
 750                     (message "Can't connect to %s%s."
 751                              mime-pgp-keyserver-address
 752                              (if mime-pgp-http-proxy-server-address
 753                                  (concat "via "
 754                                          mime-pgp-http-proxy-server-address)
 755                                ""))
 756                     (throw 'mime-pgp-fetch-key-done nil)
 757                     )
 758                 (process-send-string
 759                  process
 760                  (concat "GET " (format url-template
 761                                         (or (cdr id) (car id))) "\r\n")
 762                  )
 763                 (while (and (eq 'open (process-status process))
 764                             (accept-process-output process
 765                                                    mime-pgp-fetch-timeout)
 766                             ))
 767                 (delete-process process)
 768                 (goto-char (point-min))
 769                 (if (and (re-search-forward
 770                           "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$" nil t)
 771                          (setq start (match-beginning 0))
 772                          (re-search-forward
 773                           "^-----END PGP PUBLIC KEY BLOCK-----\r?$" nil t)
 774                          )
 775                     (setq armor (buffer-substring start (1+ (point))))
 776                   ))))
 777           (if armor
 778               (save-window-excursion
 779                 (funcall show-function armor)
 780                 (if (y-or-n-p "Add this key to keyring? ")
 781                     (if (string-match
 782                          "^0"
 783                          (with-temp-buffer
 784                            (insert armor)
 785                            ;; The function should return a number of
 786                            ;; keys found as a string.
 787                            (format "%s" (funcall snarf-function))))
 788                         (progn
 789                           (message "Key not found or discarded.")
 790                           nil)
 791                       t)
 792                   (message "Aborted")
 793                   nil))
 794             (message "Key not found.")
 795             nil)))))
 796
 797
 798 ;;; @ end
 799 ;;;
 800
 801 (provide 'mime-pgp)
 802
 803 (run-hooks 'mime-pgp-load-hook)
 804
 805 ;;; mime-pgp.el ends here