cgit.sxemacs.org Git - packages/blob - xemacs-packages/mailcrypt/mc-gpg.el

   1 ;; mc-gpg.el, GPG support for Mailcrypt
   2 ;; Copyright (C) 1995  Jin Choi <jin@atype.com>
   3 ;;                     Patrick LoPresti <patl@lcs.mit.edu>
   4 ;;               1998  Brian Warner <warner@lothar.com>
   5
   6 ;; $Id: mc-gpg.el,v 1.6 2002-10-04 01:58:28 youngs Exp $
   7
   8 ;;{{{ Licensing
   9 ;; This file is intended to be used with GNU Emacs.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24 ;;}}}
  25 (require 'mailcrypt)
  26
  27 ; pieces to do:
  28
  29 ; #key lookup?
  30 ; #mc-gpg-encrypt-region
  31 ;  need to deal with untrusted keys, missing keys (offer to fetch), --throw
  32 ; #mc-gpg-decrypt-region [anything not clearsigned] (a,as,ae,ase)
  33 ;  need to implement signature-key fetch, ponder --throw-keyid case
  34 ;  keys without passphrases, sigs with bad algorithms (ignore sig? warn?)
  35 ; #mc-gpg-sign-region (clearsign/notclearsign)
  36 ; #mc-gpg-verify-region [clearsigned only] (ok/badsig/missingkey/corruptmsg)
  37 ; #mc-gpg-insert-public-key (comment, altkeyring)
  38 ; #mc-gpg-snarf-keys (one, multiple, old, corrupt)
  39 ; key fetching (is there a GPG key server yet?)
  40 ; clean up use of buffers, #kill off old tmp buffers
  41 ; in verify-region, print date of signature too
  42 ;  ~maybe have bad-signature message print keyid/date? (no, sig is invalid,
  43 ;  ~ anything other than its invalidity is misleading)
  44 ; make messages shorter (get it all to fit in echo area)
  45
  46 ; enhancements I'd like to add
  47 ;  trustdb status reporting during encryption/decryption: show the best trust
  48 ;   path to the recipient/signer?
  49 ;  completion on local id when signing (--list-secret-keys should know them)
  50 ;  algorithm preferences, possibly by destination user
  51 ;   (this is embedded in gpg)
  52 ;  extra options, possibly by destination user. Maybe for pgp5.0/pgp2.6 compat?
  53 ;  rfc2015 operation (MIME: application/pgp-signature, etc)
  54 ;  signature dates are currently reported with just the date. Find a time
  55 ;   formatting function and use the longtime in the VALIDSIG message.
  56
  57 ; mc-gpg-alternate-keyring seems dubious.. have two options, public/private?
  58
  59 ; using a shell introduces concerns about quoting and such. If the name of a
  60 ; key used as a recipient or as a mc-gpg-user-id (a key to sign with) has a
  61 ; double quote or ! or weird stuff, things could break.
  62
  63 ; encrypting to a nontrusted key is problematic: when not in --batch mode,
  64 ; gpg warns the user and asks if they want to use the key anyway. In --batch
  65 ; mode, it fails, even if we give --yes. Worse yet, if we encrypt to multiple
  66 ; recipients, the untrusted ones get dropped withou flagging an error (stderr
  67 ; does get a message, but it doesn't indicate which keys had a problem)
  68
  69 (defvar mc-gpg-user-id (user-login-name)
  70   "*GPG ID of your default identity.")
  71 (defvar mc-gpg-path "gpg" "*The GPG executable.")
  72 (defvar mc-gpg-display-snarf-output nil
  73   "*If t, pop up the GPG output window when snarfing keys.")
  74 (defvar mc-gpg-always-fetch 'never
  75   "*If t, always fetch missing keys. If 'never, never fetch. If nil,
  76 ask the user.")
  77 (defvar mc-gpg-alternate-keyring nil
  78   "*Public keyring to use instead of default.")
  79 (defvar mc-gpg-comment
  80    (format "Processed by Mailcrypt %s <http://mailcrypt.sourceforge.net/>"
  81            mc-version)
  82   "*Comment field to appear in ASCII armor output.  If nil, let GPG use its
  83 default.")
  84 (defconst mc-gpg-msg-begin-line "^-----BEGIN PGP MESSAGE-----\r?$"
  85   "Text for start of GPG message delimiter.")
  86 (defconst mc-gpg-msg-end-line "^-----END PGP MESSAGE-----\r?$"
  87   "Text for end of GPG message delimiter.")
  88 (defconst mc-gpg-signed-begin-line "^-----BEGIN PGP SIGNED MESSAGE-----\r?$"
  89   "Text for start of GPG signed messages.")
  90 (defconst mc-gpg-signed-end-line "^-----END PGP SIGNATURE-----\r?$"
  91   "Text for end of GPG signed messages.")
  92 (defconst mc-gpg-key-begin-line "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
  93   "Text for start of GPG public key.")
  94 (defconst mc-gpg-key-end-line "^-----END PGP PUBLIC KEY BLOCK-----\r?$"
  95   "Text for end of GPG public key.")
  96 (defvar mc-gpg-extra-args nil
  97   "Extra arguments to pass to all invocations of gpg. Used during debugging to
  98 set --homedir, to use special test keys instead of the developer's normal
  99 keyring.")
 100 (defvar mc-gpg-debug-buffer nil
 101   "A buffer for debugging messages. If nil, no debugging messages are logged.
 102 BEWARE! Sensitive data (including your passphrase) is put here. Set this with:
 103  (setq mc-gpg-debug-buffer (get-buffer-create \"mc debug\"))")
 104
 105 ;; we use with-current-buffer for clarity. emacs19 doesn't have it. This
 106 ;; code is cribbed from lazy-lock.el which does the same thing
 107 (eval-when-compile
 108   ;; We use this for clarity and speed.  Borrowed from a future Emacs.
 109   (or (fboundp 'with-current-buffer)
 110       (defmacro with-current-buffer (buffer &rest body)
 111         "Execute the forms in BODY with BUFFER as the current buffer.
 112 The value returned is the value of the last form in BODY."
 113         (` (save-excursion (set-buffer (, buffer)) (,@ body)))))
 114   )
 115
 116 (defun mc-gpg-debug-print (string)
 117   (if (and (boundp 'mc-gpg-debug-buffer) mc-gpg-debug-buffer)
 118       (print string mc-gpg-debug-buffer)))
 119
 120 ;; the insert parser will return '(t) and insert the whole of stdout if
 121 ;; rc == 0, and will return '(nil rc stderr) if rc != 0
 122 (defun mc-gpg-insert-parser (stdoutbuf stderrbuf statusbuf rc parserdata)
 123   (mc-gpg-debug-print
 124    (format "(mc-gpg-generic-parser stdoutbuf=%s stderrbuf=%s rc=%s"
 125            stdoutbuf stderrbuf rc))
 126   (if (= rc 0)
 127       '(t (t))
 128     (list nil nil rc (with-current-buffer stderrbuf (buffer-string))))
 129 )
 130
 131 ;; the null parser returns rc and never inserts anything
 132 (defun mc-gpg-null-parser (stdoutbuf stderrbuf statusbuf rc parserdata)
 133   (list nil rc))
 134
 135 ; utility function (variant of mc-process-region):
 136 ; take region in current buffer, send as stdin to a process
 137 ; maybe send in a passphrase first
 138 ; three buffers of output are collected: stdout, stderr, and --status-fd
 139 ;
 140 ; parser is called with stdoutbuf as the current buffer as
 141 ;  (parser stdoutbuf stderrbuf statusbuf rc parserdata)
 142 ; and is expected to return a list:
 143 ;  '(REPLACEP RESULT)
 144 ;
 145 ; if REPLACEP is true, the original buffer's [beg..end] will be replaced by
 146 ; the stdout data buffer's contents (all of it). Otherwise the original buffer
 147 ; is left alone. RESULT (specifically (cdr parser-return-value)) is returned
 148 ; by mc-gpg-process-region.
 149
 150 (defun mc-gpg-process-region (beg end passwd program args parser bufferdummy
 151                                   &optional parserdata)
 152   (let ((obuf (current-buffer))
 153         (process-connection-type nil)
 154         (shell-file-name "/bin/sh") ;; ??? force? need sh (not tcsh) for "2>"
 155         ; other local vars
 156         mybuf
 157         stderr-tempfilename stderr-buf
 158         status-tempfilename status-buf
 159         proc rc status parser-result
 160         )
 161     (mc-gpg-debug-print (format
 162        "(mc-gpg-process-region beg=%s end=%s passwd=%s program=%s args=%s parser=%s bufferdummy=%s)"
 163        beg end passwd program args parser bufferdummy))
 164     (setq stderr-tempfilename
 165           (make-temp-name (expand-file-name "mailcrypt-gpg-stderr-"
 166                                             mc-temp-directory)))
 167     (setq status-tempfilename
 168           (make-temp-name (expand-file-name "mailcrypt-gpg-status-"
 169                                             mc-temp-directory)))
 170     (unwind-protect
 171         (progn
 172           ;; get output places ready
 173           (setq mybuf (get-buffer-create " *mailcrypt stdout temp"))
 174           (set-buffer mybuf)
 175           (erase-buffer)
 176           (set-buffer obuf)
 177           (buffer-disable-undo mybuf)
 178
 179           (if passwd
 180               (setq args (append '("--passphrase-fd" "0") args)))
 181           (setq args (append (list (concat "2>" stderr-tempfilename)) args))
 182           (setq args (append (list (concat "3>" status-tempfilename)) args))
 183           (setq args (append '("--status-fd" "3") args))
 184
 185           (if mc-gpg-extra-args
 186               (setq args (append mc-gpg-extra-args args)))
 187
 188           (mc-gpg-debug-print (format "prog is %s, args are %s"
 189                                       program
 190                                       (mapconcat '(lambda (x)
 191                                                     (format "'%s'" x))
 192                                                  args " ")))
 193
 194           (setq proc
 195                 (apply 'start-process-shell-command "*GPG*" mybuf
 196                        program args))
 197           ;; send in passwd if necessary
 198           (if passwd
 199               (progn
 200                 (process-send-string proc (concat passwd "\n"))
 201                 (or mc-passwd-timeout (mc-deactivate-passwd t))))
 202           ;; send in the region
 203           (process-send-region proc beg end)
 204           ;; finish it off
 205           (process-send-eof proc)
 206           ;; wait for it to finish
 207           (while (eq 'run (process-status proc))
 208             (accept-process-output proc 5))
 209           ;; remember result codes
 210           (setq status (process-status proc))
 211           (setq rc (process-exit-status proc))
 212           (mc-gpg-debug-print (format "prog finished, rc=%s" rc))
 213
 214           ;; Hack to force a status_notify() in Emacs 19.29
 215           (delete-process proc)
 216
 217           ;; remove the annoying "yes your process has finished" message
 218           (set-buffer mybuf)
 219           (goto-char (point-max))
 220           (if (re-search-backward "\nProcess \\*GPG.*\n\\'" nil t)
 221               (delete-region (match-beginning 0) (match-end 0)))
 222           (goto-char (point-min))
 223           ;; CRNL -> NL
 224           (while (search-forward "\r\n" nil t)
 225             (replace-match "\n"))
 226
 227           ;; ponder process death: signal, not just rc!=0
 228           (if (or (eq 'stop status) (eq 'signal status))
 229               ;; process died
 230               (error "%s exited abnormally: '%s'" program rc) ;;is rc a string?
 231             )
 232
 233           (if (= 127 rc)
 234               (error "%s could not be found" program) ;; at least on my system
 235             )
 236
 237           ;; fill stderr buf
 238           (setq stderr-buf (get-buffer-create " *mailcrypt stderr temp"))
 239           (buffer-disable-undo stderr-buf)
 240           (set-buffer stderr-buf)
 241           (erase-buffer)
 242           (insert-file-contents stderr-tempfilename)
 243
 244           ;; fill status buf
 245           (setq status-buf (get-buffer-create " *mailcrypt status temp"))
 246           (buffer-disable-undo status-buf)
 247           (set-buffer status-buf)
 248           (erase-buffer)
 249           (insert-file-contents status-tempfilename)
 250
 251           ;; feed the parser
 252           (set-buffer mybuf)
 253           (setq parser-result (funcall parser
 254                                        mybuf stderr-buf status-buf
 255                                        rc parserdata))
 256           (mc-gpg-debug-print (format " parser returned %s" parser-result))
 257
 258           ;; what did the parser tell us?
 259           (if (car parser-result)
 260               ;; yes, replace region
 261               (progn
 262                 (set-buffer obuf)
 263                 (delete-region beg end)
 264                 (goto-char beg)
 265                 (insert-buffer-substring mybuf)
 266                 ))
 267
 268           ;; return result
 269           (cdr parser-result)
 270           )
 271       ;; cleanup forms
 272       (if (and proc (eq 'run (process-status proc)))
 273           ;; it is still running. kill it.
 274           (interrupt-process proc))
 275       (set-buffer obuf)
 276       (delete-file stderr-tempfilename)
 277       (delete-file status-tempfilename)
 278       ;; kill off temporary buffers unless we're debugging
 279       (if (or (not (boundp 'mc-gpg-debug-buffer))
 280               (not mc-gpg-debug-buffer))
 281           (progn
 282             (if (get-buffer " *mailcrypt stdout temp")
 283                 (kill-buffer " *mailcrypt stdout temp"))
 284             (if (get-buffer " *mailcrypt stderr temp")
 285                 (kill-buffer " *mailcrypt stderr temp"))
 286             (if (get-buffer " *mailcrypt status temp")
 287                 (kill-buffer " *mailcrypt status temp"))
 288             ))
 289 )))
 290
 291
 292 ; this lookup is used to turn key identifiers into names suitable for
 293 ; presentation to the user. When decrypting, the hex keyid to which the
 294 ; incoming message is encrypted is looked up to ask the user for a passphrase
 295 ; by name. When encrypting, the user's id (mc-gpg-user-id) is looked up to
 296 ; ask for a passphrase, and if mc-gpg-encrypt-to-me is true, the user's id
 297 ; is looked up to provide a full name to gpg. gpg is always given full names,
 298 ; because the hex keyids it provides might not work for both signing and
 299 ; encryption (split keys in gpg/pgp5)
 300 ;
 301 ;31:warner@zs2-pc4% gpg --list-secret-keys --with-colons --no-greeting
 302 ;/home/warner/.gnupg/secring.gpg
 303 ;-------------------------------
 304 ;sec::1024:17:1FE9CBFDC63B6750:1998-08-04:0:::Brian Warner (temporary GPG key) <warner@lothar.com>:
 305 ;ssb::1024:20:C68E8DE9F759FBDE:1998-08-04:0:::
 306 ;sec::768:17:16BD446D567E33CF:1998-08-04:0:::signature (sample signature key) <key@key>:
 307 ;sec::768:16:D514CB72B37D9AF4:1998-08-04:0:::crypt (crypt) <crypt@crypt>:
 308 ;sec::1024:17:4DBDD3258230A3E0:1998-08-04:0:::dummyy <d@d>:
 309 ;ssb::1024:20:549B0E6CBBBB43D1:1998-08-04:0:::
 310 ;
 311 ; we use the whole user id string (Brian..lothar.com>) as USER-ID, and the
 312 ; long keyid 1FE9CBFDC63B6750 for KEY-ID
 313
 314 (defvar mc-gpg-key-cache nil
 315   "Association list mapping GPG IDs to canonical \"keys\".  A \"key\"
 316 is a pair (USER-ID . KEY-ID) which identifies the canonical IDs of the
 317 GPG ID.")
 318
 319 (defun mc-gpg-lookup-key (str &optional type)
 320   ;; Look up the string STR in the user's secret key ring.  Return a
 321   ;; pair of strings (USER-ID . KEY-ID) which uniquely identifies the
 322   ;; matching key, or nil if no key matches.
 323   (let (args)
 324     (if (string= str "***** CONVENTIONAL *****") nil
 325       (let ((result (cdr-safe (assoc str mc-gpg-key-cache)))
 326             (key-regexp
 327              "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*:[^:]*:[^:]*:[^:]*:\\([^:]*\\):"
 328              )
 329             (obuf (current-buffer))
 330             buffer)
 331         (if (null result)
 332             (unwind-protect
 333                 (progn
 334                   (setq buffer (generate-new-buffer " *mailcrypt temp"))
 335                   (setq args (list
 336                               "--with-colons"
 337                               "--no-greeting" "--batch"
 338                               "--list-secret-keys" str
 339                               ))
 340                   (if mc-gpg-alternate-keyring
 341                       (setq args (append (list "--keyring"
 342                                                mc-gpg-alternate-keyring)
 343                                          args)))
 344                   (if mc-gpg-extra-args
 345                       (setq args (append mc-gpg-extra-args args)))
 346                   (mc-gpg-debug-print
 347                    (format "lookup: args are %s" args))
 348                   (let ((coding-system-for-read
 349                          (if (and (fboundp 'coding-system-p)
 350                                   (coding-system-p 'utf-8))
 351                              'utf-8 nil)))
 352                     (apply 'call-process mc-gpg-path nil buffer nil args))
 353                   (set-buffer buffer)
 354                   (goto-char (point-min))
 355                   (if (re-search-forward key-regexp nil t)
 356                       (progn
 357                         (setq result
 358                               (cons (buffer-substring-no-properties
 359                                      (match-beginning 3) (match-end 3))
 360                                     (concat
 361                                      "0x"
 362                                      (buffer-substring-no-properties
 363                                       (match-beginning 2) (match-end 2)))))
 364                         (setq mc-gpg-key-cache (cons (cons str result)
 365                                                      mc-gpg-key-cache)))))
 366                                         ;(if buffer (kill-buffer buffer))
 367               (set-buffer obuf)))
 368         (if (null result)
 369             (error "No GPG secret key for %s" str))
 370         result))))
 371
 372 ;gpg: no info to calculate a trust probability
 373 ;gpg: no valid addressees
 374 ;gpg: [stdin]: encryption failed: No such user id
 375
 376 (defun mc-gpg-encrypt-region (recipients start end &optional id sign)
 377   (let ((process-environment process-environment)
 378         (buffer (get-buffer-create mc-buffer-name))
 379         (obuf (current-buffer))
 380         action msg args key passwd result gpg-id)
 381     (mc-gpg-debug-print (format
 382        "(mc-gpg-encrypt-region recipients=%s start=%s end=%s id=%s sign=%s)"
 383        recipients start end id sign))
 384
 385     (setq args (list
 386                 "--batch" "--armor" "--textmode" "--always-trust"
 387                 (if recipients "--encrypt" "--store")
 388                 ))
 389     (setq action (if recipients "Encrypting" "Armoring"))
 390     (setq msg (format "%s..." action))  ; May get overridden below
 391     (if mc-gpg-comment
 392         (setq args (append (list "--comment" (format "'%s'" mc-gpg-comment))
 393                            args)))
 394     (if mc-gpg-alternate-keyring
 395         (setq args (append (list "--keyring" mc-gpg-alternate-keyring) args)))
 396
 397     (if (and (not (eq mc-pgp-always-sign 'never))
 398              (or mc-pgp-always-sign sign (y-or-n-p "Sign the message? ")))
 399         (progn
 400           (setq key (mc-gpg-lookup-key (or id mc-gpg-user-id) 'encrypt))
 401           (setq passwd
 402                 (mc-activate-passwd
 403                  (cdr key)
 404                  (format "GPG passphrase for %s (%s): " (car key) (cdr key))))
 405           (setq args
 406                 (append (list "--local-user" (cdr key)
 407                               "--sign"
 408                               )
 409                         args))
 410           (setq msg (format "%s+signing as %s ..." action (car key)))
 411           (if (not recipients)
 412               ;; the --store is last in args. remove it. remove --textmode too
 413               (setq args (nreverse (cddr (nreverse args)))))
 414           )
 415       )
 416
 417     ; if we're supposed to encrypt for the user too, we need their key
 418     ;; FIXME: we only need their public key, not the secret one. Some users
 419     ;; (the author included) keep their secret keys offline unless needed
 420     ;; (but the public ones are still available).. the --list-secret-keys
 421     ;; done by mc-gpg-lookup-key will fail in this situation. Change
 422     ;; mc-gpg-lookup-key to have a way to look for public keys too.
 423     (if (and recipients mc-encrypt-for-me)
 424         (setq recipients (cons (cdr (or key
 425                                         (setq key (mc-gpg-lookup-key
 426                                                    mc-gpg-user-id 'encrypt)))
 427                                     ) recipients)))
 428
 429     ; push(@args, map {qq<-r "$_">} @recipients) if @recipients; # roughly
 430     (if recipients
 431         (setq args (append (apply 'append
 432                                   (mapcar '(lambda (x)
 433                                              (list "--recipient"
 434                                                    (concat "\"" x "\"")))
 435                                           recipients))
 436                            args)))
 437
 438     (message "%s" msg)
 439     (setq result (mc-gpg-process-region start end passwd mc-gpg-path args
 440                                         'mc-gpg-insert-parser buffer))
 441     (if (not (car result))
 442         (error "%s failed: %s" msg (nth 2 result)))
 443
 444     t
 445 ))
 446
 447
 448 ; GPG DECRYPT BEHAVIOR:  gnupg-0.9.9 only
 449 ;  (all status messages are prefixed by "[GNUPG:] "
 450
 451 ; signed (not encrypted) by a known key [S.s1v]:
 452 ;  rc == 0, stdout has message
 453 ;  status:
 454 ;   SIG_ID <sigid> <date> <longtime>
 455 ;   GOODSIG <longkeyid> <username>
 456 ;   VALIDSIG <keyfingerprint> <date> <longtime>
 457 ;   TRUST_foo
 458
 459 ; signed (not encrypted) by unknown key [S.s4]:
 460 ;  rc == 2, stdout has message
 461 ;  status:
 462 ;   ERRSIG <longkeyid> <pubkeyalgo> <hashalgo> <sigclass> <longtime> <rc>
 463 ;   NO_PUBKEY <longkeyid>
 464
 465 ; encrypted to a private key we don't have [E.e3]:
 466 ;  rc == 2,
 467 ;  stderr: gpg: decryption failed: secret key not available
 468 ;  status:
 469 ;   ENC_TO <longkeyid> <keytype> <keylength==0>
 470 ;   NO_SECKEY <longkeyid>
 471 ;   DECRYPTION_FAILED
 472
 473 ; encrypted to us, our key has no passphrase
 474 ;  rc == 0?
 475 ;  stderr: gpg: NOTE: secret key foo is NOT protected
 476 ;  status:
 477 ;   ENC_TO <longkeyid> <keytype> <keylen==0>
 478 ;   GOOD_PASSPHRASE
 479 ;   DECRYPTION_OKAY
 480
 481 ; encrypted to us, but we didn't give a passphrase [E.e1r, no pw]:
 482 ;  rc == 2
 483 ;  stderr: gpg: fatal: Can't query password in batchmode
 484 ;  status:
 485 ;    ENC_TO <longkeyid> <keytype> <keylength==0>
 486 ;    NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>
 487 ;    MISSSING_PASSPHRASE
 488 ;    BAD_PASSPHRASE <longkeyid>
 489 ;    DECRYPTION_FAILED
 490 ; (N.B.: gpg cannot tell tell the difference between no passphrase and an
 491 ;  empty passphrase.)
 492
 493 ; encrypted to us *and someone else*, no passphrase [E.e3re1r, no pw]:
 494 ;  rc == 2?
 495 ;  stderr: gpg: fatal: Can't query password in batchmode
 496 ;  status:
 497 ;    ENC_TO <longkeyid1> <keytype> <keylength==0>
 498 ;    NEED_PASSPHRASE <longkeyid1> <otherlongkeyid> <keytype> <keylen==0>
 499 ;    MISSSING_PASSPHRASE
 500 ;    BAD_PASSPHRASE <longkeyid1>
 501 ;    ENC_TO <longkeyid2> .. ..
 502 ;    NO_SECKEY <longkeyid2>
 503 ;    DECRYPTION_FAILED
 504
 505 ; encrypted to us, but we used the wrong passphrase [E.e1r, bad pw]:
 506 ;  rc == 2
 507 ;  stderr: gpg: public key decryption failed: [Bb]ad passphrase
 508 ;  status:
 509 ;    ENC_TO <longkeyid> <keytype> <keylength==0>
 510 ;    NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>
 511 ;    BAD_PASSPHRASE <longkeyid>
 512 ;    DECRYPTION_FAILED
 513
 514 ; encrypted to us, good passphrase [E.e1r, good pw]:
 515 ;  rc == 0, stdout has message
 516 ;  status:
 517 ;    ENC_TO <longkeyid> <keytype> <keylength==0>
 518 ;    NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>
 519 ;    GOOD_PASSPHRASE
 520 ;    DECRYPTION_OKAY
 521
 522 ; encrypted to us, good passphrase, signed by trusted/untrusted party
 523 ;                                        [ES.e1r.s1v, good ps]:
 524 ;  rc == 0, stdout has message
 525 ;  stderr: gpg: Signature made <date> using DSA key ID <pubkeyid>
 526 ;  stderr: gpg: Good signature from "<keyname>"
 527 ;  status:
 528 ;    ENC_TO <longkeyid> <keytype> <keylength==0>
 529 ;    NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>
 530 ;    GOOD_PASSPHRASE
 531 ;    SIG_ID <sigid> <date> <longtime>
 532 ;    GOODSIG <longkeyid> <username>
 533 ;    VALIDSIG <keyfingerprint> <date> <longtime>
 534 ;    TRUST_(UNDEFINED|NEVER|MARGINAL|FULLY|ULTIMATE)
 535 ;    DECRYPTION_OKAY
 536
 537 ; encrypted to us, good passphrase, signed by unknown party [ES.e1r.s4]:
 538 ;  rc == 2, stdout has message
 539 ;  stderr: gpg: Signature made <date> using DSA key ID <pubkeyid>
 540 ;  stderr: gpg: Can't check signature: [Pp]ublic key not found
 541 ;  status:
 542 ;    ENC_TO <longkeyid> <keytype> <keylength==0>
 543 ;    NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>
 544 ;    GOOD_PASSPHRASE
 545 ;    ERRSIG <longkeyid> <pubkeyalgo> <hashalgo> <sigclass> <longtime> <rc>
 546 ;     rc: 4 is unknown algorithm, 9 is missing public key
 547 ;    NO_PUBKEY <longkeyid>
 548 ;    DECRYPTION_OKAY
 549
 550 ; symmetrically encrypted, we didn't give a passphrase
 551 ;  rc == 2, stderr: gpg: fatal: Can't query password in batchmode
 552 ;  status:
 553 ;    NEED_PASSPHRASE_SYM <cipheralgo> <s2kmode> <s2khash>
 554 ;    MISSING_PASSPHRASE
 555 ;    DECRYPTION_FAILED
 556
 557 ; symmetrically encrypted, we gave the wrong passphrase
 558 ;  rc == 2, stderr: gpg: decryption failed: [Bb]ad key
 559 ;  status:
 560 ;    NEED_PASSPHRASE_SYM <cipheralgo> <s2kmode> <s2khash>
 561 ;    DECRYPTION_FAILED
 562
 563 ; symmetrically encrypted, good passphrase
 564 ;  rc == 0, stdout: message
 565 ;  status:
 566 ;    NEED_PASSPHRASE_SYM <cipheralgo> <s2kmode> <s2khash>
 567 ;    DECRYPTION_OKAY
 568
 569 ; armored [A]:
 570 ;  rc == 0, stdout: message
 571 ;  no status
 572
 573 ; corrupted armor
 574 ;  rc == 2, stderr: gpg: CRC error; stuff - stuff
 575
 576 ; ( to test: multiple recipients, keys without passphrases)
 577
 578
 579 ;; this parser's return convention:
 580 ;;   '( (
 581 ;;       replacep ; consumed by process-region: decrypt was successful
 582 ;;0      have-secret-key ; t: we are a recipient (TODO: stealth),
 583 ;;                         'symmetric : need passphrase
 584 ;;                         'signed : signed not encrypted
 585 ;;                         nil: not a recipient
 586 ;;1      passphrase-ok ; t was good, nil was bad, keyid: need pw for keyid
 587 ;;2      signature:
 588 ;;        nil: no sig
 589 ;;        keyid-hex : don't have signature key
 590 ;;        '(keyid-string t trust date) : good signature on date with trust
 591 ;;        '(keyid-string nil trust date) : bad signature on date with trust
 592 ;;       )
 593 ;;      )
 594 ; todo: stealth ("--throw-keyid")?
 595 ;       when there is a signature that we can't check because of a bad algo
 596 ;       then we pretend there wasn't a signature. extend the return convention
 597 ;       to signal this case.
 598 ;       when there is a signature that we can't check because we don't
 599 ;       currently have a key, and if we successfully fetch that key in
 600 ;       mc-gpg-decrypt-region, how do we restart the operation?
 601
 602 ;; cases:
 603 ;;  *not addressed to us (nil nil nil)
 604 ;;  *just armored (same as good symmetric) ('symmetric t nil)
 605 ;;  conventionally encrypted
 606 ;;   *didn't give passphrase ('symmetric "***** CONVENTIONAL *****" nil)
 607 ;;   did give passphrase
 608 ;;    *bad passphrase ('symmetric nil nil)
 609 ;;    *good passphrase ('symmetric t nil)
 610 ;;  signed (not clearsigned), not encrypted
 611 ;;    *don't have key ('signed t keyid)
 612 ;;    do have key
 613 ;;     *good sig ('signed t (t keyid-string trust date))
 614 ;;     *bad sig ('signed t (nil keyid-string trust date))
 615 ;;  encrypted to us:
 616 ;;   *didn't give passphrase (t keyid nil)
 617 ;;   gave passphrase:
 618 ;;    *bad passphrase (t nil nil)
 619 ;;    good passphrase
 620 ;;     decrypted ok
 621 ;;      *no signature (t t nil)
 622 ;;      yes signature
 623 ;;       *don't have key (offer to fetch) (t t keyid)
 624 ;;       do have key
 625 ;;        *good sig (t t (t keyid-string date trust))
 626 ;;        *bad sig (t t (nil keyid-string date trust))
 627
 628 ;; a subfunction to extract the signature info. Used in both decrypt-parser
 629 ;; and verify-parser. Call with statusbuf. Returns
 630 ;;  '(sigtype sigid sigdate sigtrust)
 631
 632 (defun mc-gpg-sigstatus-parser ()
 633   (let (sigtype sigid sigdate sigtrust)
 634
 635     ;; sigtype: GOOD, BAD, ERR
 636     ;; sigid: who made the signature? (a name if possible, else hex keyid)
 637     ;; sigdate: date string of when the sig was made
 638     (goto-char (point-min))
 639     (if (re-search-forward "^\\[GNUPG:\\] +\\(GOOD\\|BAD\\|ERR\\)SIG\\b"
 640                            nil t)
 641         (progn
 642           (setq sigtype (match-string 1))
 643           (goto-char (point-min))
 644           (if (and (or (string= sigtype "GOOD") (string= sigtype "BAD"))
 645                    (re-search-forward
 646                     "^\\[GNUPG:\\] +\\(GOOD\\|BAD\\)SIG +\\(\\S +\\) +\\(.*\\)$" nil t))
 647               ;; match-string 2 is the hex keyid of the signator.
 648               ;; #3 is the name
 649               (setq sigid (match-string 3)))
 650
 651           ;; for ERRSIG:
 652           ;;   match-string #1 is the hex keyid, #2 is the algorithm ID
 653           ;;       (17: DSA, 1,3: RSA, 20: Elgamal)
 654           ;;  #3: hashalgo, #4: sigclass, #5: longtime, #6: rc
 655           ;;   (rc==4 for unknown algo, 9 for missing public key)
 656           ;; we only set sigtype if:
 657           ;;   (#1 is present), and
 658           ;;   ((#6 is missing) or (#6 == 9))
 659           ;; the idea being to not fetch a key if we aren't going to be able
 660           ;; to use the algorithm it wants
 661           (goto-char (point-min))
 662           (if (and (string= sigtype "ERR")
 663                    (re-search-forward
 664                     "^\\[GNUPG:\\] +ERRSIG +\\(\\S +\\)" nil t))
 665               (let (errsig-rc (sigid-temp (match-string 1)))
 666                 (goto-char (point-min))
 667                 (if (re-search-forward
 668                      "^\\[GNUPG:\\] +ERRSIG +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\)" nil t)
 669                     (setq errsig-rc (match-string 6)))
 670                 (if (or
 671                      (not errsig-rc)
 672                      (string= errsig-rc "9"))
 673                     (setq sigid sigid-temp))
 674                 ))
 675
 676           ;; for GOODSIG:
 677           ;;  VALIDSIG should be present, with <keyfingerprint> <date> <time>
 678           (goto-char (point-min))
 679           (if (and (string= sigtype "GOOD")
 680                    (re-search-forward
 681                     "^\\[GNUPG:\\] +SIG_ID +\\(\\S +\\) +\\(\\S +\\)\\b"
 682                     nil t))
 683               (setq sigdate (match-string 2))
 684             ;; in gpg >= 0.9.7, a third field is a longtime value (seconds
 685             ;; since epoch)
 686             )
 687
 688           ;; sigtrust: how trusted is the signing key?
 689           (goto-char (point-min))
 690           (if (re-search-forward "^\\[GNUPG:\\] +\\(TRUST_\\S +\\)$" nil t)
 691               (setq sigtrust (match-string 1)))
 692           ))
 693
 694     (list sigtype sigid sigdate sigtrust))
 695   )
 696
 697
 698 ; this parser's job is to find the decrypted data if any is available. The
 699 ; code in -decrypt-region will worry about reporting other status information
 700 ; like signatures. PARSERDATA is non-nil if a passphrase was given to GPG.
 701
 702 (defun mc-gpg-decrypt-parser (stdoutbuf stderrbuf statusbuf rc parserdata)
 703   (let
 704       (
 705        decryptstatus ; DECRYPTION_(OKAY|FAILED)
 706        no-seckey ; NO_SECKEY
 707        keyid ; NEED_PASSPHRASE <keyid>
 708        missing-passphrase ; MISSING_PASSPHRASE
 709        symmetric ; NEED_PASSPHRASE_SYM
 710        badpass ; BAD_PASSPHRASE
 711        sigtype ; GOODSIG, BADSIG, ERRSIG
 712        sigid ;; GOODSIG <keyid>  (note: not SIG_ID!),
 713              ;;; or ERRSIG <keyid> if ERRSIG-rc is 9 for missing pubkey
 714        sigdate ; VALIDSIG .. <date>
 715        sigtrust ; TRUST_(UNDEFINED|NEVER|MARGINAL|FULLY|ULTIMATE)
 716        )
 717     ;; this code is split into two pieces. The first scans statusbuf
 718     ;; (and stderr if absolutely necessary) for keywords, setting the
 719     ;; local variables to describe what happened during our decryption attempt.
 720     ;; We don't try too hard to interpret the results yet.
 721
 722     ;; the second part (the big cond statement below) interprets those vars
 723     ;; to decide what to report to the caller
 724
 725     (set-buffer statusbuf)
 726
 727     ;; decryptstatus: no decryption took place, one was ok, or one failed
 728     (goto-char (point-min))
 729     (if (re-search-forward
 730          "^\\[GNUPG:\\] +DECRYPTION_\\(OKAY\\|FAILED\\)\\b"
 731          nil t)
 732         (setq decryptstatus (match-string 1)))
 733
 734     ;; no-seckey: set if we saw a NO_SECKEY message.
 735     (goto-char (point-min))
 736     (if (re-search-forward
 737          "^\\[GNUPG:\\] +NO_SECKEY\\b"
 738          nil t)
 739         (setq no-seckey t))
 740
 741     ;; keyid: the message is encrypted to one of our private keys and we
 742     ;; need a passphrase from the user. which one?
 743     (goto-char (point-min))
 744     (if (re-search-forward "^\\[GNUPG:\\] +NEED_PASSPHRASE +\\(\\S +\\)"
 745                            nil t)
 746         (setq keyid (concat "0x" (match-string 1))))
 747
 748     ;; missing-passphrase: set if we saw MISSING_PASSPHRASE
 749     (goto-char (point-min))
 750     (if (re-search-forward "^\\[GNUPG:\\] +MISSING_PASSPHRASE\\b"
 751                            nil t)
 752         (setq missing-passphrase t))
 753
 754     ;; symmetric: Set if the message is symmetrically encrypted.
 755     (goto-char (point-min))
 756     (if (re-search-forward
 757          "^\\[GNUPG:\\] +NEED_PASSPHRASE_SYM\\b"
 758          nil t)
 759         (setq symmetric t))
 760
 761     ;; badpass: GPG did not get a good passphrase. Either we didn't give one
 762     ;;  or we gave the wrong one.
 763     (goto-char (point-min))
 764     (if (re-search-forward "^\\[GNUPG:\\] +BAD_PASSPHRASE\\b"
 765                            nil t)
 766         (setq badpass t))
 767
 768     (let ((sigstuff (mc-gpg-sigstatus-parser)))
 769       (setq sigtype (nth 0 sigstuff))
 770       (setq sigid (nth 1 sigstuff))
 771       (setq sigdate (nth 2 sigstuff))
 772       (setq sigtrust (nth 3 sigstuff))
 773       )
 774
 775     ;; begin second piece: stare at those variables and decide what happened.
 776     ;; refer to the "cases:" comment above for what we look for.
 777
 778     (mc-gpg-debug-print
 779      (format
 780       "decrypt-parser: decryptstatus=%s no-seckey=%s keyid=%s missing-passphrase=%s symmetric=%s badpass=%s sigtype=%s sigid=%s sigdate=%s sigtrust=%s rc=%s"
 781       decryptstatus no-seckey keyid missing-passphrase symmetric badpass sigtype sigid sigdate sigtrust rc))
 782
 783     (cond
 784
 785      ((and (not decryptstatus) (not (or keyid symmetric)))
 786       ;; either corrupt, armored-only, signed-only
 787       ;;  or we're using an old gpg and no passphrase was requested:
 788       ;;   either corrupt, armored-only, signed-only, or not for us.
 789       (cond
 790        (sigtype
 791         ;; signed-only. extract info
 792         (cond
 793          ((string= sigtype "GOOD")        ;; good signature
 794           (list t 'signed t (list t sigid sigtrust sigdate)))
 795          ((string= sigtype "BAD")   ;; bad signature
 796           (list t 'signed t (list nil sigid sigtrust sigdate)))
 797          ((string= sigtype "ERR")   ;; couldn't check: why?
 798           (if sigid
 799               ;; didn't have the key, we can fetch it
 800               (list t 'signed t sigid)
 801             ;; can't use it. pretend it wasn't signed.
 802             (list t t t nil)))
 803          (t  ;; sigtype is bogus
 804           (error "sigtype was bogus. Shouldn't happen."))
 805          ))
 806        ((not (= rc 0))  ;; corrupt
 807         (error "The message was corrupt."))
 808        (t  ;; armored-only
 809         (list t 'symmetric t nil))
 810        ))
 811
 812      ((or
 813        (string= decryptstatus "FAILED")
 814        ;; couldn't decrypt: not to us, need pw, bad pw
 815        (and (not decryptstatus)
 816             (or keyid symmetric)
 817             (not (= rc 0))
 818             (not (string= sigtype "ERR")))
 819        ;; or old gpg and we could have decrypted it (a passphrase was
 820        ;; requested), but the decrypt went bad (rc!=0 but not due to ERRSIG)
 821        )
 822       (cond
 823        ((and (not symmetric) (not keyid))
 824         ;; didn't ask for a passphrase, ergo it isn't for us
 825         (list nil nil nil nil))
 826        ((or missing-passphrase (not parserdata))
 827         ;; we didn't give a passphrase, need pubkey or symmetric
 828         (if symmetric
 829             (list nil 'symmetric "***** CONVENTIONAL *****" nil)
 830           (list nil t keyid nil)))
 831        (symmetric ;; symmetric fails without a BAD_PASSPHRASE
 832         (list nil 'symmetric nil nil))
 833        ((or badpass parserdata)
 834         ;; probably pubkey, we gave the wrong passphrase
 835         (list nil t nil nil))
 836        (t  ;; shouldn't happen, error out
 837         (error "decryption failed, but I don't know why. Shouldn't happen."))
 838        ))
 839
 840      ((or
 841        (string= decryptstatus "OKAY")
 842        ;; decrypted okay, check for signature
 843        (and (not decryptstatus)
 844             keyid
 845             (not (= rc 0))
 846             (string= sigtype "ERR"))
 847        ;; or old gpg and sigcheck went bad (rc!=0 due to ERRSIG)
 848        (and (not decryptstatus)
 849             keyid
 850             (= rc 0))
 851        ;; or old gpg, passphrase was requested, no errors reported
 852        )
 853       (cond
 854        (sigtype   ;; there was a signature, extract the info (never sym here)
 855         (cond
 856          ((string= sigtype "GOOD")  ;; good signature
 857           (list t t t (list t sigid sigtrust sigdate)))
 858          ((string= sigtype "BAD")   ;; bad signature
 859           (list t t t (list nil sigid sigtrust sigdate)))
 860          ((string= sigtype "ERR")   ;; couldn't check: why?
 861           (if sigid
 862               ;; didn't have the key. we can fetch it.
 863               (list t t t sigid)
 864             ;; no keyid, or we can't use it. pretend there wasn't a sig.
 865             (list t t t nil)))
 866          (t  ;; sigtype is bogus
 867           (error "sigtype was bogus. Shouldn't happen."))
 868          ))
 869        (t         ;; there wasn't a signature
 870         (if symmetric
 871             (list t 'symmetric t nil)
 872           (list t t t nil)))
 873        ))
 874
 875      (t  ;; decryptstatus was bogus. error out.
 876       (error "decryptstatus was bogus '%s'. Shouldn't happen." decryptstatus))
 877
 878      )
 879     ))
 880
 881
 882
 883
 884 ;; message about who made the signature. This is a bit wide.. the date can
 885 ;; easily run off the echo area. Consider replacing 'Good signature' with
 886 ;; 'good sig', but keep it consistent with everything else. This function is
 887 ;; used by both the decrypt section and the verify section.
 888 ;; todo: should the keyid be put in here? If the user reads the trustvalue,
 889 ;;  and if they have a trust path, then they can trust the name.
 890 (defun mc-gpg-format-sigline (goodp sigid sigtrust sigdate)
 891   (if goodp
 892       (format "Good signature from '%s' %s made %s"
 893               sigid sigtrust sigdate)
 894     (format "BAD SIGNATURE claiming to be from '%s'" sigid)
 895     ))
 896
 897 ;; decrypt-region is first called without ID. This means we'll try to decrypt
 898 ;; without a passphrase, almost guaranteed to fail, but it will tell us which
 899 ;; key is necessary. We then call decrypt-region again, this time with ID
 900 ;; set. This second time will lookup ID and ask the user for the passphrase.
 901
 902 (defun mc-gpg-decrypt-region (start end &optional id)
 903   ;; returns a pair (SUCCEEDED . VERIFIED) where SUCCEEDED is t if
 904   ;; the decryption succeeded and verified is t if there was a valid signature
 905   (let ((process-environment process-environment)
 906         (buffer (get-buffer-create mc-buffer-name))
 907         (obuf (current-buffer))
 908         args key new-key passwd result gpg-id)
 909     (mc-gpg-debug-print (format "(mc-gpg-decrypt-region start=%s end=%s id=%s)"
 910                                 start end id))
 911     (undo-boundary)
 912     (if id
 913         ;; second time through, now we know who the message is for.
 914         ;; id is either a hex keyid of the (first?) secret key that is in
 915         ;; the message's recipient list, or "**..CONVENTIONAL.."
 916         (progn
 917           (setq key (mc-gpg-lookup-key id 'encrypt))
 918           ;; key is nil if CONVENTIONAL, (string . hexid) otherwise
 919           (setq passwd
 920                 (if key
 921                     (mc-activate-passwd (cdr key)
 922                                         (format
 923                                          "GPG passphrase for %s (%s): "
 924                                          (car key) (cdr key)))
 925                   (mc-activate-passwd
 926                    id "GPG passphrase for conventional decryption: ")))
 927           (if (string= passwd "")
 928               (progn
 929                 (mc-deactivate-passwd t)
 930                 (error "Empty passphrases are bad, mmkay?")))
 931           ;; in particular, they cause an infinite loop. If the key doesn't
 932           ;; have a passphrase, the decryption should have worked the first
 933           ;; time around.
 934           ))
 935     (setq args '("--batch"))
 936     (if mc-gpg-alternate-keyring
 937         (setq args (append args (list "--keyring" mc-gpg-alternate-keyring))))
 938     (setq args (append args '("--decrypt"))) ; this wants to be last
 939     (message "Decrypting...")
 940     ;; pass ID as the parserdata. This will be non-nil if a passphrase was
 941     ;; given (i.e. 2nd pass), which affects decrypt status parsing
 942     (setq result
 943           (mc-gpg-process-region
 944            start end passwd mc-gpg-path args 'mc-gpg-decrypt-parser buffer id))
 945     ;(message "Decrypting... Done.")
 946     ;; result: '(HAVE-SECRET-KEY PASSPHRASE-OK SIG)
 947     ;;  SIG: nil, sigkeyid, or '(KEYID GOODP TRUSTLEVEL DATESTRING)
 948     (cond
 949      ((not (nth 0 result)) ;; we were not a recipient
 950       (error "This message is not addressed to you"))
 951      ((not (nth 1 result)) ;; passphrase-ok is nil: bad passphrase
 952       (mc-deactivate-passwd t)
 953       (error "That passphrase was wrong"))
 954      ((not (equal (nth 1 result) t)) ;; passphrase-ok is keyid: need passphrase
 955       ;; get passphrase for (nth 1 result), try again
 956       (mc-gpg-decrypt-region start end (nth 1 result))
 957       )
 958      ;; passphrase was ok, were able to decrypt
 959      ((nth 2 result) ;; there was a signature
 960       (let ((sig (nth 2 result)))
 961         (cond
 962          ((atom sig) ;; don't have the signature key
 963           (progn
 964             ;; offer to fetch the key, then what? run again? must we undo 1st?
 965             (mc-message-sigstatus
 966              (format "cannot check signature from keyid %s" sig))
 967             (if (and (not (eq mc-gpg-always-fetch 'never))
 968                      (or mc-gpg-always-fetch
 969                          (y-or-n-p
 970                           (format "Key %s not found; attempt to fetch? " sig)))
 971                      (mc-gpg-fetch-key (cons nil sig)))
 972                 (progn
 973                   (undo-start)
 974                   (undo-more 1)
 975                   (mc-gpg-decrypt-region start end id))
 976               '(t . nil))
 977             ))
 978          ((nth 0 sig) ;; good signature
 979           (progn
 980             (mc-message-sigstatus (mc-gpg-format-sigline
 981                                    t (nth 1 sig) (nth 2 sig) (nth 3 sig)))
 982             '(t . t)
 983             ))
 984          (t ;; bad signature
 985           (progn
 986             (mc-message-sigstatus (mc-gpg-format-sigline
 987                                    nil (nth 1 sig) (nth 2 sig) (nth 3 sig))
 988                                   t ; get their attention
 989                                   )
 990             '(t . nil)
 991             ))
 992        )))
 993      (t ;; no signature
 994       (message "Decrypting... Done.")
 995       '(t . nil)
 996       ))
 997     ))
 998
 999 (defun mc-gpg-sign-region (start end &optional id unclear)
1000   (let ((process-environment process-environment)
1001         (buffer (get-buffer-create mc-buffer-name))
1002         passwd args key result)
1003     (setq key (mc-gpg-lookup-key (or id mc-gpg-user-id) 'sign))
1004     (setq passwd
1005           (mc-activate-passwd
1006            (cdr key)
1007            (format "GPG passphrase for %s (%s): " (car key) (cdr key))))
1008     (setq args
1009           (list
1010            "--batch" "--armor"
1011            "--local-user" (cdr key)
1012            (if unclear "--sign" "--clearsign")
1013            ))
1014     (if mc-gpg-comment
1015         (setq args (append (list "--comment" (format "'%s'" mc-gpg-comment))
1016                            args)))
1017     (if mc-gpg-extra-args
1018         (setq args (append mc-gpg-extra-args args)))
1019     (message "Signing as %s ..." (car key))
1020     (setq result (mc-gpg-process-region start end passwd mc-gpg-path args
1021                                         'mc-gpg-insert-parser buffer))
1022     (if (car result)
1023         (message "Signing as %s ... Done." (car key))
1024       (progn
1025         (mc-deactivate-passwd t)
1026         (error "Signature failed: %s" (nth 2 result))
1027         ))
1028     (car result)
1029 ))
1030
1031
1032 ; GPG VERIFY BEHAVIOR: gnupg-0.9.9 only
1033 ;  (all status messages are prefixed by "[GNUPG:] "
1034 ;  (filenames in [] are my parts of my testsuite)
1035
1036 ; corrupted sig (armor is corrupt) [CS.s1bad]:
1037 ;  rc == 2
1038 ;  stderr: gpg: CRC error; stuff - stuff
1039 ;          gpg: packet(1) with unknown version
1040
1041 ; GOOD sig from a known key [CS.s1v,CS.s2v,CS.s3v]
1042 ;  rc == 0
1043 ;  status:
1044 ;    SIG_ID <sigid> <date> <longtime>
1045 ;    GOODSIG <longkeyid> <username>
1046 ;    VALIDSIG <keyfingerprint> <date> <longtime>
1047 ;    TRUST_(UNDEFINED|NEVER|MARGINAL|FULLY|ULTIMATE)
1048
1049 ; BAD sig from a known key [CS.s1f]:
1050 ;  rc == 1
1051 ;  status: BADSIG <longkeyid> <username>
1052
1053 ; unknown key [CS.s4]:
1054 ;  rc == 2
1055 ;  status:
1056 ;   ERRSIG <longkeyid> <pubkeyalgo> <hashalgo> <sigclass> <longtime> <rc==9>
1057 ;   NO_PUBKEY <longkeyid>
1058
1059 ;; so no status messages mean armor corruption
1060
1061 ;; return convention for mc-gpg-verify-parser:
1062 ;;  (same as sig section of decrypt parser)
1063 ;;   sigid : signed by an unknown key, need this key to verify
1064 ;;   '(t sigid sigtrust sigdate): good sig from sigid
1065 ;;   '(nil sigid sigtrust sigdate): forged sig "from" sigid
1066 ;; (actual return includes a leading nil because the verify-parser should
1067 ;;  never replace the region with stdout)
1068
1069 (defun mc-gpg-verify-parser (stdoutbuf stderrbuf statusbuf rc parserdata)
1070   (let (sigtype sigid sigdate sigtrust)
1071     ;; parse FOOSIG with the same code as decrypt-parser
1072     (set-buffer statusbuf)
1073
1074     (let ((sigstuff (mc-gpg-sigstatus-parser)))
1075       (setq sigtype (nth 0 sigstuff))
1076       (setq sigid (nth 1 sigstuff))
1077       (setq sigdate (nth 2 sigstuff))
1078       (setq sigtrust (nth 3 sigstuff))
1079       )
1080
1081     (mc-gpg-debug-print
1082      (format
1083       "decrypt-parser: sigtype=%s sigid=%s sigdate=%s sigtrust=%s"
1084       sigtype sigid sigdate sigtrust))
1085
1086     (if (and (not (= rc 0))
1087              (not sigtype))
1088         (error "The message was corrupt."))
1089
1090     (cond
1091      ((string= sigtype "ERR")
1092       (list nil sigid))
1093      ((string= sigtype "GOOD")
1094       (list nil (list t sigid sigtrust sigdate))) ;; good sig
1095      (t
1096       (list nil (list nil sigid sigtrust sigdate))))
1097     ))
1098
1099
1100 ; check a signature, print a message about its validity. Returns t if the
1101 ; sig was valid, nil otherwise
1102
1103 (defun mc-gpg-verify-region (start end &optional no-fetch)
1104   (let ((buffer (get-buffer-create mc-buffer-name))
1105         (obuf (current-buffer))
1106         args result)
1107     (setq args '("--batch" "--verify"))
1108     (if mc-gpg-alternate-keyring
1109         (setq args (append "--keyring" mc-gpg-alternate-keyring args)))
1110     (message "Verifying...")
1111     (setq result (mc-gpg-process-region
1112                   start end nil mc-gpg-path args 'mc-gpg-verify-parser buffer))
1113     (mc-gpg-debug-print (format "process-region returned %s" result))
1114     (setq result (car result))
1115
1116     (cond
1117
1118      ((atom result)
1119       ;; need key
1120       (if (and
1121            (not no-fetch)
1122            (not (eq mc-gpg-always-fetch 'never))
1123            (or mc-gpg-always-fetch
1124                (y-or-n-p
1125                 (format "Key %s not found; attempt to fetch? " result)))
1126            (mc-gpg-fetch-key (cons nil result))
1127            (set-buffer obuf))
1128           (mc-gpg-verify-region start end t)
1129         (error "Can't check signature: Public key %s not found" result)))
1130
1131      ((nth 0 result)
1132       ;; good sig
1133       (progn
1134         (message (mc-gpg-format-sigline
1135                   t (nth 1 result) (nth 2 result) (nth 3 result)))
1136         t))
1137
1138      (t
1139       ;; bad sig
1140       (progn
1141         (ding)
1142         (message (mc-gpg-format-sigline
1143                   nil (nth 1 result) (nth 2 result) (nth 3 result)))
1144         nil))
1145     )
1146 ))
1147
1148 (defun mc-gpg-insert-public-key (&optional id)
1149   (let ((buffer (get-buffer-create mc-buffer-name))
1150         args result)
1151     (setq id (or id mc-gpg-user-id))
1152     (setq args (list "--export" "--armor" "--batch" (concat "\"" id "\"")))
1153     (if mc-gpg-comment
1154         (setq args (append (list "--comment" (format "'%s'" mc-gpg-comment))
1155                            args)))
1156     (if mc-gpg-alternate-keyring
1157         (setq args (append (list "--keyring" mc-gpg-alternate-keyring) args)))
1158
1159     (setq result (mc-gpg-process-region (point) (point) nil mc-gpg-path
1160                                         args 'mc-gpg-insert-parser buffer))
1161     (if (car result)
1162         (message (format "Key for user ID: %s" id))
1163       (message "failed: %s" (nth 2 result)))
1164     (car result)
1165 ))
1166
1167 ;; GPG IMPORT BEHAVIOR: gnupg-0.9.9 only
1168
1169 ;; status:
1170 ;;  IMPORT_RES (12 fields)
1171 ;;   1 <count> : number of keys seen
1172 ;;   2 <no_user_id> : the number of keys without valid userids, including
1173 ;;                    keys that weren't self-signed
1174 ;;   3 <imported> : new public keys
1175 ;;   4 <imported_rsa> : new RSA public keys (included in <imported>)
1176 ;;   5 <unchanged> : old public keys
1177 ;;   6 <n_uids>
1178 ;;   7 <n_subk>
1179 ;;   8 <n_sigs>
1180 ;;   9 <n_revoc>
1181 ;;   10 <sec_read> : number of secret keys seen
1182 ;;   11 <sec_imported> : new secret keys
1183 ;;   12 <sec_dups> : old secret keys
1184
1185 ;;   the first three are for public keys, the last three are for secret keys.
1186 ;;   add them together, I guess. It's unlikely that anyone will be importing
1187 ;;   armored secret keys via email, but if they do it will be reported as if
1188 ;;   it were a public key.
1189
1190 ;; return convention:
1191 ;;  error with stderr if rc != 0
1192 ;;  '(count bad new old changed secretp)
1193
1194 (defun mc-gpg-snarf-parser (stdoutbuf stderrbuf statusbuf rc parserdata)
1195   (if (eq rc 0)
1196       (let (count bad new old changed secretp)
1197         (set-buffer statusbuf)
1198         (goto-char (point-min))
1199         (if (re-search-forward
1200              "^\\[GNUPG:\\] +IMPORT_RES +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\) +\\(\\S +\\)"
1201              nil t)
1202             (progn
1203               (setq count (string-to-number (match-string 1)))
1204               (setq bad (string-to-number (match-string 2)))
1205               (setq new (+ (string-to-number (match-string 3))
1206                            (string-to-number (match-string 11))))
1207               (setq old (+ (string-to-number (match-string 5))
1208                            (string-to-number (match-string 12))))
1209               (setq changed (- count bad new old))
1210               (setq secretp (not (string= (match-string 10) "0")))
1211               (list nil count bad new old changed secretp))
1212           (error "No key import status: your GnuPG is too old."))
1213         )
1214     (error (with-current-buffer stderrbuf (buffer-string))))
1215 )
1216
1217 (defun mc-gpg-snarf-keys (start end)
1218   ;; Returns number of keys found.
1219   (let ((buffer (get-buffer-create mc-buffer-name))
1220         results args msg)
1221     (setq args '("--import" "--batch"))
1222     (if mc-gpg-alternate-keyring
1223         (setq args (append args (list "--keyring" mc-gpg-alternate-keyring))))
1224     (message "Snarfing...")
1225     (setq results (mc-gpg-process-region start end nil mc-gpg-path args
1226                                          'mc-gpg-snarf-parser buffer))
1227     ;; don't have to update trustdb: gpg does it automatically (although it
1228     ;; might take a few seconds if a lot of keys or signatures have been
1229     ;; added).
1230
1231     ;; Is there any point to displaying this message? mc-snarf-keys will
1232     ;; display a simple "%d new keys found" message right after we return.
1233     ;; Well, print it anyway, if the user looks in the *Messages* buffer
1234     ;; they'll see more.
1235     (setq msg (format "%d keys seen" (nth 0 results)))
1236     (if (not (zerop (nth 1 results)))
1237         (setq msg (concat msg (format ", %d bad" (nth 1 results)))))
1238     (if (not (zerop (nth 2 results)))
1239         (setq msg (concat msg (format ", %d new" (nth 2 results)))))
1240     (if (not (zerop (nth 3 results)))
1241         (setq msg (concat msg (format ", %d old" (nth 3 results)))))
1242     (if (not (zerop (nth 4 results)))
1243         (setq msg (concat msg (format ", %d changed" (nth 4 results)))))
1244     (if (nth 5 results)
1245         (setq msg (concat msg ", SECRET KEYS IMPORTED")))
1246
1247     (message msg)
1248     (nth 2 results)
1249     ))
1250
1251 (defun mc-scheme-gpg ()
1252   (list
1253    (cons 'encryption-func               'mc-gpg-encrypt-region)
1254    (cons 'decryption-func               'mc-gpg-decrypt-region)
1255    (cons 'signing-func                  'mc-gpg-sign-region)
1256    (cons 'verification-func             'mc-gpg-verify-region)
1257    (cons 'key-insertion-func            'mc-gpg-insert-public-key)
1258    (cons 'snarf-func                    'mc-gpg-snarf-keys)
1259    (cons 'msg-begin-line                mc-gpg-msg-begin-line)
1260    (cons 'msg-end-line                  mc-gpg-msg-end-line)
1261    (cons 'signed-begin-line             mc-gpg-signed-begin-line)
1262    (cons 'signed-end-line               mc-gpg-signed-end-line)
1263    (cons 'key-begin-line                mc-gpg-key-begin-line)
1264    (cons 'key-end-line                  mc-gpg-key-end-line)
1265    (cons 'user-id                       mc-gpg-user-id)))
1266
1267 ;;{{{ Key fetching
1268
1269 (defvar mc-gpg-always-fetch 'never
1270   "*If t, always attempt to fetch missing keys, or never fetch if
1271 'never.")
1272
1273 (defun mc-gpg-fetch-key (&optional id)
1274   "Attempt to fetch a key for addition to GPG keyring.  Interactively,
1275 prompt for string matching key to fetch.
1276
1277 This function is not yet implemented. The GPG documentation suggests a simple
1278 keyserver protocol, but as far as I know it has not yet been implemented
1279 anywhere."
1280
1281   (error "Key fetching not yet implemented"))
1282
1283 ;;}}}