;ELC ;;; compiled by amu@mit.edu on Wed Dec 30 12:35:46 1998 ;;; from file /afs/sipb.mit.edu/contrib/emacs/packages/mailcrypt-3.5.1/mc-gpg.el ;;; emacs version 19.34.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mc-gpg.el' was compiled for Emacs 19.29 or later")) (require (quote mailcrypt)) #@35 *GPG ID of your default identity. (defvar mc-gpg-user-id (user-login-name) (#$ . -517)) #@22 *The GPG executable. (defvar mc-gpg-path "gpg" (#$ . -611)) #@57 *If t, pop up the GPG output window when snarfing keys. (defvar mc-gpg-display-snarf-output nil (#$ . -677)) #@44 *Public keyring to use instead of default. (defvar mc-gpg-alternate-keyring nil (#$ . -792)) #@84 *Comment field to appear in ASCII armor output. If nil, let GPG use its default. (defvar mc-gpg-comment nil (#$ . -891)) #@42 Text for start of GPG message delimiter. (defconst mc-gpg-msg-begin-line "-----BEGIN PGP MESSAGE-----" (#$ . 1020)) #@40 Text for end of GPG message delimiter. (defconst mc-gpg-msg-end-line "-----END PGP MESSAGE-----\n?" (#$ . 1142)) #@40 Text for start of GPG signed messages. (defconst mc-gpg-signed-begin-line "-----BEGIN PGP SIGNED MESSAGE-----" (#$ . 1261)) #@38 Text for end of GPG signed messages. (defconst mc-gpg-signed-end-line "-----END PGP SIGNATURE-----\n?" (#$ . 1391)) #@35 Text for start of GPG public key. (defconst mc-gpg-key-begin-line "^-----BEGIN PGP PUBLIC KEY BLOCK----- ?$" (#$ . 1513)) #@33 Text for end of GPG public key. (defconst mc-gpg-key-end-line "^-----END PGP PUBLIC KEY BLOCK----- ?$" (#$ . 1641)) #@47 Regular expression matching an error from GPG (defconst mc-gpg-error-re "^\\(ERROR:\\|WARNING:\\).*" (#$ . 1763)) #@64 Regular expression matching a GPG signature validation message (defconst mc-gpg-sigok-re "^gpg: Good signature.*" (#$ . 1883)) #@53 Regular expression matching a GPG key snarf message (defconst mc-gpg-newkey-re "^[^:]+:[^:]+: \\(key [0-9A-F]+\\): \\(.*\\)$" (#$ . 2016)) #@56 Regular expression matching a GPG missing-key messsage (defconst mc-gpg-nokey-re "Cannot find the public key matching userid '\\(.+\\)'$" (#$ . 2161)) (byte-code "\nB" ["gpg: Signature made .+ using .+ key ID \\(\\S +\\)\ngpg: Can't check signature: Public key not found" mc-gpg-key-expected-re current-load-list] 2) #@160 Extra arguments to pass to all invocations of gpg. Used during debugging to set --homedir, to use special test keys instead of the developer's normal keyring. (defconst mc-gpg-extra-args nil (#$ . 2491)) #@76 A buffer for debugging messages. If nil, no debugging messages are logged. (defconst mc-gpg-debug-buffer nil (#$ . 2701)) (defalias 'mc-gpg-debug-print #[(string) "!  \"" [boundp mc-gpg-debug-buffer print string] 3]) (defalias 'mc-gpg-insert-parser #[(stdoutbuf stderrbuf statusbuf rc) " \f $! ULJ\f \"!" [mc-gpg-debug-print format "(mc-gpg-generic-parser stdoutbuf=%s stderrbuf=%s rc=%s" stdoutbuf stderrbuf rc 0 (t t) error with-current-buffer buffer-string] 6]) (defalias 'mc-gpg-null-parser #[(stdoutbuf stderrbuf statusbuf rc) " D" [t rc] 2]) (defalias 'mc-gpg-process-region #[(beg end passwd program args parser bufferdummy) "p \n \f &!\"! \"!ݎ!\nq  q\n!i\" PC\"PC\"\"''\"##!\n% P\"1! # ! != \" ! !\f\"! !\nqdb#|eb@A#B!  C=. D=9EF\f#ށG!!q H !ށI!!q H!\nq\n\f$ρJ\n\"!\n@ q|bK\n!\nA. " [nil "/bin/sh" parser-result status rc proc status-buf status-tempfilename stderr-buf stderr-tempfilename mybuf shell-file-name process-connection-type obuf mc-gpg-debug-print format "(mc-gpg-process-region beg=%s end=%s passwd=%s program=%s args=%s parser=%s bufferdummy=%s)" beg end passwd program args parser bufferdummy make-temp-name expand-file-name "mailcrypt-gpg-stderr-" mc-temp-directory "mailcrypt-gpg-status-" ((byte-code "!=!\fq!!" [proc process-status run interrupt-process obuf delete-file stderr-tempfilename status-tempfilename] 2)) get-buffer-create " *mailcrypt stdout temp" erase-buffer buffer-disable-undo append ("--passphrase-fd" "0") "2>" "3>" ("--status-fd" "3") mc-gpg-extra-args "prog is %s, args are %s" mapconcat #[(x) "\n\"" [format "'%s'" x] 3] " " apply start-process-shell-command "*GPG*" process-send-string "\n" mc-passwd-timeout mc-deactivate-passwd t process-send-region process-send-eof process-status run accept-process-output 5 process-exit-status "prog finished, rc=%s" delete-process re-search-backward "\nProcess \\*GPG.*\n\\'" 0 search-forward " \n" replace-match stop signal error "%s exited abnormally: '%s'" " *mailcrypt stderr temp" insert-file-contents " *mailcrypt status temp" " parser returned %s" insert-buffer-substring] 13]) #@143 Association list mapping GPG IDs to canonical "keys". A "key" is a pair (USER-ID . KEY-ID) which identifies the canonical IDs of the GPG ID. (defvar mc-gpg-key-cache nil (#$ . 5119)) (defalias 'mc-gpg-lookup-key #[(str &optional type) "\nÚ?\n \"p \nˎ!\n9D \"D \" \"! &qeb #ߔߕ\"\"PB\n\n\nB B)\n\n\"\n,)" [nil args str "***** CONVENTIONAL *****" assoc mc-gpg-key-cache "^sec:[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*:[^:]*:[^:]*:[^:]*:\\([^:]*\\):$" buffer obuf key-regexp result ((set-buffer obuf)) generate-new-buffer " *mailcrypt temp" "--with-colons" "--no-greeting" "--batch" "--list-secret-keys" mc-gpg-alternate-keyring append "--keyring" mc-gpg-extra-args mc-gpg-debug-print format "lookup: args are %s" apply call-process mc-gpg-path re-search-forward t buffer-substring-no-properties 2 "0x" 1 error "No GPG secret key for %s"] 8]) (defalias 'mc-gpg-encrypt-region #[(recipients start end &optional id sign) "\n!pÉ \n \f&!;ق<گIۂJ\n\n\" e\"D\"\"t\"D\"$=$!)\"A@A#\"@QE\"\n@# !2)\"@B\"\"\" \"9\f& \".\n" [process-environment get-buffer-create mc-buffer-name nil gpg-id result passwd key args msg action obuf buffer mc-gpg-debug-print format "(mc-gpg-encrypt-region recipients=%s start=%s end=%s id=%s sign=%s)" recipients start end id sign "--batch" "--armor" "--textmode" "--always-trust" "--encrypt" "--store" "Encrypting" "Armoring" "%s..." mc-gpg-comment append "--comment" "'%s'" mc-gpg-alternate-keyring "--keyring" mc-pgp-always-sign never y-or-n-p "Sign the message? " mc-gpg-lookup-key mc-gpg-user-id encrypt mc-activate-passwd "GPG passphrase for %s (%s): " "--local-user" "\"" "--sign" "%s+signing as %s ..." cddr mc-encrypt-for-me apply mapcar #[(x) "\nQD" ["--remote-user" "\"" x] 4] message "%s" mc-gpg-process-region mc-gpg-path mc-gpg-insert-parser "%s Done." t] 10]) (defalias 'mc-gpg-decrypt-parser #[(stdoutbuf stderrbuf statusbuf rc) "qeb##!Peb#2!eb#A!qeb#XF@eb#g!eb Ӛ#!P#!eb#F@F@#F@#F@   Ӛ F@ ۚʉ \nFF@ \nFF@F@ ʉF@ Ӛ%ʉ F@ ۚ7ʉ \nFF@ʉ \nFF." [nil sigtrust sigdate sigid symmetric sigtype keyid statusbuf re-search-forward "NEED_PASSPHRASE \\(\\S +\\)$" t "0x" match-string 1 "\\(\\S +SIG\\)" "\\(TRUST_\\S +\\)$" stderrbuf "^gpg: public key decryption failed: Secret key not available$" "^gpg: Signature made \\(.*\\) using" "ERRSIG" "^gpg: Signature made .* key ID \\(.*\\)$" "^gpg: \\S + signature from \"\\(.*\\)\"$" "^gpg: fatal: Can't query password in batchmode$" "***** CONVENTIONAL *****" "^gpg: public key decryption failed: Bad passphrase$" "^gpg: decryption failed: Bad key$" signed "GOODSIG"] 7]) (defalias 'mc-gpg-decrypt-region #[(start end &optional id) "\n!pÉ \n $! Q\"J@@A#\"O\" c D\"  \" !   &@!3 A@!!3 A@嚄 A@#3 8. 8):)\"!+=+)\"!)B! !#**)@)A@)8)8$!*)A@)8)8$!)3!. " [process-environment get-buffer-create mc-buffer-name nil gpg-id result passwd new-key key args obuf buffer mc-gpg-debug-print format "(mc-gpg-decrypt-region start=%s end=%s id=%s)" start end id undo-boundary mc-gpg-lookup-key encrypt mc-activate-passwd "GPG passphrase for %s (%s): " "GPG passphrase for conventional decryption: " ("--batch") mc-gpg-alternate-keyring append "--keyring" ("--decrypt") message "Decrypting..." mc-gpg-process-region mc-gpg-path mc-gpg-decrypt-parser error "This message is not addressed to you" mc-deactivate-passwd t "That passphrase was wrong" mc-gpg-decrypt-region 2 sig "cannot check signature from keyid %s" mc-gpg-always-fetch never y-or-n-p "Key %s not found; attempt to fetch? " mc-gpg-fetch-key undo-start undo-more 1 (t) "Good signature from '%s' %s made %s" 3 (t . t) "BAD SIGNATURE from '%s' %s made %s" (t) "Decrypting... Done." (t)] 10]) (defalias 'mc-gpg-sign-region #[(start end &optional id unclear) "\n!É \n\"\f@\f@\fA#\"\fAQ7Ԃ8կK\"D \"V \"\f@\" &u\f@\"-" [process-environment get-buffer-create mc-buffer-name nil key args passwd buffer mc-gpg-lookup-key id mc-gpg-user-id sign mc-activate-passwd format "GPG passphrase for %s (%s): " "--batch" "--armor" "--local-user" "\"" unclear "--sign" "--clearsign" mc-gpg-comment append "--comment" "'%s'" mc-gpg-extra-args message "Signing as %s ..." mc-gpg-process-region start end mc-gpg-path mc-gpg-insert-parser "Signing as %s ... Done." t] 8]) (defalias 'mc-gpg-verify-parser #[(stdoutbuf stderrbuf statusbuf rc) "\nqeb# !C\" #)\nqeb#N qeb#N qeb#!\"!U qeb#{!QEUEE \"!*" [nil msg statusbuf re-search-forward "^\\[GNUPG:\\]\\s +\\(\\S +\\)" t append match-string 1 mapconcat identity " " "^\\[GNUPG:\\]\\s +ERRSIG$" stderrbuf "gpg: Can't check signature: Public key not found$" "key ID \\(\\S +\\)$" needkey status mc-gpg-debug-print format " status is %s" rc 0 good "^gpg: Good signature \\(from.*\\)$" bad error with-current-buffer buffer-string] 6]) (defalias 'mc-gpg-verify-region #[(start end &optional no-fetch) " !p‰  #! & \"! @=E A@! @=T A@! @= A@P=\f\"!\fB!q# A@\" A@!-" [get-buffer-create mc-buffer-name nil result gpg-id args obuf buffer ("--batch" "--verify") mc-gpg-alternate-keyring append "--keyring" message "Verifying..." mc-gpg-process-region start end mc-gpg-path mc-gpg-verify-parser mc-gpg-debug-print format "process-region returned %s" good bad error needkey no-fetch "0x" mc-gpg-always-fetch never y-or-n-p "Key %s not found; attempt to fetch? " mc-gpg-fetch-key mc-gpg-verify-region t "Can't check signature: Public key 0x%s not found"] 8]) (defalias 'mc-gpg-insert-public-key #[(&optional id) " ! \f F\n#\n\"D \"0D \"`` \f&F \"!*" [get-buffer-create mc-buffer-name nil args buffer id mc-gpg-user-id "--export" "--armor" "--batch" mc-gpg-comment append "--comment" format "'%s'" mc-gpg-alternate-keyring "--keyring" mc-gpg-process-region mc-gpg-path mc-gpg-insert-parser message "Key for user ID: %s" t] 8]) (defalias 'mc-gpg-snarf-parser #[(stdoutbuf stderrbuf statusbuf rc) "=Oqeb #G̔̕\"͚5T ΚA T\fT \fF- \"!" [rc 0 nil tmpstr weirdos oldkeys newkeys stderrbuf re-search-forward mc-gpg-newkey-re t buffer-substring-no-properties 2 "public key imported" "not changed" error with-current-buffer buffer-string] 5]) (defalias 'mc-gpg-snarf-keys #[(start end) " !‰ D\"!  &\f@\fA@\f8$!\f@+" [get-buffer-create mc-buffer-name nil args results buffer ("--import" "--batch") mc-gpg-alternate-keyring append "--keyring" message "Snarfing..." mc-gpg-process-region start end mc-gpg-path mc-gpg-snarf-parser format "%d new keys, %d old, %d weird" 2] 8]) (defalias 'mc-scheme-gpg #[nil "BBBBBB BBBBBBB " [encryption-func mc-gpg-encrypt-region decryption-func mc-gpg-decrypt-region signing-func mc-gpg-sign-region verification-func mc-gpg-verify-region key-insertion-func mc-gpg-insert-public-key snarf-func mc-gpg-snarf-keys msg-begin-line mc-gpg-msg-begin-line msg-end-line mc-gpg-msg-end-line signed-begin-line mc-gpg-signed-begin-line signed-end-line mc-gpg-signed-end-line key-begin-line mc-gpg-key-begin-line key-end-line mc-gpg-key-end-line user-id mc-gpg-user-id] 14]) #@72 *If t, always attempt to fetch missing keys, or never fetch if 'never. (defvar mc-gpg-always-fetch (quote never) (#$ . -13146)) #@272 Attempt to fetch a key for addition to GPG keyring. Interactively, prompt for string matching key to fetch. This function is not yet implemented. The GPG documentation suggests a simple keyserver protocol, but as far as I know it has not yet been implemented anywhere. (defalias 'mc-gpg-fetch-key #[(&optional id) "!" [error "Key fetching not yet implemented"] 2 (#$ . 13281)])