cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/mew-pgp.el

   1 ;;; mew-pgp.el --- PGP/MIME for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Aug 17, 1994
   5 ;; Revised: Aug 30, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-pgp-version "mew-pgp.el version 0.48")
  10
  11 (require 'mew)
  12 (eval-when-compile
  13   (if (mew-which-el "timer" load-path)
  14       (require 'timer)))
  15
  16 ;;;
  17 ;;; PGP 2.6.x is supported.
  18 ;;; PGP 5.x is supported. But very ad-hoc.
  19 ;;; GNUPG 0.9.x is supported. But very ad-hoc.
  20 ;;;
  21
  22 (defvar mew-pgp-ver nil
  23   "Automatically set 0 if PGP version is 2. Set 1 if 5. Set 2 if GNUPG.")
  24
  25 (defconst mew-pgp-ver2 0)
  26 (defconst mew-pgp-ver5 1)
  27 (defconst mew-pgp-verg 2)
  28 (defconst mew-pgp-list '("PGPv2" "PGPv5" "GNUPG"))
  29 (defconst mew-pgp-keys '(pgpv2 pgpv5 gnupg)) ;; use symbols, cases are string
  30
  31 ;; mew-prog-pgp is used only for version check
  32 (defvar mew-prog-pgp2  "pgp") ;; "pgp263i", PGP selection
  33 (defvar mew-prog-pgp5  "pgp") ;; PGP selection
  34 (defvar mew-prog-pgp5e "pgpe")
  35 (defvar mew-prog-pgp5s "pgps")
  36 (defvar mew-prog-pgp5v "pgpv")
  37 (defvar mew-prog-pgp5k "pgpk")
  38 (defvar mew-prog-gpg   "gpg") ;; PGP selection
  39
  40 (defvar mew-prog-pgpe (list mew-prog-pgp2 mew-prog-pgp5e mew-prog-gpg))
  41 (defvar mew-prog-pgps (list mew-prog-pgp2 mew-prog-pgp5s mew-prog-gpg))
  42 (defvar mew-prog-pgpv (list mew-prog-pgp2 mew-prog-pgp5v mew-prog-gpg))
  43 (defvar mew-prog-pgpd (list mew-prog-pgp2 mew-prog-pgp5v mew-prog-gpg))
  44 (defvar mew-prog-pgpk (list mew-prog-pgp2 mew-prog-pgp5k mew-prog-gpg))
  45
  46 (defconst mew-prog-pgpe-arg
  47   '(("-ea" "+language=en" "+batchmode=on" "+armorlines=0")
  48     ("-a" "+language=en" "+batchmode=on" "+armorlines=0")
  49     ("--encrypt" "--armor" "--batch")))
  50 (defconst mew-prog-pgpd-arg
  51   '(("+language=en" "+batchmode=off")
  52     ("+language=en" "+batchmode=off")
  53     ("--decrypt")))
  54 (defconst mew-prog-pgps-arg
  55   '(("-sba" "+language=en" "+batchmode=off")
  56     ("-ba" "+language=en" "+batchmode=off")
  57     ("--detach-sign" "--armor")))
  58 (defconst mew-prog-pgpv-arg
  59   '(("+batchmode=on" "+language=en")
  60     ("+batchmode=on" "+language=en" "+force=on")
  61     ("--verify" "--batch")))
  62
  63 (defconst mew-prog-arg-output '("-o" "-o" "--output"))
  64 (defconst mew-prog-arg-input '(nil "-o" nil))
  65 (defconst mew-prog-arg-luserid '("-u" "-u" "--local-user"))
  66 (defconst mew-prog-arg-ruserid '(nil "-r" "--remote-user"))
  67
  68 (defconst mew-prog-pgpk-add-arg
  69   '(("-ka" "+batchmode=on") ("-a" "+batchmode=on") ("--import" "--batch")))
  70 (defconst mew-prog-pgpk-ext-arg
  71   '(("-kxfa") ("-xa") ("--export" "--armor" "--batch")))
  72
  73 (defconst mew-pgp-msg-signature
  74   '("\n\\(.*\\) signature from user \\(.*\\)\\."
  75     "\n\\(.*\\) signature made"
  76     " \\(.*\\) signature from \"\\(.*\\)\""))
  77
  78 (defconst mew-pgp-msg-key-id
  79   '("Key ID \\(\\S +\\) not found"
  80     ": \\(0x[0-9A-Za-z]+\\)"
  81     "xxx"))
  82 (defconst mew-pgp-msg-bad-pass
  83   '("No passphrase" "Cannot unlock private key\\|It can only be decrypted" "bad passphrase"))
  84 (defconst mew-pgp-msg-enter
  85   '("Enter" "Enter" "xxx"))
  86 (defconst mew-pgp-msg-enter-pass
  87   '("Enter pass phrase: " "Enter pass phrase: " "Enter passphrase: "))
  88 (defconst mew-pgp-msg-reenter-pass
  89   '("Enter pass phrase: " "Enter pass phrase: " "Enter passphrase: "))
  90 (defconst mew-pgp-msg-no-enckey
  91   '("Key matching" "No encryption keys" "public key not found"))
  92 (defconst mew-pgp-msg-no-validkey
  93   '("DUMMY" "^WARNING:[ -9;-~\n]+belongs? to:" "no info to calculate a trust probability")) ;;xxx
  94 (defconst mew-pgp-msg-no-vrfkey
  95   '("Key matching" "unknown keyid" "public key not found"))
  96 (defconst mew-pgp-msg-no-keyring
  97   '("Keyring file" "Keyring file" "public key not found"))
  98 (defconst mew-pgp-msg-no-seckey-or-secring
  99   '("You do not have the secret key"
 100     "Cannot find a private key"
 101     ": decryption failed: secret key not available"))
 102 (defconst mew-pgp-msg-unsupported
 103   '("Unsupported packet format" ;; including algorithms and packets
 104     "Unsupported packet format\\|None of the signatures were understood"
 105     "xxx"))
 106 (defconst mew-pgp-verify-addr
 107   '(".* \\(signature from user\\) " "\\(   \\)" "gpg: .* \\(from\\|aka\\) "))
 108
 109 ;; 2: ASCII armor corrupted
 110 ;; 3:
 111 ;; 5:
 112
 113 ;; 2: ERROR: or Error:
 114
 115 (defconst mew-pgp-msg-no-export-key
 116   '("Key not found" "No keys" "nothing exported"))
 117
 118 (defvar mew-pgp-micalg '("pgp-md5" "pgp-sha1" "pgp-sha1"))
 119
 120 ;;
 121 ;;
 122
 123 (defvar mew-pgp-string nil)
 124 (defvar mew-pgp-running nil)
 125 (defvar mew-pgp-failure nil)
 126
 127 (defvar mew-pgp-decrypt-msg nil)
 128 (defvar mew-pgp-sign-msg nil)
 129
 130 (defconst mew-pgp-encryption-begin "-----BEGIN PGP MESSAGE-----")
 131 (defconst mew-pgp-signature-begin  "-----BEGIN PGP SIGNED MESSAGE-----")
 132 (defconst mew-pgp-key-begin "-----BEGIN PGP PUBLIC KEY BLOCK-----")
 133 (defconst mew-pgp-key-end   "-----END PGP PUBLIC KEY BLOCK-----")
 134
 135 (defconst mew-pgp-err-pass    'mew-err-pass)
 136 (defconst mew-pgp-err-pubring 'mew-err-pubring)
 137 (defconst mew-pgp-err-secring 'mew-err-secring)
 138 (defconst mew-pgp-err-pubkey  'mew-err-pubkey)
 139 (defconst mew-pgp-err-seckey  'mew-err-seckey)
 140 (defconst mew-pgp-err-seckey-or-secring 'mew-err-seckey-or-secring)
 141 (defconst mew-pgp-err-other   'mew-err-other)
 142
 143 (defvar mew-pgp-result-pass     "Pass phrase is wrong.")
 144 (defvar mew-pgp-result-pubring  "No public keyring.")
 145 (defvar mew-pgp-result-secring  "No secret keyring.")
 146 (defvar mew-pgp-result-pubkey   "No his/her public key.")
 147 (defvar mew-pgp-result-invalid
 148   "His/her public key is invalid. Sign the key by yourself, first.")
 149 (defvar mew-pgp-result-seckey   "No your secret key.")
 150 (defvar mew-pgp-result-seckey-or-secring
 151   "PGP NOT decrypted due to no secret keyring or no your secret key.")
 152 (defvar mew-pgp-result-other    "PGP failed for some reasons.")
 153 (defvar mew-pgp-result-sec-succ "PGP decrypted. ")
 154 (defvar mew-pgp-result-dec-fail "PGP NOT decrypted for some reasons.")
 155 (defvar mew-pgp-result-unsup    "PGP unsupported signature.")
 156
 157 (defvar mew-pgp-prompt-enter-pass   "Enter pass phrase (%s): ")
 158 (defvar mew-pgp-prompt-reenter-pass "Re-enter pass phrase (%s): ")
 159
 160 (defmacro mew-pgp-get (list-or-vec)
 161   (` (elt (, list-or-vec) mew-pgp-ver)))
 162 (defmacro mew-pgp-set (vec val)
 163   (` (aset (, vec) mew-pgp-ver (, val))))
 164
 165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 166 ;;
 167 ;; PGP version check
 168 ;;
 169
 170 (defun mew-pgp-set-version ()
 171   (if (not (mew-which mew-prog-pgp exec-path))
 172       (setq mew-pgp-ver nil)
 173     (save-excursion
 174       (mew-set-buffer-tmp)
 175       (call-process mew-prog-pgp nil t nil)
 176       (goto-char (point-min))
 177       (if (search-forward "PGP is now invoked" nil t)
 178           (setq mew-pgp-ver mew-pgp-ver5)
 179         (goto-char (point-min))
 180         (if (search-forward "Pretty Good Privacy(tm) 2" nil t)
 181             (setq mew-pgp-ver mew-pgp-ver2)
 182           (goto-char (point-min))
 183           (if (search-forward "gpg" nil t)
 184               (setq mew-pgp-ver mew-pgp-verg)
 185             (setq mew-pgp-ver nil)))))))
 186
 187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 188 ;;
 189 ;; PGP selection
 190 ;;
 191
 192 (defun mew-pgp-select ()
 193   "Select PGP version and set up environment for selected PGP."
 194   (interactive)
 195   (setq mew-prog-pgp
 196         (completing-read
 197          "PGP name : "
 198          (mapcar (function (lambda (x) (cons x x)))
 199                  (list mew-prog-pgp2 mew-prog-pgp5 mew-prog-gpg))
 200          nil t))
 201   (mew-pgp-set-version))
 202
 203 (defun mew-pgp-passphrase (&optional again)
 204   (let ((prompt (if again
 205                     mew-pgp-prompt-reenter-pass
 206                   mew-pgp-prompt-enter-pass)))
 207     (setq prompt (format prompt (mew-pgp-get mew-pgp-list)))
 208     (if mew-use-pgp-cached-passphrase
 209         (mew-input-passwd prompt (mew-pgp-get mew-pgp-keys))
 210       (mew-input-passwd prompt))))
 211
 212 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 213 ;;
 214 ;; PGP verifying
 215 ;;
 216
 217 (defun mew-pgp-verify-check ()
 218   (let (ret keyid)
 219     (goto-char (point-min))
 220     (if (not (re-search-forward (mew-pgp-get mew-pgp-msg-signature) nil t))
 221         ;; this is verification, so the error is about public key
 222         (progn
 223           (goto-char (point-min))
 224           (if (search-forward (mew-pgp-get mew-pgp-msg-no-vrfkey) nil t)
 225               (progn
 226                 (goto-char (point-min))
 227                 (if (not (re-search-forward (mew-pgp-get mew-pgp-msg-key-id) nil t))
 228                     (setq keyid "not found")
 229                   (setq keyid (mew-buffer-substring
 230                                (match-beginning 1) (match-end 1)))
 231                   (if (equal mew-pgp-ver mew-pgp-ver2) ;; xxx
 232                       (setq keyid (concat "0x" keyid))))
 233                 (setq ret (concat mew-pgp-result-pubkey " ID = " keyid)))
 234             (goto-char (point-min))
 235             (if (search-forward (mew-pgp-get mew-pgp-msg-no-keyring) nil t)
 236                 (setq ret mew-pgp-result-pubring)
 237               (goto-char (point-min))
 238               (if (re-search-forward (mew-pgp-get mew-pgp-msg-unsupported) nil t)
 239                   (setq ret mew-pgp-result-unsup)
 240                 ;; this line must be nil since this function is used
 241                 ;; by the decryption function, too, for signed-then-encrypted
 242                 ;; messages. We can't tell whether or not signatures exist
 243                 ;; from the outside of the cipher.
 244                 ))))
 245       ;; Signature result is found.
 246       (setq ret (concat (mew-match 1) " PGP sign "))
 247       (goto-char (point-max))
 248       (if (and (boundp 'mew-inherit-from) mew-inherit-from
 249                (re-search-backward (concat (concat (mew-pgp-get mew-pgp-verify-addr) ".*") mew-inherit-from) nil t))
 250           (progn
 251             (beginning-of-line)
 252             (looking-at (concat (mew-pgp-get mew-pgp-verify-addr) "\\(.*\\)"))
 253             (setq ret (concat ret (mew-match 2))))
 254         (goto-char (point-max))
 255         (re-search-backward (concat (mew-pgp-get mew-pgp-verify-addr) "\\(.*\\)") nil t)
 256         (setq ret (concat ret (mew-match 2))))
 257       ;; xxx
 258       (goto-char (point-min))
 259       (if (search-forward "not certified with enough" nil t)
 260           (setq ret (concat ret " MARGINAL"))
 261         (goto-char (point-min))
 262         (if (search-forward "not trusted" nil t)
 263             (setq ret (concat ret " UNTRUSTED"))
 264           (goto-char (point-min))
 265           (if (search-forward "not certified with a" nil t)
 266               ;; PGP uses "unknown" for validity internally, but
 267               ;; prints "undefined" instead of "unknown".
 268               (setq ret (concat ret " UNDEFINED"))
 269             (setq ret (concat ret " COMPLETE"))))))
 270     ret))
 271
 272 (defun mew-pgp-verify (file1 file2)
 273   (message "PGP verifying ... ")
 274   (let ((ioption (mew-pgp-get mew-prog-arg-input)))
 275     (save-excursion
 276       (mew-set-buffer-tmp)
 277       (if ioption
 278           (apply (function call-process)
 279                  (mew-pgp-get mew-prog-pgpv)
 280                  nil t nil
 281                  (append (mew-pgp-get mew-prog-pgpv-arg)
 282                          (list ioption file1 file2)))
 283         (apply (function call-process)
 284                (mew-pgp-get mew-prog-pgpv)
 285                nil t nil
 286                (append (mew-pgp-get mew-prog-pgpv-arg)
 287                        (list file2 file1))))
 288       (message "PGP verifying ... done")
 289       (mew-pgp-verify-check))))
 290
 291 (defun mew-pgp-verify-old (file)
 292   (message "PGP verifying ... ")
 293   (save-excursion
 294     (mew-set-buffer-tmp)
 295     (let ((file1 (mew-make-temp-name)))
 296       (apply (function call-process)
 297              (mew-pgp-get mew-prog-pgpv)
 298              nil t nil
 299              (append (mew-pgp-get mew-prog-pgpv-arg)
 300                      (list (mew-pgp-get mew-prog-arg-output) file1 file)))
 301       (message "PGP verifying ... done")
 302       (list file1 (mew-pgp-verify-check)))))
 303
 304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 305 ;;
 306 ;; PGP encrypting
 307 ;;
 308
 309 (defun mew-pgp-encrypt-check ()
 310   (let (ret) ;; this should be nil
 311     (goto-char (point-min))
 312     (if (search-forward (mew-pgp-get mew-pgp-msg-no-enckey) nil t)
 313         (setq ret mew-pgp-result-pubkey)
 314       (goto-char (point-min))
 315       (if (search-forward (mew-pgp-get mew-pgp-msg-no-keyring) nil t)
 316           (setq ret mew-pgp-result-pubring)
 317         (goto-char (point-min))
 318         (if (re-search-forward (mew-pgp-get mew-pgp-msg-no-validkey) nil t)
 319             (setq ret mew-pgp-result-invalid))))
 320     ret))
 321
 322 (defun mew-pgp-encrypt (file1 decrypters)
 323   (message "PGP encrypting ... ")
 324   (let ((roption (mew-pgp-get mew-prog-arg-ruserid))
 325         file2 file3) ;; not unique if makes temp here
 326     (setq file2 (mew-make-temp-name))
 327     (save-excursion
 328       (mew-set-buffer-tmp)
 329       (insert "Version: 1\n")
 330       (write-region (point-min) (point-max) file2  nil 'no-msg)
 331       (setq file3 (concat (mew-make-temp-name) mew-pgp-ascii-suffix))
 332       (mew-set-buffer-tmp)
 333       (if roption
 334           (let (decs)
 335             (while decrypters
 336               (setq decs (cons (car decrypters) (cons roption decs)))
 337               ;; nreverse later, take care.
 338               (setq decrypters (cdr decrypters)))
 339             (setq decrypters (nreverse decs))
 340             (apply
 341              (function call-process)
 342              (mew-pgp-get mew-prog-pgpe)
 343              nil t nil
 344              (append (mew-pgp-get mew-prog-pgpe-arg)
 345                      decrypters
 346                      (list (mew-pgp-get mew-prog-arg-output) file3 file1))))
 347         (apply (function call-process)
 348                (mew-pgp-get mew-prog-pgpe)
 349                nil t nil
 350                (mew-pgp-get mew-prog-arg-output) file3 file1
 351                (append (mew-pgp-get mew-prog-pgpe-arg) decrypters)))
 352       (message "PGP encrypting ... done")
 353       (list file2 nil file3 nil (mew-pgp-encrypt-check)) ;; both ctes are 7bit
 354       )))
 355
 356 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 357 ;;
 358 ;; PGP decrypting
 359 ;;
 360
 361 (defun mew-pgp-decrypt (file1 file2)
 362   ;; file1 is a key file. just ignore.
 363   ;; file2 is an encrypted file with PGP.
 364   (message "PGP decrypting ... ")
 365   (setq mew-pgp-running 'decrypting)
 366   (setq mew-pgp-string nil)
 367   (setq mew-pgp-decrypt-msg nil)
 368   (setq mew-pgp-failure nil)
 369   (let ((process-connection-type mew-connection-type2)
 370         file3 process verify)
 371     (setq file3 (mew-make-temp-name))
 372     (setq process
 373           (apply
 374            (function start-process)
 375            "PGP decrypt"
 376            (current-buffer)
 377            (mew-pgp-get mew-prog-pgpd)
 378            (append (mew-pgp-get mew-prog-pgpd-arg)
 379                    (list (mew-pgp-get mew-prog-arg-output) file3 file2))))
 380     (mew-set-process-cs process mew-cs-autoconv mew-cs-dummy)
 381     (set-process-filter process 'mew-pgp-process-filter1)
 382     (set-process-sentinel process 'mew-pgp-process-sentinel)
 383     ;; Wait for the termination of PGP.
 384     ;; Emacs doesn't provide synchronize mechanism with
 385     ;; an asynchronous process. So, take this way.
 386     (while mew-pgp-running
 387         (if mew-xemacs-p
 388             (accept-process-output)
 389           (sit-for 1)
 390           ;; accept-process-output or sleep-for is not enough
 391           (discard-input)))
 392     (message "PGP decrypting ... done")
 393     (if (file-exists-p file3)
 394         (progn
 395           (save-excursion
 396             (mew-set-buffer-tmp)
 397             (insert mew-pgp-string)
 398             (setq verify (mew-pgp-verify-check)))
 399           (if verify
 400               (setq mew-pgp-decrypt-msg
 401                     (concat mew-pgp-decrypt-msg "\n\t" verify))))
 402       ;; unpredictable error
 403       (mew-passwd-set-passwd (mew-pgp-get mew-pgp-keys) nil)
 404       (if (equal mew-pgp-decrypt-msg mew-pgp-result-sec-succ)
 405           (setq mew-pgp-decrypt-msg mew-pgp-result-dec-fail)))
 406     (list file3 mew-pgp-decrypt-msg)))
 407
 408 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 409 ;;
 410 ;; PGP signing
 411 ;;
 412
 413 (defun mew-pgp-sign (file1)
 414   (message "PGP signing ... ")
 415   (setq mew-pgp-running 'signing)
 416   (setq mew-pgp-string nil)
 417   (setq mew-pgp-sign-msg nil)
 418   (setq mew-pgp-failure nil)
 419   (let ((process-connection-type mew-connection-type2)
 420         file2 process)
 421     (setq file2 (concat (mew-make-temp-name) mew-pgp-ascii-suffix))
 422     ;; not perfectly unique but OK
 423     (setq process
 424           (apply
 425            (function start-process)
 426            "PGP sign"
 427            (current-buffer)
 428            (mew-pgp-get mew-prog-pgps)
 429            (append (mew-pgp-get mew-prog-pgps-arg)
 430                    (list (mew-pgp-get mew-prog-arg-luserid) mew-inherit-signer
 431                          (mew-pgp-get mew-prog-arg-output) file2 file1))))
 432     (mew-set-process-cs process mew-cs-autoconv mew-cs-dummy)
 433     (set-process-filter process 'mew-pgp-process-filter1)
 434     (set-process-sentinel process 'mew-pgp-process-sentinel)
 435     ;; Wait for the termination of PGP.
 436     ;; Emacs doesn't provide synchronize mechanism with
 437     ;; an asynchronous process. So, take this way.
 438     (while mew-pgp-running
 439         (if mew-xemacs-p
 440             (accept-process-output)
 441           (sit-for 1)
 442           ;; accept-process-output or sleep-for is not enough
 443           (discard-input)))
 444     (message "PGP signing ... done")
 445     (if (not (file-exists-p file2)) ;; for unpredictable error
 446         (mew-passwd-set-passwd (mew-pgp-get mew-pgp-keys) nil))
 447     (list file2 nil (mew-pgp-get mew-pgp-micalg) mew-pgp-sign-msg))) ;; return
 448
 449 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 450 ;;
 451 ;; PGP process functions
 452 ;;
 453
 454 (defun mew-pgp-process-sentinel (process event)
 455   (let ((decrypted mew-pgp-result-sec-succ)
 456         (msg ""))
 457     (if (not mew-pgp-failure)
 458         (cond
 459          ((equal mew-pgp-running 'decrypting)
 460           (setq mew-pgp-decrypt-msg decrypted))
 461          ((equal mew-pgp-running 'signing)
 462           (setq mew-pgp-sign-msg nil)))
 463       (cond
 464        ;; sign or decrypt
 465        ((equal mew-pgp-failure mew-pgp-err-pass)
 466         (setq msg mew-pgp-result-pass))
 467        ;; decrypt-then-verify
 468        ((equal mew-pgp-failure mew-pgp-err-pubring)
 469         (setq msg decrypted))
 470        ;; decrypt-then-vrify
 471        ((equal mew-pgp-failure mew-pgp-err-pubkey)
 472         (setq msg decrypted))
 473        ;; sign
 474        ((equal mew-pgp-failure mew-pgp-err-secring)
 475         (setq msg mew-pgp-result-secring))
 476        ;; sign
 477        ((equal mew-pgp-failure mew-pgp-err-seckey)
 478         (setq msg mew-pgp-result-seckey))
 479        ;; decrypt
 480        ((equal mew-pgp-failure mew-pgp-err-seckey-or-secring)
 481         (setq msg mew-pgp-result-seckey-or-secring))
 482        ;; other
 483        (t ;; mew-pgp-err-other or nil
 484         (setq msg mew-pgp-result-other)))
 485       (cond
 486        ((equal mew-pgp-running 'decrypting)
 487         (setq mew-pgp-decrypt-msg msg))
 488        ((equal mew-pgp-running 'signing)
 489         (setq mew-pgp-sign-msg msg))))
 490     (setq mew-pgp-running nil)))
 491
 492 (defun mew-pgp-process-filter1 (process string)
 493   ;; sign or decrypt, not verify
 494   (setq mew-pgp-string (concat mew-pgp-string string))
 495   (cond
 496    ;; no secret key or no secring for decrypt
 497    ((string-match (mew-pgp-get mew-pgp-msg-no-seckey-or-secring) string)
 498     (setq mew-pgp-failure mew-pgp-err-seckey-or-secring)
 499     (set-process-filter process 'mew-pgp-process-filter3))
 500
 501    ;; no secring for sign
 502    ((string-match (mew-pgp-get mew-pgp-msg-no-keyring) string)
 503     (setq mew-pgp-failure mew-pgp-err-secring)
 504     ;; Enter secret key filename:
 505     (process-send-string process "\n")
 506     (set-process-filter process 'mew-pgp-process-filter3))
 507
 508    ;; no secret key for sign
 509    ((string-match (mew-pgp-get mew-pgp-msg-no-enckey) string)
 510     (setq mew-pgp-failure mew-pgp-err-seckey)
 511     ;; Enter secret key filename:
 512     (process-send-string process "\n")
 513     (set-process-filter process 'mew-pgp-process-filter3))
 514
 515    ;; pass phrase for sign or decrypt
 516    ((string-match (mew-pgp-get mew-pgp-msg-enter-pass) string)
 517     (process-send-string process (format "%s\n" (mew-pgp-passphrase)))
 518     (set-process-filter process 'mew-pgp-process-filter2))
 519
 520    ;; just in case
 521    ((string-match (mew-pgp-get mew-pgp-msg-enter) string)
 522     (setq mew-pgp-failure mew-pgp-err-other)
 523     ;; Enter XXX:
 524     (process-send-string process "\n")
 525     (set-process-filter process 'mew-pgp-process-filter3))))
 526
 527 (defun mew-pgp-process-filter2 (process string)
 528   (setq mew-pgp-string (concat mew-pgp-string string))
 529   (cond
 530    ;; re-enter pass phrase
 531    ((string-match (mew-pgp-get mew-pgp-msg-reenter-pass) string)
 532     (setq mew-pgp-string nil)
 533     (mew-passwd-set-passwd (mew-pgp-get mew-pgp-keys) nil) ;; cancel anyway
 534     (process-send-string process (format "%s\n" (mew-pgp-passphrase 'again)))
 535     (set-process-filter process 'mew-pgp-process-filter2))
 536
 537    ;; pass phrases were wrong three times
 538    ((string-match (mew-pgp-get mew-pgp-msg-bad-pass) string)
 539     (setq mew-pgp-failure mew-pgp-err-pass)
 540     (mew-passwd-set-passwd (mew-pgp-get mew-pgp-keys) nil) ;; cancel anyway
 541     (set-process-filter process 'mew-pgp-process-filter3))
 542
 543    ;; no pubring for verify
 544    ((string-match (mew-pgp-get mew-pgp-msg-no-keyring) string)
 545     (setq mew-pgp-failure mew-pgp-err-pubring)
 546     ;; Enter public key filename:
 547     (process-send-string process "\n")
 548     (set-process-filter process 'mew-pgp-process-filter3))
 549
 550    ;; no public key for verify
 551    ((string-match (mew-pgp-get mew-pgp-msg-no-vrfkey) string)
 552     (setq mew-pgp-failure mew-pgp-err-pubkey)
 553     ;; Enter public key filename:
 554     (process-send-string process "\n")
 555     (set-process-filter process 'mew-pgp-process-filter3))
 556
 557    ;; after decrypted secret key, symmetric key is not uknown...
 558    ;; gpg: unknown cipher algorithm
 559    ;; no secret key or no secring for decrypt
 560    ((string-match (mew-pgp-get mew-pgp-msg-no-seckey-or-secring) string)
 561     (setq mew-pgp-failure mew-pgp-err-seckey-or-secring)
 562     (set-process-filter process 'mew-pgp-process-filter3))
 563
 564    ;; just in case
 565    ((string-match (mew-pgp-get mew-pgp-msg-enter) string)
 566     (setq mew-pgp-failure mew-pgp-err-other)
 567     ;; Enter XXX:
 568     (process-send-string process "\n")
 569     (set-process-filter process 'mew-pgp-process-filter3))))
 570
 571 (defun mew-pgp-process-filter3 (process string)
 572   ;; ending or error
 573   (setq mew-pgp-string (concat mew-pgp-string string))
 574   ;; string may contain old "Enter"
 575   (cond
 576    ;; just in case
 577    ((string-match (mew-pgp-get mew-pgp-msg-enter) string)
 578     ;; (setq mew-pgp-failure mew-pgp-err-other) ;; this is wrong
 579     ;; Enter XXX:
 580     (process-send-string process "\n")
 581     (set-process-filter process 'mew-pgp-process-filter3))))
 582
 583 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 584 ;;
 585 ;; shortcut methods
 586 ;;
 587
 588 (defun mew-pgp-sign-letter ()
 589   "Sign the entire draft with PGP. Input your passphrase."
 590   (interactive)
 591   (mew-pgp-encode-letter 'pgp-signature))
 592
 593 (defun mew-pgp-encrypt-letter ()
 594   "Encrypt the entire draft with PGP."
 595   (interactive)
 596   (mew-pgp-encode-letter 'pgp-encryption))
 597
 598 (defun mew-pgp-sign-encrypt-letter ()
 599   "Sign then encrypt the entire draft with PGP. Input your passphrase."
 600   (interactive)
 601   (mew-pgp-encode-letter 'pgp-signature-encryption))
 602
 603 (defun mew-pgp-encrypt-sign-letter ()
 604   "Encrypt then sign the entire draft with PGP. Input your passphrase."
 605   (interactive)
 606   (mew-pgp-encode-letter 'pgp-encryption-signature))
 607
 608 (defmacro mew-pgp-encode-letter (type)
 609   (` (if (null mew-pgp-ver)
 610          (message "%s doesn't exist" mew-prog-pgp)
 611        (mew-draft-make-message (, type)))))
 612
 613 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 614 ;;
 615 ;; key distribution
 616 ;;
 617
 618 (defun mew-pgp-check-old-pgp ()
 619   (goto-char (point-min))
 620   (if (re-search-forward (concat "^" mew-pgp-encryption-begin) nil t)
 621       'pgp-encryption
 622     (goto-char (point-min))
 623     (if (re-search-forward (concat "^" mew-pgp-signature-begin) nil t)
 624         'pgp-signature
 625       nil)))
 626
 627
 628 (defun mew-summary-decode-pgp ()
 629   "Decrypting/verifying old-fashioned PGP messages."
 630   (interactive)
 631   (if (null mew-pgp-ver)
 632       (message "%s doesn't exist" mew-prog-pgp)
 633     (mew-summary-msg
 634      (let* ((fld (mew-summary-folder-name))
 635             (msg (mew-summary-message-number))
 636             (file (mew-expand-folder-get-msg fld msg))
 637             file1 type result win start
 638             mew-inherit-from)
 639        (save-excursion
 640          (set-buffer (mew-buffer-message))
 641          (mew-elet
 642           (widen)
 643           (setq win (get-buffer-window (current-buffer)))
 644           (setq start (window-start win))
 645           (setq type (mew-pgp-check-old-pgp))
 646           (if (null type)
 647               (save-excursion
 648                 (mew-set-buffer-tmp)
 649                 (insert-file-contents file)
 650                 (setq type (mew-pgp-check-old-pgp))))
 651           (if (null type)
 652               (message "No PGP message was found")
 653             (setq mew-inherit-from
 654                   (mew-addrstr-parse-address
 655                    (mew-header-get-value mew-from:)))
 656             (goto-char (mew-header-end))
 657             (forward-line)
 658             (delete-region (point) (point-max))
 659             (cond
 660              ((equal type 'pgp-encryption)
 661               (setq result (mew-pgp-decrypt 'dummy file)))
 662              ((equal type 'pgp-signature)
 663               (setq result (mew-pgp-verify-old file))))
 664             (setq file1 (nth 0 result))
 665             (setq mew-syntax-privacy-result
 666                   (concat mew-x-mew: " <body> " (nth 1 result) "\n"))
 667             (save-excursion
 668               (goto-char (mew-header-end))
 669               (mew-decode-syntax-insert-privacy))
 670             (if (not (file-exists-p file1))
 671                 () ;; xxx
 672               (mew-frwlet
 673                mew-cs-text-for-read mew-cs-dummy
 674                (insert-file-contents file1))
 675               (delete-file file1))
 676             (if mew-mule-p
 677                 (mew-cs-decode-region (point) (point-max) mew-cs-rfc822-trans))
 678             (mew-message-set-end-of)
 679             (set-window-start win start)
 680             (set-buffer-modified-p nil))))))))
 681
 682 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 683 ;;
 684 ;; key distribution
 685 ;;
 686
 687 (defun mew-attach-pgp-public-key ()
 688   "Extract the PGP key for the inputed user on '.'. in attachments"
 689   (interactive)
 690   (if (not (mew-attach-not-line012-1))
 691       (message "Can't link here.")
 692     (let* ((error nil)
 693            (nums (mew-syntax-nums))
 694            (subdir (mew-attach-expand-path mew-encode-syntax nums))
 695            (attachdir (mew-attachdir))
 696            user file filepath begin end)
 697       ;; attachdir / {subdir/} dir
 698       (if (not (equal subdir ""))
 699           (setq attachdir (expand-file-name subdir attachdir)))
 700       ;; attachdir / file
 701       (setq filepath (mew-random-filename attachdir mew-pgp-key-suffix))
 702       (if (null filepath)
 703           (message "Could not make a file for pgp key, sorry.")
 704         (setq file (file-name-nondirectory filepath))
 705         (setq user (car (mew-input-address "Who's key? (%s): " (mew-get-my-address))))
 706         (save-excursion
 707           (mew-set-buffer-tmp)
 708           (apply (function call-process)
 709                  (mew-pgp-get mew-prog-pgpk)
 710                  nil t nil
 711                  (append
 712                   (mew-pgp-get mew-prog-pgpk-ext-arg)
 713                   (list user)))
 714           (goto-char (point-min))
 715           (if (search-forward (mew-pgp-get mew-pgp-msg-no-export-key) nil t)
 716               (setq error t)
 717             (goto-char (point-min))
 718             (if (not (search-forward mew-pgp-key-begin nil t))
 719                 (setq error t)
 720               (beginning-of-line)
 721               (setq begin (point))
 722               (if (not (search-forward mew-pgp-key-end nil t))
 723                   (setq error t)
 724                 (beginning-of-line)
 725                 (forward-line)
 726                 (setq end (point)))
 727               (write-region begin end filepath nil 'no-msg))))
 728         (if error
 729             (message "can't extract pgp key for %s" user)
 730           (setq mew-encode-syntax
 731                 (mew-syntax-insert-entry
 732                  mew-encode-syntax
 733                  nums
 734                  (mew-encode-syntax-single file mew-type-apk nil user)))
 735           (mew-encode-syntax-print mew-encode-syntax))))))
 736
 737 (defvar mew-pgp-tmp-file nil)
 738
 739 (defun mew-mime-pgp-keys (begin end &optional params execute)
 740   "A function to add PGP keys in Application/PGP-Keys to your
 741 public keyring."
 742   (interactive)
 743   (insert " ######   #####  ######  #     # ####### #     #\n"
 744           " #     # #     # #     # #    #  #        #   #\n"
 745           " #     # #       #     # #   #   #         # #\n"
 746           " ######  #  #### ######  ####    #######    #\n"
 747           " #       #     # #       #   #   #          #\n"
 748           " #       #     # #       #    #  #          #\n"
 749           " #        #####  #       #     # #######    #\n"
 750           "\n\n")
 751   (if execute
 752       (mew-pgp-add-keys begin end (mew-current-get 'cache)
 753                         (mew-buffer-message))
 754     (insert "\nTo add this key to your pubring, type "
 755             (substitute-command-keys
 756              "'\\<mew-summary-mode-map>\\[mew-summary-execute-external]'."))))
 757
 758 (defun mew-pgp-add-keys (begin end key-buf mes-buf)
 759   "A function to add PGP keys to your public keyring."
 760   (interactive)
 761   (if (not mew-pgp-ver)
 762       (message "PGP is not found")
 763     (if (not (y-or-n-p "Add this PGP key onto your public keyring? "))
 764         ()
 765       (setq mew-pgp-tmp-file (mew-make-temp-name))
 766       (save-excursion
 767         (set-buffer key-buf)
 768         (mew-frwlet
 769          mew-cs-dummy mew-cs-autoconv
 770          (write-region begin end mew-pgp-tmp-file nil 'no-msg))
 771         (set-buffer mes-buf)
 772         (mew-elet
 773          (message "Adding PGP keys ... ")
 774          (apply (function call-process)
 775                 (mew-pgp-get mew-prog-pgpk)
 776                 nil t nil
 777                 (append (mew-pgp-get mew-prog-pgpk-add-arg)
 778                         (list mew-pgp-tmp-file)))
 779          (message "Adding PGP keys ... done")
 780          (insert "\n\n"
 781                  "**************** IMPORTANT NOTE ****************\n"
 782                  "When Mew adds PGP keys onto your public keyring,\n"
 783                  "it is careless about both TRUST and VALIDITY.\n"
 784                  "It is YOU who set these values. Please use\n")
 785          (cond
 786           ((equal mew-pgp-ver mew-pgp-ver2)
 787            (insert "\"pgp -ke\" and \"pgp -ks\" to change them.\n"))
 788           ((equal mew-pgp-ver mew-pgp-ver5)
 789            (insert "\"pgpk -e\" and \"pgpk -s\" to change them.\n"))
 790           ((equal mew-pgp-ver mew-pgp-verg)
 791            (insert "\"gpg --edit-key\" to change them.\n")))
 792          (insert "If you don't know what TRUST and VALIDITY is,\n"
 793                  "you should learn the web of trust system BEFORE\n"
 794                  "using PGP to protect your privacy.\n"
 795                  "**************** IMPORTANT NOTE ****************\n")
 796          (if (equal mes-buf (mew-buffer-message))
 797              ()
 798            (let ((inhibit-quit t)) (read-char-exclusive)))))
 799       (if (file-exists-p mew-pgp-tmp-file)
 800           (delete-file mew-pgp-tmp-file)))))
 801
 802 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 803 ;;
 804 ;; key fetch
 805 ;;
 806
 807 (defun mew-pgp-fetch-key (arg)
 808   "Fetch PGP public key."
 809   (interactive "P")
 810   (if (null (processp mew-pgp-fetch-key-process))
 811       (let (key key-list buf keyid xurl xurl-list xmew uri userid)
 812         (save-excursion
 813           (set-buffer (mew-buffer-message))
 814           (setq userid (mew-header-parse-address mew-from:))
 815           (cond
 816            (arg
 817             (setq key-list mew-x-pgp-key-list)
 818             (setq key (car key-list))
 819             (while key
 820               (progn
 821                 (setq xurl (mew-header-get-value key))
 822                 (if (and xurl (string-match "http:[^ \t\n]*" xurl))
 823                     (progn
 824                       (setq xurl (substring xurl (match-beginning 0) (match-end 0)))
 825                       (setq xurl-list (append xurl-list (list xurl)))))
 826                 (setq key-list (cdr key-list))
 827                 (setq key (car key-list)))))
 828            (t (setq xmew (mew-header-get-value mew-x-mew:)))))
 829         (cond
 830          ((and arg xurl-list)
 831           (setq xurl (car xurl-list))
 832           (while (and xurl (not uri))
 833             (progn
 834               (if (y-or-n-p (format "fetch from %s? " xurl))
 835                   (setq uri xurl))
 836               (setq xurl-list (cdr xurl-list))
 837               (setq xurl (car xurl-list)))))
 838          ((and xmew
 839                (string-match "key. ID = \\(0x[0-9a-fA-F]+\\)" xmew nil)
 840                (setq keyid (substring xmew (match-beginning 1) (match-end 1))))
 841           (if (y-or-n-p (format "Fetch Key ID=%s? " keyid))
 842               (setq uri (format mew-pgp-keyserver-url-template keyid))))
 843          ((and userid
 844                (y-or-n-p (format "fetch User ID=%s? " userid)))
 845           (setq uri (format mew-pgp-keyserver-url-template userid))
 846           ))
 847         (if (not uri)
 848             (message "can't find PGP public key's information.")
 849           (setq buf (generate-new-buffer mew-buffer-pgpkey))
 850           (message "key fetching...%s." uri)
 851           (mew-piolet
 852            mew-cs-autoconv mew-cs-autoconv
 853            (setq mew-pgp-fetch-key-process
 854                  (start-process "Get PGP Key" buf mew-prog-imcat uri)))
 855           (set-process-sentinel mew-pgp-fetch-key-process
 856                                 'mew-pgp-fetch-process-done)))
 857     (if (y-or-n-p "Fetching process is running. Continue fetching process? ")
 858         ()
 859       (mew-pgp-fetch-process-kill))))
 860
 861 (defun mew-pgp-fetch-process-kill ()
 862   "Kill the current process fetching PGP keys."
 863   (interactive)
 864   (unwind-protect
 865       (if (processp mew-pgp-fetch-key-process)
 866           (kill-process mew-pgp-fetch-key-process))
 867     (setq mew-pgp-fetch-key-process nil)))
 868
 869 (defun mew-pgp-fetch-process-done (proc str)
 870   (let* ((buf (process-buffer proc))
 871          (wconf (current-window-configuration)))
 872     (save-excursion
 873       (mew-pop-to-buffer buf)
 874       (delete-other-windows)
 875       (goto-char (point-min))
 876       (if (and (search-forward mew-pgp-key-begin nil t)
 877                (search-forward mew-pgp-key-end nil t))
 878           (progn
 879             (goto-char (point-max))
 880             (insert "\n\n")
 881             (mew-pgp-add-keys (point-min) (point-max)
 882                               (current-buffer) (current-buffer)))
 883         (progn
 884           (goto-char (point-max))
 885           (insert "\n\n** PGP Key fetch failure. **\n\n")
 886           (let ((inhibit-quit t)) (read-char-exclusive))))
 887       (kill-buffer buf)
 888       (setq mew-pgp-fetch-key-process nil)
 889       (set-window-configuration wconf))))
 890
 891 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 892 ;; <Decrypt> or <Decrypt-then-Verify>
 893 ;;
 894 ;; no seckey no secring:: <1>
 895 ;; You do not have the secret key needed to decrypt this file.
 896 ;;
 897 ;;    <Verify> <2>
 898 ;;      Keyring file 'pubring.pgp' does not exist.
 899 ;;      Enter public key filename:
 900 ;;
 901 ;;      Key matching expected Key ID 1B8BF431 not found in file 'pubring.pgp'.
 902 ;;      Enter public key filename:
 903 ;;
 904 ;; <Sign> <1>
 905 ;;
 906 ;; A secret key is required to make a signature.
 907 ;; Keyring file 'secring.pgp' does not exist.
 908 ;; Enter secret key filename:
 909 ;;
 910 ;; A secret key is required to make a signature.
 911 ;; Key matching userid 'hoge' not found in file 'secring.pgp'.
 912 ;; Enter secret key filename:
 913 ;;
 914 ;; <Encrypt>
 915 ;;
 916 ;; Keyring file 'pubring.pgp' does not exist.
 917 ;;
 918 ;; Key matching userid 'hoge' not found in file 'pubring.pgp'.
 919 ;;
 920 ;; <Verify>
 921 ;; Keyring file 'pubring.pgp' does not exist.
 922 ;;
 923 ;; Key matching expected Key ID 1B8BF431 not found in file 'pubring.pgp'.
 924
 925 (provide 'mew-pgp)
 926
 927 ;;; Copyright Notice:
 928
 929 ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999 Mew developing team.
 930 ;; All rights reserved.
 931
 932 ;; Redistribution and use in source and binary forms, with or without
 933 ;; modification, are permitted provided that the following conditions
 934 ;; are met:
 935 ;;
 936 ;; 1. Redistributions of source code must retain the above copyright
 937 ;;    notice, this list of conditions and the following disclaimer.
 938 ;; 2. Redistributions in binary form must reproduce the above copyright
 939 ;;    notice, this list of conditions and the following disclaimer in the
 940 ;;    documentation and/or other materials provided with the distribution.
 941 ;; 3. Neither the name of the team nor the names of its contributors
 942 ;;    may be used to endorse or promote products derived from this software
 943 ;;    without specific prior written permission.
 944 ;;
 945 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 946 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 947 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 948 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 949 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 950 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 951 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 952 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 953 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 954 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 955 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 956
 957 ;;; mew-pgp.el ends here