rpms/emacs-vm/FC-6 makefile-add-extra-lisp.patch, NONE, 1.1 pgg-def.el, NONE, 1.1 pgg-gpg.el, NONE, 1.1 pgg-parse.el, NONE, 1.1 pgg-pgp.el, NONE, 1.1 pgg-pgp5.el, NONE, 1.1 pgg.el, NONE, 1.1 u-vm-color.el, NONE, 1.1 .cvsignore, 1.6, 1.7 emacs-vm.spec, 1.6, 1.7 sources, 1.6, 1.7
Jonathan G. Underwood (jgu)
fedora-extras-commits at redhat.com
Thu Jun 21 22:01:32 UTC 2007
- Previous message (by thread): rpms/puppet/FC-5 .cvsignore, 1.14, 1.15 puppet.spec, 1.15, 1.16 sources, 1.14, 1.15
- Next message (by thread): rpms/puppet/EL-4 .cvsignore, 1.12, 1.13 puppet.spec, 1.13, 1.14 sources, 1.12, 1.13
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Author: jgu
Update of /cvs/extras/rpms/emacs-vm/FC-6
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv27561
Modified Files:
.cvsignore emacs-vm.spec sources
Added Files:
makefile-add-extra-lisp.patch pgg-def.el pgg-gpg.el
pgg-parse.el pgg-pgp.el pgg-pgp5.el pgg.el u-vm-color.el
Log Message:
- Update to version 8.0.0 devo 453 which removes the need for thr vmrf patch
- No longer need to bundle vcard stuff as that is included upstream
- Spec file cleanups
- No longer use separate pixmaps
- Updated pgg*.el from Emacs CVS 21st June 2007
- Add pgg*.el and u-vm-color.el to CVS rather than as source files
makefile-add-extra-lisp.patch:
--- NEW FILE makefile-add-extra-lisp.patch ---
--- lisp/Makefile.in.original 2007-06-20 00:16:37.000000000 +0100
+++ lisp/Makefile.in 2007-06-20 00:18:43.000000000 +0100
@@ -57,6 +57,14 @@
SOURCES += vcard.el
SOURCES += tapestry.el
+SOURCES += u-vm-color.el
+SOURCES += pgg.el
+SOURCES += pgg-def.el
+SOURCES += pgg-gpg.el
+SOURCES += pgg-parse.el
+SOURCES += pgg-pgp.el
+SOURCES += pgg-pgp5.el
+
# to list of object files
ifeq (@EMACS_FLAVOR@,emacs)
OBJECTS = vm-autoloads.elc
--- NEW FILE pgg-def.el ---
;;; pgg-def.el --- functions/macros for defining PGG functions
;; Copyright (C) 1999, 2002, 2003, 2004, 2005,
;; 2006, 2007 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno at unixuser.org>
;; Created: 1999/11/02
;; Keywords: PGP, OpenPGP, GnuPG
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(defgroup pgg ()
"Glue for the various PGP implementations."
:group 'mime
:version "22.1")
(defcustom pgg-default-scheme 'gpg
"Default PGP scheme."
:group 'pgg
:type '(choice (const :tag "GnuPG" gpg)
(const :tag "PGP 5" pgp5)
(const :tag "PGP" pgp)))
(defcustom pgg-default-user-id (user-login-name)
"User ID of your default identity."
:group 'pgg
:type 'string)
(defcustom pgg-default-keyserver-address "subkeys.pgp.net"
"Host name of keyserver."
:group 'pgg
:type 'string)
(defcustom pgg-query-keyserver nil
"Whether PGG queries keyservers for missing keys when verifying messages."
:version "22.1"
:group 'pgg
:type 'boolean)
(defcustom pgg-encrypt-for-me t
"If t, encrypt all outgoing messages with user's public key."
:group 'pgg
:type 'boolean)
(defcustom pgg-cache-passphrase t
"If t, cache passphrase."
:group 'pgg
:type 'boolean)
(defcustom pgg-passphrase-cache-expiry 16
"How many seconds the passphrase is cached.
Whether the passphrase is cached at all is controlled by
`pgg-cache-passphrase'."
:group 'pgg
:type 'integer)
(defcustom pgg-passphrase-coding-system nil
"Coding system to encode passphrase."
:group 'pgg
:type 'coding-system)
(defvar pgg-messages-coding-system nil
"Coding system used when reading from a PGP external process.")
(defvar pgg-status-buffer " *PGG status*")
(defvar pgg-errors-buffer " *PGG errors*")
(defvar pgg-output-buffer " *PGG output*")
(defvar pgg-echo-buffer "*PGG-echo*")
(defvar pgg-scheme nil
"Current scheme of PGP implementation.")
(defvar pgg-text-mode nil
"If t, inform the recipient that the input is text.")
(defmacro pgg-truncate-key-identifier (key)
`(if (> (length ,key) 8) (substring ,key -8) ,key))
(provide 'pgg-def)
;;; arch-tag: c425f3ab-ed75-4055-bb46-431a418c94b7
;;; pgg-def.el ends here
--- NEW FILE pgg-gpg.el ---
;;; pgg-gpg.el --- GnuPG support for PGG.
;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno at unixuser.org>
;; Symmetric encryption and gpg-agent support added by:
;; Sascha Wilde <wilde at sha-bang.de>
;; Created: 1999/10/28
;; Keywords: PGP, OpenPGP, GnuPG
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(eval-when-compile
(require 'cl) ; for gpg macros
(require 'pgg))
(defgroup pgg-gpg ()
"GnuPG interface."
:group 'pgg)
(defcustom pgg-gpg-program "gpg"
"The GnuPG executable."
:group 'pgg-gpg
:type 'string)
(defcustom pgg-gpg-extra-args nil
"Extra arguments for every GnuPG invocation."
:group 'pgg-gpg
:type '(repeat (string :tag "Argument")))
(defcustom pgg-gpg-recipient-argument "--recipient"
"GnuPG option to specify recipient."
:group 'pgg-gpg
:type '(choice (const :tag "New `--recipient' option" "--recipient")
(const :tag "Old `--remote-user' option" "--remote-user")))
(defcustom pgg-gpg-use-agent t
"Whether to use gnupg agent for key caching."
:group 'pgg-gpg
:type 'boolean)
(defvar pgg-gpg-user-id nil
"GnuPG ID of your default identity.")
(defun pgg-gpg-process-region (start end passphrase program args)
(let* ((use-agent (and (null passphrase) (pgg-gpg-use-agent-p)))
(output-file-name (pgg-make-temp-file "pgg-output"))
(args
`("--status-fd" "2"
,@(if use-agent '("--use-agent")
(if passphrase '("--passphrase-fd" "0")))
"--yes" ; overwrite
"--output" ,output-file-name
, at pgg-gpg-extra-args , at args))
(output-buffer pgg-output-buffer)
(errors-buffer pgg-errors-buffer)
(orig-mode (default-file-modes))
(process-connection-type nil)
(inhibit-redisplay t)
process status exit-status
passphrase-with-newline
encoded-passphrase-with-new-line)
(with-current-buffer (get-buffer-create errors-buffer)
(buffer-disable-undo)
(erase-buffer))
(unwind-protect
(progn
(set-default-file-modes 448)
(let ((coding-system-for-write 'binary))
(setq process
(apply #'start-process "*GnuPG*" errors-buffer
program args)))
(set-process-sentinel process #'ignore)
(when passphrase
(setq passphrase-with-newline (concat passphrase "\n"))
(if pgg-passphrase-coding-system
(progn
(setq encoded-passphrase-with-new-line
(encode-coding-string
passphrase-with-newline
(coding-system-change-eol-conversion
pgg-passphrase-coding-system 'unix)))
(pgg-clear-string passphrase-with-newline))
(setq encoded-passphrase-with-new-line passphrase-with-newline
passphrase-with-newline nil))
(process-send-string process encoded-passphrase-with-new-line))
(process-send-region process start end)
(process-send-eof process)
(while (eq 'run (process-status process))
(accept-process-output process 5))
(setq status (process-status process)
exit-status (process-exit-status process))
(delete-process process)
(with-current-buffer (get-buffer-create output-buffer)
(buffer-disable-undo)
(erase-buffer)
(if (file-exists-p output-file-name)
(let ((coding-system-for-read (if pgg-text-mode
'raw-text
'binary)))
(insert-file-contents output-file-name)))
(set-buffer errors-buffer)
(if (memq status '(stop signal))
(error "%s exited abnormally: '%s'" program exit-status))
(if (= 127 exit-status)
(error "%s could not be found" program))))
(if passphrase-with-newline
(pgg-clear-string passphrase-with-newline))
(if encoded-passphrase-with-new-line
(pgg-clear-string encoded-passphrase-with-new-line))
(if (and process (eq 'run (process-status process)))
(interrupt-process process))
(if (file-exists-p output-file-name)
(delete-file output-file-name))
(set-default-file-modes orig-mode))))
(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key notruncate)
(if (and passphrase
pgg-cache-passphrase
(progn
(goto-char (point-min))
(re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t)))
(pgg-add-passphrase-to-cache
(or key
(progn
(goto-char (point-min))
(if (re-search-forward
"^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t)
(substring (match-string 0) -8))))
passphrase
notruncate)))
(defvar pgg-gpg-all-secret-keys 'unknown)
(defun pgg-gpg-lookup-all-secret-keys ()
"Return all secret keys present in secret key ring."
(when (eq pgg-gpg-all-secret-keys 'unknown)
(setq pgg-gpg-all-secret-keys '())
(let ((args (list "--with-colons" "--no-greeting" "--batch"
"--list-secret-keys")))
(with-temp-buffer
(apply #'call-process pgg-gpg-program nil t nil args)
(goto-char (point-min))
(while (re-search-forward
"^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)" nil t)
(push (substring (match-string 2) 8)
pgg-gpg-all-secret-keys)))))
pgg-gpg-all-secret-keys)
(defun pgg-gpg-lookup-key (string &optional type)
"Search keys associated with STRING."
(let ((args (list "--with-colons" "--no-greeting" "--batch"
(if type "--list-secret-keys" "--list-keys")
string)))
(with-temp-buffer
(apply #'call-process pgg-gpg-program nil t nil args)
(goto-char (point-min))
(if (re-search-forward "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)"
nil t)
(substring (match-string 2) 8)))))
(defun pgg-gpg-lookup-key-owner (string &optional all)
"Search keys associated with STRING and return owner of identified key.
The value may be just the bare key id, or it may be a combination of the
user name associated with the key and the key id, with the key id enclosed
in \"<...>\" angle brackets.
Optional ALL non-nil means search all keys, including secret keys."
(let ((args (list "--with-colons" "--no-greeting" "--batch"
(if all "--list-secret-keys" "--list-keys")
string))
(key-regexp (concat "^\\(sec\\|pub\\)"
":[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*"
":[^:]*:[^:]*:[^:]*:\\([^:]*\\):")))
(with-temp-buffer
(apply #'call-process pgg-gpg-program nil t nil args)
(goto-char (point-min))
(if (re-search-forward key-regexp
nil t)
(match-string 3)))))
(defun pgg-gpg-key-id-from-key-owner (key-owner)
(cond ((not key-owner) nil)
;; Extract bare key id from outermost paired angle brackets, if any:
((string-match "[^<]*<\\(.+\\)>[^>]*" key-owner)
(substring key-owner (match-beginning 1)(match-end 1)))
(key-owner)))
(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase)
"Encrypt the current region between START and END.
If optional argument SIGN is non-nil, do a combined sign and encrypt.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
(passphrase (or passphrase
(when (and sign (not (pgg-gpg-use-agent-p)))
(pgg-read-passphrase
(format "GnuPG passphrase for %s: "
pgg-gpg-user-id)
pgg-gpg-user-id))))
(args
(append
(list "--batch" "--armor" "--always-trust" "--encrypt")
(if pgg-text-mode (list "--textmode"))
(if sign (list "--sign" "--local-user" pgg-gpg-user-id))
(if (or recipients pgg-encrypt-for-me)
(apply #'nconc
(mapcar (lambda (rcpt)
(list pgg-gpg-recipient-argument rcpt))
(append recipients
(if pgg-encrypt-for-me
(list pgg-gpg-user-id)))))))))
(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
(when sign
(with-current-buffer pgg-errors-buffer
;; Possibly cache passphrase under, e.g. "jas", for future sign.
(pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
(pgg-gpg-possibly-cache-passphrase passphrase)))
(pgg-process-when-success)))
(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
"Encrypt the current region between START and END with symmetric cipher.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(let* ((passphrase (or passphrase
(when (not (pgg-gpg-use-agent-p))
(pgg-read-passphrase
"GnuPG passphrase for symmetric encryption: "))))
(args
(append (list "--batch" "--armor" "--symmetric" )
(if pgg-text-mode (list "--textmode")))))
(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
(pgg-process-when-success)))
(defun pgg-gpg-decrypt-region (start end &optional passphrase)
"Decrypt the current region between START and END.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(let* ((current-buffer (current-buffer))
(message-keys (with-temp-buffer
(insert-buffer-substring current-buffer)
(pgg-decode-armor-region (point-min) (point-max))))
(secret-keys (pgg-gpg-lookup-all-secret-keys))
;; XXX the user is stuck if they need to use the passphrase for
;; any but the first secret key for which the message is
;; encrypted. ideally, we would incrementally give them a
;; chance with subsequent keys each time they fail with one.
(key (pgg-gpg-select-matching-key message-keys secret-keys))
(key-owner (and key (pgg-gpg-lookup-key-owner key t)))
(key-id (pgg-gpg-key-id-from-key-owner key-owner))
(pgg-gpg-user-id (or key-id key
pgg-gpg-user-id pgg-default-user-id))
(passphrase (or passphrase
(when (not (pgg-gpg-use-agent-p))
(pgg-read-passphrase
(format (if (pgg-gpg-symmetric-key-p message-keys)
"Passphrase for symmetric decryption: "
"GnuPG passphrase for %s: ")
(or key-owner "??"))
pgg-gpg-user-id))))
(args '("--batch" "--decrypt")))
(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
(with-current-buffer pgg-errors-buffer
(pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
(goto-char (point-min))
(re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
;;;###autoload
(defun pgg-gpg-symmetric-key-p (message-keys)
"True if decoded armor MESSAGE-KEYS has symmetric encryption indicator."
(let (result)
(dolist (key message-keys result)
(when (and (eq (car key) 3)
(member '(symmetric-key-algorithm) key))
(setq result key)))))
(defun pgg-gpg-select-matching-key (message-keys secret-keys)
"Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."
(loop for message-key in message-keys
for message-key-id = (and (equal (car message-key) 1)
(cdr (assq 'key-identifier
(cdr message-key))))
for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))
when (and key (member key secret-keys)) return key))
(defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
"Make detached signature from text between START and END."
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
(passphrase (or passphrase
(when (not (pgg-gpg-use-agent-p))
(pgg-read-passphrase
(format "GnuPG passphrase for %s: "
pgg-gpg-user-id)
pgg-gpg-user-id))))
(args
(append (list (if cleartext "--clearsign" "--detach-sign")
"--armor" "--batch" "--verbose"
"--local-user" pgg-gpg-user-id)
(if pgg-text-mode (list "--textmode"))))
(inhibit-read-only t)
buffer-read-only)
(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
(with-current-buffer pgg-errors-buffer
;; Possibly cache passphrase under, e.g. "jas", for future sign.
(pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
(pgg-gpg-possibly-cache-passphrase passphrase))
(pgg-process-when-success)))
(defun pgg-gpg-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
(let ((args '("--batch" "--verify")))
(when (stringp signature)
(setq args (append args (list signature))))
(setq args (append args '("-")))
(pgg-gpg-process-region start end nil pgg-gpg-program args)
(with-current-buffer pgg-errors-buffer
(goto-char (point-min))
(while (re-search-forward "^gpg: \\(.*\\)\n" nil t)
(with-current-buffer pgg-output-buffer
(insert-buffer-substring pgg-errors-buffer
(match-beginning 1) (match-end 0)))
(delete-region (match-beginning 0) (match-end 0)))
(goto-char (point-min))
(re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t))))
(defun pgg-gpg-insert-key ()
"Insert public key at point."
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
(args (list "--batch" "--export" "--armor"
pgg-gpg-user-id)))
(pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
(insert-buffer-substring pgg-output-buffer)))
(defun pgg-gpg-snarf-keys-region (start end)
"Add all public keys in region between START and END to the keyring."
(let ((args '("--import" "--batch" "-")) status)
(pgg-gpg-process-region start end nil pgg-gpg-program args)
(set-buffer pgg-errors-buffer)
(goto-char (point-min))
(when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t)
(setq status (buffer-substring (match-end 0)
(progn (end-of-line)(point)))
status (vconcat (mapcar #'string-to-number (split-string status))))
(erase-buffer)
(insert (format "Imported %d key(s).
\tArmor contains %d key(s) [%d bad, %d old].\n"
(+ (aref status 2)
(aref status 10))
(aref status 0)
(aref status 1)
(+ (aref status 4)
(aref status 11)))
(if (zerop (aref status 9))
""
"\tSecret keys are imported.\n")))
(append-to-buffer pgg-output-buffer (point-min)(point-max))
(pgg-process-when-success)))
(defun pgg-gpg-update-agent ()
"Try to connet to gpg-agent and send UPDATESTARTUPTTY."
(if (fboundp 'make-network-process)
(let* ((agent-info (getenv "GPG_AGENT_INFO"))
(socket (and agent-info
(string-match "^\\([^:]*\\)" agent-info)
(match-string 1 agent-info)))
(conn (and socket
(make-network-process :name "gpg-agent-process"
:host 'local :family 'local
:service socket))))
(when (and conn (eq (process-status conn) 'open))
(process-send-string conn "UPDATESTARTUPTTY\n")
(delete-process conn)
t))
;; We can't check, so assume gpg-agent is up.
t))
(defun pgg-gpg-use-agent-p ()
"Return t if `pgg-gpg-use-agent' is t and gpg-agent is available."
(and pgg-gpg-use-agent (pgg-gpg-update-agent)))
(provide 'pgg-gpg)
;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
;;; pgg-gpg.el ends here
--- NEW FILE pgg-parse.el ---
;;; pgg-parse.el --- OpenPGP packet parsing
;; Copyright (C) 1999, 2002, 2003, 2004, 2005,
;; 2006, 2007 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno at unixuser.org>
;; Created: 1999/10/28
;; Keywords: PGP, OpenPGP, GnuPG
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This module is based on
;; [OpenPGP] RFC 2440: "OpenPGP Message Format"
;; by John W. Noerenberg, II <jwn2 at qualcomm.com>,
;; Jon Callas <jon at pgp.com>, Lutz Donnerhacke <lutz at iks-jena.de>,
;; Hal Finney <hal at pgp.com> and Rodney Thayer <rodney at unitran.com>
;; (1998/11)
;;; Code:
(eval-when-compile (require 'cl))
(defgroup pgg-parse ()
"OpenPGP packet parsing."
:group 'pgg)
(defcustom pgg-parse-public-key-algorithm-alist
'((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
"Alist of the assigned number to the public key algorithm."
:group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-symmetric-key-algorithm-alist
'((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
"Alist of the assigned number to the simmetric key algorithm."
:group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-hash-algorithm-alist
'((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2) (8 . SHA256) (9 . SHA384)
(10 . SHA512))
"Alist of the assigned number to the cryptographic hash algorithm."
:group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-compression-algorithm-alist
'((0 . nil); Uncompressed
(1 . ZIP)
(2 . ZLIB))
"Alist of the assigned number to the compression algorithm."
:group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-signature-type-alist
'((0 . "Signature of a binary document")
(1 . "Signature of a canonical text document")
(2 . "Standalone signature")
(16 . "Generic certification of a User ID and Public Key packet")
(17 . "Persona certification of a User ID and Public Key packet")
(18 . "Casual certification of a User ID and Public Key packet")
(19 . "Positive certification of a User ID and Public Key packet")
(24 . "Subkey Binding Signature")
(31 . "Signature directly on a key")
(32 . "Key revocation signature")
(40 . "Subkey revocation signature")
(48 . "Certification revocation signature")
(64 . "Timestamp signature."))
"Alist of the assigned number to the signature type."
:group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-ignore-packet-checksum t; XXX
"If non-nil checksum of each ascii armored packet will be ignored."
:group 'pgg-parse
:type 'boolean)
(defvar pgg-armor-header-lines
'("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
"^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
"^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
"^-----BEGIN PGP SIGNATURE-----\r?$")
"Armor headers.")
(eval-and-compile
(defalias 'pgg-char-int (if (fboundp 'char-int)
'char-int
'identity)))
(defmacro pgg-format-key-identifier (string)
`(mapconcat (lambda (c) (format "%02X" (pgg-char-int c)))
,string "")
;; `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
;; (string-to-number-list ,string)))
)
(defmacro pgg-parse-time-field (bytes)
`(list (logior (lsh (car ,bytes) 8)
(nth 1 ,bytes))
(logior (lsh (nth 2 ,bytes) 8)
(nth 3 ,bytes))
0))
(defmacro pgg-byte-after (&optional pos)
`(pgg-char-int (char-after ,(or pos `(point)))))
(defmacro pgg-read-byte ()
`(pgg-char-int (char-after (prog1 (point) (forward-char)))))
(defmacro pgg-read-bytes-string (nbytes)
`(buffer-substring
(point) (prog1 (+ ,nbytes (point))
(forward-char ,nbytes))))
(defmacro pgg-read-bytes (nbytes)
`(mapcar #'pgg-char-int (pgg-read-bytes-string ,nbytes))
;; `(string-to-number-list (pgg-read-bytes-string ,nbytes))
)
(defmacro pgg-read-body-string (ptag)
`(if (nth 1 ,ptag)
(pgg-read-bytes-string (nth 1 ,ptag))
(pgg-read-bytes-string (- (point-max) (point)))))
(defmacro pgg-read-body (ptag)
`(mapcar #'pgg-char-int (pgg-read-body-string ,ptag))
;; `(string-to-number-list (pgg-read-body-string ,ptag))
)
(defalias 'pgg-skip-bytes 'forward-char)
(defmacro pgg-skip-header (ptag)
`(pgg-skip-bytes (nth 2 ,ptag)))
(defmacro pgg-skip-body (ptag)
`(pgg-skip-bytes (nth 1 ,ptag)))
(defmacro pgg-set-alist (alist key value)
`(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
(when (fboundp 'define-ccl-program)
(define-ccl-program pgg-parse-crc24
'(1
((loop
(read r0) (r1 ^= r0) (r2 ^= 0)
(r5 = 0)
(loop
(r1 <<= 1)
(r1 += ((r2 >> 15) & 1))
(r2 <<= 1)
(if (r1 & 256)
((r1 ^= 390) (r2 ^= 19707)))
(if (r5 < 7)
((r5 += 1)
(repeat))))
(repeat)))))
(defun pgg-parse-crc24-string (string)
(let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
(ccl-execute-on-string pgg-parse-crc24 h string)
(format "%c%c%c"
(logand (aref h 1) 255)
(logand (lsh (aref h 2) -8) 255)
(logand (aref h 2) 255)))))
(defmacro pgg-parse-length-type (c)
`(cond
((< ,c 192) (cons ,c 1))
((< ,c 224)
(cons (+ (lsh (- ,c 192) 8)
(pgg-byte-after (+ 2 (point)))
192)
2))
((= ,c 255)
(cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
(pgg-byte-after (+ 3 (point))))
(logior (lsh (pgg-byte-after (+ 4 (point))) 8)
(pgg-byte-after (+ 5 (point)))))
5))
(t;partial body length
'(0 . 0))))
(defun pgg-parse-packet-header ()
(let ((ptag (pgg-byte-after))
length-type content-tag packet-bytes header-bytes)
(if (zerop (logand 64 ptag));Old format
(progn
(setq length-type (logand ptag 3)
length-type (if (= 3 length-type) 0 (lsh 1 length-type))
content-tag (logand 15 (lsh ptag -2))
packet-bytes 0
header-bytes (1+ length-type))
(dotimes (i length-type)
(setq packet-bytes
(logior (lsh packet-bytes 8)
(pgg-byte-after (+ 1 i (point)))))))
(setq content-tag (logand 63 ptag)
length-type (pgg-parse-length-type
(pgg-byte-after (1+ (point))))
packet-bytes (car length-type)
header-bytes (1+ (cdr length-type))))
(list content-tag packet-bytes header-bytes)))
(defun pgg-parse-packet (ptag)
(case (car ptag)
(1 ;Public-Key Encrypted Session Key Packet
(pgg-parse-public-key-encrypted-session-key-packet ptag))
(2 ;Signature Packet
(pgg-parse-signature-packet ptag))
(3 ;Symmetric-Key Encrypted Session Key Packet
(pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
;; 4 -- One-Pass Signature Packet
;; 5 -- Secret Key Packet
(6 ;Public Key Packet
(pgg-parse-public-key-packet ptag))
;; 7 -- Secret Subkey Packet
;; 8 -- Compressed Data Packet
(9 ;Symmetrically Encrypted Data Packet
(pgg-read-body-string ptag))
(10 ;Marker Packet
(pgg-read-body-string ptag))
(11 ;Literal Data Packet
(pgg-read-body-string ptag))
;; 12 -- Trust Packet
(13 ;User ID Packet
(pgg-read-body-string ptag))
;; 14 -- Public Subkey Packet
;; 60 .. 63 -- Private or Experimental Values
))
(defun pgg-parse-packets (&optional header-parser body-parser)
(let ((header-parser
(or header-parser
(function pgg-parse-packet-header)))
(body-parser
(or body-parser
(function pgg-parse-packet)))
result ptag)
(while (> (point-max) (1+ (point)))
(setq ptag (funcall header-parser))
(pgg-skip-header ptag)
(push (cons (car ptag)
(save-excursion
(funcall body-parser ptag)))
result)
(if (zerop (nth 1 ptag))
(goto-char (point-max))
(forward-char (nth 1 ptag))))
result))
(defun pgg-parse-signature-subpacket-header ()
(let ((length-type (pgg-parse-length-type (pgg-byte-after))))
(list (pgg-byte-after (+ (cdr length-type) (point)))
(1- (car length-type))
(1+ (cdr length-type)))))
(defun pgg-parse-signature-subpacket (ptag)
(case (car ptag)
(2 ;signature creation time
(cons 'creation-time
(let ((bytes (pgg-read-bytes 4)))
(pgg-parse-time-field bytes))))
(3 ;signature expiration time
(cons 'signature-expiry
(let ((bytes (pgg-read-bytes 4)))
(pgg-parse-time-field bytes))))
(4 ;exportable certification
(cons 'exportability (pgg-read-byte)))
(5 ;trust signature
(cons 'trust-level (pgg-read-byte)))
(6 ;regular expression
(cons 'regular-expression
(pgg-read-body-string ptag)))
(7 ;revocable
(cons 'revocability (pgg-read-byte)))
(9 ;key expiration time
(cons 'key-expiry
(let ((bytes (pgg-read-bytes 4)))
(pgg-parse-time-field bytes))))
;; 10 = placeholder for backward compatibility
(11 ;preferred symmetric algorithms
(cons 'preferred-symmetric-key-algorithm
(cdr (assq (pgg-read-byte)
pgg-parse-symmetric-key-algorithm-alist))))
(12 ;revocation key
)
(16 ;issuer key ID
(cons 'key-identifier
(pgg-format-key-identifier (pgg-read-body-string ptag))))
(20 ;notation data
(pgg-skip-bytes 4)
(cons 'notation
(let ((name-bytes (pgg-read-bytes 2))
(value-bytes (pgg-read-bytes 2)))
(cons (pgg-read-bytes-string
(logior (lsh (car name-bytes) 8)
(nth 1 name-bytes)))
(pgg-read-bytes-string
(logior (lsh (car value-bytes) 8)
(nth 1 value-bytes)))))))
(21 ;preferred hash algorithms
(cons 'preferred-hash-algorithm
(cdr (assq (pgg-read-byte)
pgg-parse-hash-algorithm-alist))))
(22 ;preferred compression algorithms
(cons 'preferred-compression-algorithm
(cdr (assq (pgg-read-byte)
pgg-parse-compression-algorithm-alist))))
(23 ;key server preferences
(cons 'key-server-preferences
(pgg-read-body ptag)))
(24 ;preferred key server
(cons 'preferred-key-server
(pgg-read-body-string ptag)))
;; 25 = primary user id
(26 ;policy URL
(cons 'policy-url (pgg-read-body-string ptag)))
;; 27 = key flags
;; 28 = signer's user id
;; 29 = reason for revocation
;; 100 to 110 = internal or user-defined
))
(defun pgg-parse-signature-packet (ptag)
(let* ((signature-version (pgg-byte-after))
(result (list (cons 'version signature-version)))
hashed-material field n)
(cond
((= signature-version 3)
(pgg-skip-bytes 2)
(setq hashed-material (pgg-read-bytes 5))
(pgg-set-alist result
'signature-type
(cdr (assq (pop hashed-material)
pgg-parse-signature-type-alist)))
(pgg-set-alist result
'creation-time
(pgg-parse-time-field hashed-material))
(pgg-set-alist result
'key-identifier
(pgg-format-key-identifier
(pgg-read-bytes-string 8)))
(pgg-set-alist result
'public-key-algorithm (pgg-read-byte))
(pgg-set-alist result
'hash-algorithm (pgg-read-byte)))
((= signature-version 4)
(pgg-skip-bytes 1)
(pgg-set-alist result
'signature-type
(cdr (assq (pgg-read-byte)
pgg-parse-signature-type-alist)))
(pgg-set-alist result
'public-key-algorithm
(pgg-read-byte))
(pgg-set-alist result
'hash-algorithm (pgg-read-byte))
(when (>= 10000 (setq n (pgg-read-bytes 2)
n (logior (lsh (car n) 8)
(nth 1 n))))
(save-restriction
(narrow-to-region (point)(+ n (point)))
(nconc result
(mapcar (function cdr) ;remove packet types
(pgg-parse-packets
#'pgg-parse-signature-subpacket-header
#'pgg-parse-signature-subpacket)))
(goto-char (point-max))))
(when (>= 10000 (setq n (pgg-read-bytes 2)
n (logior (lsh (car n) 8)
(nth 1 n))))
(save-restriction
(narrow-to-region (point)(+ n (point)))
(nconc result
(mapcar (function cdr) ;remove packet types
(pgg-parse-packets
#'pgg-parse-signature-subpacket-header
#'pgg-parse-signature-subpacket)))))))
(setcdr (setq field (assq 'public-key-algorithm
result))
(cdr (assq (cdr field)
pgg-parse-public-key-algorithm-alist)))
(setcdr (setq field (assq 'hash-algorithm
result))
(cdr (assq (cdr field)
pgg-parse-hash-algorithm-alist)))
result))
(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
(let (result)
(pgg-set-alist result
'version (pgg-read-byte))
(pgg-set-alist result
'key-identifier
(pgg-format-key-identifier
(pgg-read-bytes-string 8)))
(pgg-set-alist result
'public-key-algorithm
(cdr (assq (pgg-read-byte)
pgg-parse-public-key-algorithm-alist)))
result))
(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
(let (result)
(pgg-set-alist result
'version
(pgg-read-byte))
(pgg-set-alist result
'symmetric-key-algorithm
(cdr (assq (pgg-read-byte)
pgg-parse-symmetric-key-algorithm-alist)))
result))
(defun pgg-parse-public-key-packet (ptag)
(let* ((key-version (pgg-read-byte))
(result (list (cons 'version key-version)))
field)
(cond
((= 3 key-version)
(pgg-set-alist result
'creation-time
(let ((bytes (pgg-read-bytes 4)))
(pgg-parse-time-field bytes)))
(pgg-set-alist result
'key-expiry (pgg-read-bytes 2))
(pgg-set-alist result
'public-key-algorithm (pgg-read-byte)))
((= 4 key-version)
(pgg-set-alist result
'creation-time
(let ((bytes (pgg-read-bytes 4)))
(pgg-parse-time-field bytes)))
(pgg-set-alist result
'public-key-algorithm (pgg-read-byte))))
(setcdr (setq field (assq 'public-key-algorithm
result))
(cdr (assq (cdr field)
pgg-parse-public-key-algorithm-alist)))
result))
(defun pgg-decode-packets ()
(if (re-search-forward "^=\\([A-Za-z0-9+/]\\{4\\}\\)$" nil t)
(let ((p (match-beginning 0))
(checksum (match-string 1)))
(delete-region p (point-max))
(if (ignore-errors (base64-decode-region (point-min) p))
(or (not (fboundp 'pgg-parse-crc24-string))
pgg-ignore-packet-checksum
(string-equal (base64-encode-string (pgg-parse-crc24-string
(buffer-string)))
checksum)
(progn
(message "PGP packet checksum does not match")
nil))
(message "PGP packet contain invalid base64")
nil))
(message "PGP packet checksum not found")
nil))
(defun pgg-decode-armor-region (start end)
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(re-search-forward "^-+BEGIN PGP" nil t)
(delete-region (point-min)
(and (search-forward "\n\n")
(match-end 0)))
(when (pgg-decode-packets)
(goto-char (point-min))
(pgg-parse-packets))))
(defun pgg-parse-armor (string)
(with-temp-buffer
(buffer-disable-undo)
(if (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte nil))
(insert string)
(pgg-decode-armor-region (point-min)(point))))
(eval-and-compile
(defalias 'pgg-string-as-unibyte (if (fboundp 'string-as-unibyte)
'string-as-unibyte
'identity)))
(defun pgg-parse-armor-region (start end)
(pgg-parse-armor (pgg-string-as-unibyte (buffer-substring start end))))
(provide 'pgg-parse)
;;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e
;;; pgg-parse.el ends here
--- NEW FILE pgg-pgp.el ---
;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno at unixuser.org>
;; Created: 1999/11/02
;; Keywords: PGP, OpenPGP
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(eval-when-compile
(require 'cl) ; for pgg macros
(require 'pgg))
(defgroup pgg-pgp ()
"PGP 2.* and 6.* interface."
:group 'pgg)
(defcustom pgg-pgp-program "pgp"
"PGP 2.* and 6.* executable."
:group 'pgg-pgp
:type 'string)
(defcustom pgg-pgp-shell-file-name "/bin/sh"
"File name to load inferior shells from.
Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
:group 'pgg-pgp
:type 'string)
(defcustom pgg-pgp-shell-command-switch "-c"
"Switch used to have the shell execute its command line argument."
:group 'pgg-pgp
:type 'string)
(defcustom pgg-pgp-extra-args nil
"Extra arguments for every PGP invocation."
:group 'pgg-pgp
:type '(choice
(const :tag "None" nil)
(string :tag "Arguments")))
(defvar pgg-pgp-user-id nil
"PGP ID of your default identity.")
(defun pgg-pgp-process-region (start end passphrase program args)
(let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
(args
(concat args
pgg-pgp-extra-args
" 2>" (shell-quote-argument errors-file-name)))
(shell-file-name pgg-pgp-shell-file-name)
(shell-command-switch pgg-pgp-shell-command-switch)
(process-environment process-environment)
(output-buffer pgg-output-buffer)
(errors-buffer pgg-errors-buffer)
(process-connection-type nil)
process status exit-status)
(with-current-buffer (get-buffer-create output-buffer)
(buffer-disable-undo)
(erase-buffer))
(when passphrase
(setenv "PGPPASSFD" "0"))
(unwind-protect
(progn
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
(setq process
(start-process-shell-command "*PGP*" output-buffer
(concat program " " args))))
(set-process-sentinel process #'ignore)
(when passphrase
(process-send-string process (concat passphrase "\n")))
(process-send-region process start end)
(process-send-eof process)
(while (eq 'run (process-status process))
(accept-process-output process 5))
(setq status (process-status process)
exit-status (process-exit-status process))
(delete-process process)
(with-current-buffer output-buffer
(pgg-convert-lbt-region (point-min)(point-max) 'LF)
(if (memq status '(stop signal))
(error "%s exited abnormally: '%s'" program exit-status))
(if (= 127 exit-status)
(error "%s could not be found" program))
(set-buffer (get-buffer-create errors-buffer))
(buffer-disable-undo)
(erase-buffer)
(insert-file-contents errors-file-name)))
(if (and process (eq 'run (process-status process)))
(interrupt-process process))
(condition-case nil
(delete-file errors-file-name)
(file-error nil)))))
(defun pgg-pgp-lookup-key (string &optional type)
"Search keys associated with STRING."
(let ((args (list "+batchmode" "+language=en" "-kv" string)))
(with-current-buffer (get-buffer-create pgg-output-buffer)
(buffer-disable-undo)
(erase-buffer)
(apply #'call-process pgg-pgp-program nil t nil args)
(goto-char (point-min))
(cond
((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
(buffer-substring (point)(+ 8 (point))))
((re-search-forward "^Type" nil t);PGP 6.*
(beginning-of-line 2)
(substring
(nth 2 (split-string
(buffer-substring (point)(progn (end-of-line) (point)))))
2))))))
(defun pgg-pgp-encrypt-region (start end recipients &optional sign passphrase)
"Encrypt the current region between START and END."
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(passphrase (or passphrase
(when sign
(pgg-read-passphrase
(format "PGP passphrase for %s: "
pgg-pgp-user-id)
pgg-pgp-user-id))))
(args
(concat
"+encrypttoself=off +verbose=1 +batchmode +language=us -fate "
(if (or recipients pgg-encrypt-for-me)
(mapconcat 'shell-quote-argument
(append recipients
(if pgg-encrypt-for-me
(list pgg-pgp-user-id)))))
(if sign (concat " -s -u " (shell-quote-argument pgg-pgp-user-id))))))
(pgg-pgp-process-region start end nil pgg-pgp-program args)
(pgg-process-when-success nil)))
(defun pgg-pgp-decrypt-region (start end &optional passphrase)
"Decrypt the current region between START and END.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt))
(passphrase
(or passphrase
(pgg-read-passphrase
(format "PGP passphrase for %s: " pgg-pgp-user-id) key)))
(args
"+verbose=1 +batchmode +language=us -f"))
(pgg-pgp-process-region start end passphrase pgg-pgp-program args)
(pgg-process-when-success
(if pgg-cache-passphrase
(pgg-add-passphrase-to-cache key passphrase)))))
(defun pgg-pgp-sign-region (start end &optional clearsign passphrase)
"Make detached signature from text between START and END.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(passphrase
(or passphrase
(pgg-read-passphrase
(format "PGP passphrase for %s: " pgg-pgp-user-id)
(pgg-pgp-lookup-key pgg-pgp-user-id 'sign))))
(args
(concat (if clearsign "-fast" "-fbast")
" +verbose=1 +language=us +batchmode"
" -u " (shell-quote-argument pgg-pgp-user-id))))
(pgg-pgp-process-region start end passphrase pgg-pgp-program args)
(pgg-process-when-success
(goto-char (point-min))
(when (re-search-forward "^-+BEGIN PGP" nil t);XXX
(let ((packet
(cdr (assq 2 (pgg-parse-armor-region
(progn (beginning-of-line 2)
(point))
(point-max))))))
(if pgg-cache-passphrase
(pgg-add-passphrase-to-cache
(cdr (assq 'key-identifier packet))
passphrase)))))))
(defun pgg-pgp-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
(let* ((orig-file (pgg-make-temp-file "pgg"))
(args "+verbose=1 +batchmode +language=us")
(orig-mode (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes 448)
(let ((coding-system-for-write 'binary)
jka-compr-compression-info-list jam-zcat-filename-list)
(write-region start end orig-file)))
(set-default-file-modes orig-mode))
(if (stringp signature)
(progn
(copy-file signature (setq signature (concat orig-file ".asc")))
(setq args (concat args " " (shell-quote-argument signature)))))
(setq args (concat args " " (shell-quote-argument orig-file)))
(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
(delete-file orig-file)
(if signature (delete-file signature))
(pgg-process-when-success
(goto-char (point-min))
(let ((case-fold-search t))
(while (re-search-forward "^warning: " nil t)
(delete-region (match-beginning 0)
(progn (beginning-of-line 2) (point)))))
(goto-char (point-min))
(when (re-search-forward "^\\.$" nil t)
(delete-region (point-min)
(progn (beginning-of-line 2)
(point)))))))
(defun pgg-pgp-insert-key ()
"Insert public key at point."
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(args
(concat "+verbose=1 +batchmode +language=us -kxaf "
(shell-quote-argument pgg-pgp-user-id))))
(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
(insert-buffer-substring pgg-output-buffer)))
(defun pgg-pgp-snarf-keys-region (start end)
"Add all public keys in region between START and END to the keyring."
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(key-file (pgg-make-temp-file "pgg"))
(args
(concat "+verbose=1 +batchmode +language=us -kaf "
(shell-quote-argument key-file))))
(let ((coding-system-for-write 'raw-text-dos))
(write-region start end key-file))
(pgg-pgp-process-region start end nil pgg-pgp-program args)
(delete-file key-file)
(pgg-process-when-success nil)))
(provide 'pgg-pgp)
;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c
;;; pgg-pgp.el ends here
--- NEW FILE pgg-pgp5.el ---
;;; pgg-pgp5.el --- PGP 5.* support for PGG.
;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno at unixuser.org>
;; Created: 1999/11/02
;; Keywords: PGP, OpenPGP
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(eval-when-compile
(require 'cl) ; for pgg macros
(require 'pgg))
(defgroup pgg-pgp5 ()
"PGP 5.* interface."
:group 'pgg)
(defcustom pgg-pgp5-pgpe-program "pgpe"
"PGP 5.* 'pgpe' executable."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgps-program "pgps"
"PGP 5.* 'pgps' executable."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgpk-program "pgpk"
"PGP 5.* 'pgpk' executable."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgpv-program "pgpv"
"PGP 5.* 'pgpv' executable."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-shell-file-name "/bin/sh"
"File name to load inferior shells from.
Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-shell-command-switch "-c"
"Switch used to have the shell execute its command line argument."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-extra-args nil
"Extra arguments for every PGP 5.* invocation."
:group 'pgg-pgp5
:type '(choice
(const :tag "None" nil)
(string :tag "Arguments")))
(defvar pgg-pgp5-user-id nil
"PGP 5.* ID of your default identity.")
(defun pgg-pgp5-process-region (start end passphrase program args)
(let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
(args
(append args
pgg-pgp5-extra-args
(list (concat "2>" errors-file-name))))
(shell-file-name pgg-pgp5-shell-file-name)
(shell-command-switch pgg-pgp5-shell-command-switch)
(process-environment process-environment)
(output-buffer pgg-output-buffer)
(errors-buffer pgg-errors-buffer)
(process-connection-type nil)
process status exit-status)
(with-current-buffer (get-buffer-create output-buffer)
(buffer-disable-undo)
(erase-buffer))
(when passphrase
(setenv "PGPPASSFD" "0"))
(unwind-protect
(progn
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
(setq process
(apply #'funcall
#'start-process-shell-command "*PGP*" output-buffer
program args)))
(set-process-sentinel process #'ignore)
(when passphrase
(process-send-string process (concat passphrase "\n")))
(process-send-region process start end)
(process-send-eof process)
(while (eq 'run (process-status process))
(accept-process-output process 5))
(setq status (process-status process)
exit-status (process-exit-status process))
(delete-process process)
(with-current-buffer output-buffer
(pgg-convert-lbt-region (point-min)(point-max) 'LF)
(if (memq status '(stop signal))
(error "%s exited abnormally: '%s'" program exit-status))
(if (= 127 exit-status)
(error "%s could not be found" program))
(set-buffer (get-buffer-create errors-buffer))
(buffer-disable-undo)
(erase-buffer)
(insert-file-contents errors-file-name)))
(if (and process (eq 'run (process-status process)))
(interrupt-process process))
(condition-case nil
(delete-file errors-file-name)
(file-error nil)))))
(defun pgg-pgp5-lookup-key (string &optional type)
"Search keys associated with STRING."
(let ((args (list "+language=en" "-l" string)))
(with-current-buffer (get-buffer-create pgg-output-buffer)
(buffer-disable-undo)
(erase-buffer)
(apply #'call-process pgg-pgp5-pgpk-program nil t nil args)
(goto-char (point-min))
(when (re-search-forward "^sec" nil t)
(substring
(nth 2 (split-string
(buffer-substring (match-end 0)(progn (end-of-line)(point)))))
2)))))
(defun pgg-pgp5-encrypt-region (start end recipients &optional sign passphrase)
"Encrypt the current region between START and END."
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(passphrase (or passphrase
(when sign
(pgg-read-passphrase
(format "PGP passphrase for %s: "
pgg-pgp5-user-id)
pgg-pgp5-user-id))))
(args
(append
`("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
,@(if (or recipients pgg-encrypt-for-me)
(apply #'append
(mapcar (lambda (rcpt)
(list "-r"
(concat "\"" rcpt "\"")))
(append recipients
(if pgg-encrypt-for-me
(list pgg-pgp5-user-id)))))))
(if sign '("-s" "-u" pgg-pgp5-user-id)))))
(pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args)
(pgg-process-when-success nil)))
(defun pgg-pgp5-decrypt-region (start end &optional passphrase)
"Decrypt the current region between START and END."
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(passphrase
(or passphrase
(pgg-read-passphrase
(format "PGP passphrase for %s: " pgg-pgp5-user-id)
(pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt))))
(args
'("+verbose=1" "+batchmode=1" "+language=us" "-f")))
(pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args)
(pgg-process-when-success nil)))
(defun pgg-pgp5-sign-region (start end &optional clearsign passphrase)
"Make detached signature from text between START and END."
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(passphrase
(or passphrase
(pgg-read-passphrase
(format "PGP passphrase for %s: " pgg-pgp5-user-id)
(pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign))))
(args
(list (if clearsign "-fat" "-fbat")
"+verbose=1" "+language=us" "+batchmode=1"
"-u" pgg-pgp5-user-id)))
(pgg-pgp5-process-region start end passphrase pgg-pgp5-pgps-program args)
(pgg-process-when-success
(when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
(let ((packet
(cdr (assq 2 (pgg-parse-armor-region
(progn (beginning-of-line 2)
(point))
(point-max))))))
(if pgg-cache-passphrase
(pgg-add-passphrase-to-cache
(cdr (assq 'key-identifier packet))
passphrase)))))))
(defun pgg-pgp5-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
(let ((orig-file (pgg-make-temp-file "pgg"))
(args '("+verbose=1" "+batchmode=1" "+language=us"))
(orig-mode (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes 448)
(let ((coding-system-for-write 'binary)
jka-compr-compression-info-list jam-zcat-filename-list)
(write-region start end orig-file)))
(set-default-file-modes orig-mode))
(when (stringp signature)
(copy-file signature (setq signature (concat orig-file ".asc")))
(setq args (append args (list signature))))
(pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpv-program args)
(delete-file orig-file)
(if signature (delete-file signature))
(with-current-buffer pgg-errors-buffer
(goto-char (point-min))
(if (re-search-forward "^Good signature" nil t)
(progn
(set-buffer pgg-output-buffer)
(insert-buffer-substring pgg-errors-buffer)
t)
nil))))
(defun pgg-pgp5-insert-key ()
"Insert public key at point."
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(args
(list "+verbose=1" "+batchmode=1" "+language=us" "-x"
(concat "\"" pgg-pgp5-user-id "\""))))
(pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args)
(insert-buffer-substring pgg-output-buffer)))
(defun pgg-pgp5-snarf-keys-region (start end)
"Add all public keys in region between START and END to the keyring."
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(key-file (pgg-make-temp-file "pgg"))
(args
(list "+verbose=1" "+batchmode=1" "+language=us" "-a"
key-file)))
(let ((coding-system-for-write 'raw-text-dos))
(write-region start end key-file))
(pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args)
(delete-file key-file)
(pgg-process-when-success nil)))
(provide 'pgg-pgp5)
;;; arch-tag: 3dbd1073-6b3a-466c-9f55-5c587ffa6d7b
;;; pgg-pgp5.el ends here
--- NEW FILE pgg.el ---
;;; pgg.el --- glue for the various PGP implementations.
;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno at unixuser.org>
;; Symmetric encryption added by: Sascha Wilde <wilde at sha-bang.de>
;; Created: 1999/10/28
;; Keywords: PGP
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
(require 'pgg-def)
(require 'pgg-parse)
(autoload 'run-at-time "timer")
;; Don't merge these two `eval-when-compile's.
(eval-when-compile
(require 'cl))
;;; @ utility functions
;;;
(defun pgg-invoke (func scheme &rest args)
(progn
(require (intern (format "pgg-%s" scheme)))
(apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
(put 'pgg-save-coding-system 'lisp-indent-function 2)
(defmacro pgg-save-coding-system (start end &rest body)
`(if (interactive-p)
(let ((buffer (current-buffer)))
(with-temp-buffer
(let (buffer-undo-list)
(insert-buffer-substring buffer ,start ,end)
(encode-coding-region (point-min)(point-max)
buffer-file-coding-system)
(prog1 (save-excursion , at body)
(push nil buffer-undo-list)
(ignore-errors (undo))))))
(save-restriction
(narrow-to-region ,start ,end)
, at body)))
(defun pgg-temp-buffer-show-function (buffer)
(let ((window (or (get-buffer-window buffer 'visible)
(split-window-vertically))))
(set-window-buffer window buffer)
(shrink-window-if-larger-than-buffer window)))
;; XXX `pgg-display-output-buffer' is a horrible name for this function.
;; It should be something like `pgg-situate-output-or-display-error'.
(defun pgg-display-output-buffer (start end status)
"Situate en/decryption results or pop up an error buffer.
Text from START to END is replaced by contents of output buffer if STATUS
is true, or else the output buffer is displayed."
(if status
(pgg-situate-output start end)
(pgg-display-error-buffer)))
(defun pgg-situate-output (start end)
"Place en/decryption result in place of current text from START to END."
(delete-region start end)
(insert-buffer-substring pgg-output-buffer)
(decode-coding-region start (point) buffer-file-coding-system))
(defun pgg-display-error-buffer ()
"Pop up an error buffer indicating the reason for an en/decryption failure."
(let ((temp-buffer-show-function
(function pgg-temp-buffer-show-function)))
(with-output-to-temp-buffer pgg-echo-buffer
(set-buffer standard-output)
(insert-buffer-substring pgg-errors-buffer))))
(defvar pgg-passphrase-cache (make-vector 7 0))
(defvar pgg-pending-timers (make-vector 7 0)
"Hash table for managing scheduled pgg cache management timers.
We associate key and timer, so the timer can be cancelled if a new
timeout for the key is set while an old one is still pending.")
(defun pgg-read-passphrase (prompt &optional key notruncate)
"Using PROMPT, obtain passphrase for KEY from cache or user.
Truncate the key to 8 trailing characters unless NOTRUNCATE is true
\(default false).
Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
regulate cache behavior."
(or (pgg-read-passphrase-from-cache key notruncate)
(read-passwd prompt)))
(defun pgg-read-passphrase-from-cache (key &optional notruncate)
"Obtain passphrase for KEY from time-limited passphrase cache.
Truncate the key to 8 trailing characters unless NOTRUNCATE is true
\(default false).
Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
regulate cache behavior."
(and pgg-cache-passphrase
key (or notruncate
(setq key (pgg-truncate-key-identifier key)))
(symbol-value (intern-soft key pgg-passphrase-cache))))
(defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate)
"Associate KEY with PASSPHRASE in time-limited passphrase cache.
Truncate the key to 8 trailing characters unless NOTRUNCATE is true
\(default false).
Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
regulate cache behavior."
(let* ((key (if notruncate key (pgg-truncate-key-identifier key)))
(interned-timer-key (intern-soft key pgg-pending-timers))
(old-timer (symbol-value interned-timer-key))
new-timer)
(when old-timer
(cancel-timer old-timer)
(unintern interned-timer-key pgg-pending-timers))
(set (intern key pgg-passphrase-cache)
passphrase)
(set (intern key pgg-pending-timers)
(pgg-run-at-time pgg-passphrase-cache-expiry nil
#'pgg-remove-passphrase-from-cache
key notruncate))))
(if (fboundp 'clear-string)
(defalias 'pgg-clear-string 'clear-string)
(defun pgg-clear-string (string)
(fillarray string ?_)))
(defun pgg-remove-passphrase-from-cache (key &optional notruncate)
"Omit passphrase associated with KEY in time-limited passphrase cache.
Truncate the key to 8 trailing characters unless NOTRUNCATE is true
\(default false).
This is a no-op if there is not entry for KEY (eg, it's already expired.
The memory for the passphrase is filled with underscores to clear any
references to it.
Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
regulate cache behavior."
(let* ((passphrase (pgg-read-passphrase-from-cache key notruncate))
(key (if notruncate key (pgg-truncate-key-identifier key)))
(interned-timer-key (intern-soft key pgg-pending-timers))
(old-timer (symbol-value interned-timer-key)))
(when passphrase
(pgg-clear-string passphrase)
(unintern key pgg-passphrase-cache))
(when old-timer
(pgg-cancel-timer old-timer)
(unintern interned-timer-key pgg-pending-timers))))
(eval-when-compile
(defmacro pgg-run-at-time-1 (time repeat function args)
(when (featurep 'xemacs)
(if (condition-case nil
(let ((delete-itimer 'delete-itimer)
(itimer-driver-start 'itimer-driver-start)
(itimer-value 'itimer-value)
(start-itimer 'start-itimer))
(unless (or (symbol-value 'itimer-process)
(symbol-value 'itimer-timer))
(funcall itimer-driver-start))
;; Check whether there is a bug to which the difference of
;; the present time and the time when the itimer driver was
;; woken up is subtracted from the initial itimer value.
(let* ((inhibit-quit t)
(ctime (current-time))
(itimer-timer-last-wakeup
(prog1
ctime
(setcar ctime (1- (car ctime)))))
(itimer-list nil)
(itimer (funcall start-itimer "pgg-run-at-time"
'ignore 5)))
(sleep-for 0.1) ;; Accept the timeout interrupt.
(prog1
(> (funcall itimer-value itimer) 0)
(funcall delete-itimer itimer))))
(error nil))
`(let ((time ,time))
(apply #'start-itimer "pgg-run-at-time"
,function (if time (max time 1e-9) 1e-9)
,repeat nil t ,args)))
`(let ((time ,time)
(itimers (list nil)))
(setcar
itimers
(apply #'start-itimer "pgg-run-at-time"
(lambda (itimers repeat function &rest args)
(let ((itimer (car itimers)))
(if repeat
(progn
(set-itimer-function
itimer
(lambda (itimer repeat function &rest args)
(set-itimer-restart itimer repeat)
(set-itimer-function itimer function)
(set-itimer-function-arguments itimer args)
(apply function args)))
(set-itimer-function-arguments
itimer
(append (list itimer repeat function) args)))
(set-itimer-function
itimer
(lambda (itimer function &rest args)
(delete-itimer itimer)
(apply function args)))
(set-itimer-function-arguments
itimer
(append (list itimer function) args)))))
1e-9 (if time (max time 1e-9) 1e-9)
nil t itimers ,repeat ,function ,args))))))
(eval-and-compile
(if (featurep 'xemacs)
(progn
(defun pgg-run-at-time (time repeat function &rest args)
"Emulating function run as `run-at-time'.
TIME should be nil meaning now, or a number of seconds from now.
Return an itimer object which can be used in either `delete-itimer'
or `cancel-timer'."
(pgg-run-at-time-1 time repeat function args))
(defun pgg-cancel-timer (timer)
"Emulate cancel-timer for xemacs."
(let ((delete-itimer 'delete-itimer))
(funcall delete-itimer timer)))
)
(defalias 'pgg-run-at-time 'run-at-time)
(defalias 'pgg-cancel-timer 'cancel-timer)))
(defmacro pgg-convert-lbt-region (start end lbt)
`(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
(goto-char ,start)
(case ,lbt
(CRLF
(while (progn
(end-of-line)
(> (marker-position pgg-conversion-end) (point)))
(insert "\r")
(forward-line 1)))
(LF
(while (re-search-forward "\r$" pgg-conversion-end t)
(replace-match ""))))))
(put 'pgg-as-lbt 'lisp-indent-function 3)
(defmacro pgg-as-lbt (start end lbt &rest body)
`(let ((inhibit-read-only t)
buffer-read-only
buffer-undo-list)
(pgg-convert-lbt-region ,start ,end ,lbt)
(let ((,end (point)))
, at body)
(push nil buffer-undo-list)
(ignore-errors (undo))))
(put 'pgg-process-when-success 'lisp-indent-function 0)
(defmacro pgg-process-when-success (&rest body)
`(with-current-buffer pgg-output-buffer
(if (zerop (buffer-size)) nil , at body t)))
(defalias 'pgg-make-temp-file
(if (fboundp 'make-temp-file)
'make-temp-file
(lambda (prefix &optional dir-flag)
(let ((file (expand-file-name
(make-temp-name prefix)
(if (fboundp 'temp-directory)
(temp-directory)
temporary-file-directory))))
(if dir-flag
(make-directory file))
file))))
;;; @ interface functions
;;;
;;;###autoload
(defun pgg-encrypt-region (start end rcpts &optional sign passphrase)
"Encrypt the current region between START and END for RCPTS.
If optional argument SIGN is non-nil, do a combined sign and encrypt.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive
(list (region-beginning)(region-end)
(split-string (read-string "Recipients: ") "[ \t,]+")))
(let ((status
(pgg-save-coding-system start end
(pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme)
(point-min) (point-max) rcpts sign passphrase))))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
;;;###autoload
(defun pgg-encrypt-symmetric-region (start end &optional passphrase)
"Encrypt the current region between START and END symmetric with passphrase.
If optional PASSPHRASE is not specified, it will be obtained from the
cache or user."
(interactive "r")
(let ((status
(pgg-save-coding-system start end
(pgg-invoke "encrypt-symmetric-region"
(or pgg-scheme pgg-default-scheme)
(point-min) (point-max) passphrase))))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
;;;###autoload
(defun pgg-encrypt-symmetric (&optional start end passphrase)
"Encrypt the current buffer using a symmetric, rather than key-pair, cipher.
If optional arguments START and END are specified, only encrypt within
the region.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive)
(let* ((start (or start (point-min)))
(end (or end (point-max)))
(status (pgg-encrypt-symmetric-region start end passphrase)))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
;;;###autoload
(defun pgg-encrypt (rcpts &optional sign start end passphrase)
"Encrypt the current buffer for RCPTS.
If optional argument SIGN is non-nil, do a combined sign and encrypt.
If optional arguments START and END are specified, only encrypt within
the region.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive (list (split-string (read-string "Recipients: ") "[ \t,]+")))
(let* ((start (or start (point-min)))
(end (or end (point-max)))
(status (pgg-encrypt-region start end rcpts sign passphrase)))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
;;;###autoload
(defun pgg-decrypt-region (start end &optional passphrase)
"Decrypt the current region between START and END.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive "r")
(let* ((buf (current-buffer))
(status
(pgg-save-coding-system start end
(pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)
(point-min) (point-max) passphrase))))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
;;;###autoload
(defun pgg-decrypt (&optional start end passphrase)
"Decrypt the current buffer.
If optional arguments START and END are specified, only decrypt within
the region.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive "")
(let* ((start (or start (point-min)))
(end (or end (point-max)))
(status (pgg-decrypt-region start end passphrase)))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
;;;###autoload
(defun pgg-sign-region (start end &optional cleartext passphrase)
"Make the signature from text between START and END.
If the optional 3rd argument CLEARTEXT is non-nil, it does not create
a detached signature.
If this function is called interactively, CLEARTEXT is enabled
and the output is displayed.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive "r")
(let ((status (pgg-save-coding-system start end
(pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
(point-min) (point-max)
(or (interactive-p) cleartext)
passphrase))))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
;;;###autoload
(defun pgg-sign (&optional cleartext start end passphrase)
"Sign the current buffer.
If the optional argument CLEARTEXT is non-nil, it does not create a
detached signature.
If optional arguments START and END are specified, only sign data
within the region.
If this function is called interactively, CLEARTEXT is enabled
and the output is displayed.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive "")
(let* ((start (or start (point-min)))
(end (or end (point-max)))
(status (pgg-sign-region start end
(or (interactive-p) cleartext)
passphrase)))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
;;;###autoload
(defun pgg-verify-region (start end &optional signature fetch)
"Verify the current region between START and END.
If the optional 3rd argument SIGNATURE is non-nil, it is treated as
the detached signature of the current region.
If the optional 4th argument FETCH is non-nil, we attempt to fetch the
signer's public key from `pgg-default-keyserver-address'."
(interactive "r")
(let* ((packet
(if (null signature) nil
(with-temp-buffer
(buffer-disable-undo)
(if (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte nil))
(insert-file-contents signature)
(cdr (assq 2 (pgg-decode-armor-region
(point-min)(point-max)))))))
(key (cdr (assq 'key-identifier packet)))
status keyserver)
(and (stringp key)
pgg-query-keyserver
(setq key (concat "0x" (pgg-truncate-key-identifier key)))
(null (pgg-lookup-key key))
(or fetch (interactive-p))
(y-or-n-p (format "Key %s not found; attempt to fetch? " key))
(setq keyserver
(or (cdr (assq 'preferred-key-server packet))
pgg-default-keyserver-address))
(pgg-fetch-key keyserver key))
(setq status
(pgg-save-coding-system start end
(pgg-invoke "verify-region" (or pgg-scheme pgg-default-scheme)
(point-min) (point-max) signature)))
(when (interactive-p)
(let ((temp-buffer-show-function
(function pgg-temp-buffer-show-function)))
(with-output-to-temp-buffer pgg-echo-buffer
(set-buffer standard-output)
(insert-buffer-substring (if status pgg-output-buffer
pgg-errors-buffer)))))
status))
;;;###autoload
(defun pgg-verify (&optional signature fetch start end)
"Verify the current buffer.
If the optional argument SIGNATURE is non-nil, it is treated as
the detached signature of the current region.
If the optional argument FETCH is non-nil, we attempt to fetch the
signer's public key from `pgg-default-keyserver-address'.
If optional arguments START and END are specified, only verify data
within the region."
(interactive "")
(let* ((start (or start (point-min)))
(end (or end (point-max)))
(status (pgg-verify-region start end signature fetch)))
(when (interactive-p)
(let ((temp-buffer-show-function
(function pgg-temp-buffer-show-function)))
(with-output-to-temp-buffer pgg-echo-buffer
(set-buffer standard-output)
(insert-buffer-substring (if status pgg-output-buffer
pgg-errors-buffer)))))
status))
;;;###autoload
(defun pgg-insert-key ()
"Insert the ASCII armored public key."
(interactive)
(pgg-invoke "insert-key" (or pgg-scheme pgg-default-scheme)))
;;;###autoload
(defun pgg-snarf-keys-region (start end)
"Import public keys in the current region between START and END."
(interactive "r")
(pgg-save-coding-system start end
(pgg-invoke "snarf-keys-region" (or pgg-scheme pgg-default-scheme)
start end)))
;;;###autoload
(defun pgg-snarf-keys ()
"Import public keys in the current buffer."
(interactive "")
(pgg-snarf-keys-region (point-min) (point-max)))
(defun pgg-lookup-key (string &optional type)
(pgg-invoke "lookup-key" (or pgg-scheme pgg-default-scheme) string type))
(defvar pgg-insert-url-function (function pgg-insert-url-with-w3))
(defun pgg-insert-url-with-w3 (url)
(ignore-errors
(require 'url)
(let (buffer-file-name)
(url-insert-file-contents url))))
(defvar pgg-insert-url-extra-arguments nil)
(defvar pgg-insert-url-program nil)
(defun pgg-insert-url-with-program (url)
(let ((args (copy-sequence pgg-insert-url-extra-arguments))
process)
(insert
(with-temp-buffer
(setq process
(apply #'start-process " *PGG url*" (current-buffer)
pgg-insert-url-program (nconc args (list url))))
(set-process-sentinel process #'ignore)
(while (eq 'run (process-status process))
(accept-process-output process 5))
(delete-process process)
(if (and process (eq 'run (process-status process)))
(interrupt-process process))
(buffer-string)))))
(defun pgg-fetch-key (keyserver key)
"Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring."
(with-current-buffer (get-buffer-create pgg-output-buffer)
(buffer-disable-undo)
(erase-buffer)
(let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver)
(substring keyserver 0 (1- (match-end 0))))))
(save-excursion
(funcall pgg-insert-url-function
(if proto keyserver
(format "http://%s:11371/pks/lookup?op=get&search=%s"
keyserver key))))
(when (re-search-forward "^-+BEGIN" nil 'last)
(delete-region (point-min) (match-beginning 0))
(when (re-search-forward "^-+END" nil t)
(delete-region (progn (end-of-line) (point))
(point-max)))
(insert "\n")
(with-temp-buffer
(insert-buffer-substring pgg-output-buffer)
(pgg-snarf-keys-region (point-min)(point-max)))))))
(provide 'pgg)
;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4
;;; pgg.el ends here
***** Error reading new file: [Errno 2] No such file or directory: 'u-vm-color.el'
Index: .cvsignore
===================================================================
RCS file: /cvs/extras/rpms/emacs-vm/FC-6/.cvsignore,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- .cvsignore 18 Mar 2007 21:28:29 -0000 1.6
+++ .cvsignore 21 Jun 2007 22:00:51 -0000 1.7
@@ -1,12 +1 @@
-vm-7.19.tar.gz
-vm-7.19-devo-282.patch.gz
-pixmaps-small-fuzzy.tar.gz
-u-vm-color.el
-vcard.el
-vm-vcard.el
-pgg-def.el
-pgg.el
-pgg-gpg.el
-pgg-parse.el
-pgg-pgp5.el
-pgg-pgp.el
+vm-8.0.0-453.tgz
Index: emacs-vm.spec
===================================================================
RCS file: /cvs/extras/rpms/emacs-vm/FC-6/emacs-vm.spec,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- emacs-vm.spec 18 Mar 2007 21:28:29 -0000 1.6
+++ emacs-vm.spec 21 Jun 2007 22:00:51 -0000 1.7
@@ -1,42 +1,39 @@
-# Upstream vm (http://www.wonderworks.com/vm/) seems to be currently
-# unmaintained. This package adds the patchset maintained by Robert Widhopf-Fenk
-# (http://www.robf.de/Hacking/elisp/vm-7.19.patch.gz). I have manually added a
-# version number to the patch filename.
+# Font-lock support of message bodies was added (Source1) from
+# http://de.geocities.com/ulf_jasper/emacs.html on 10th February 2007.
#
# In order to make the PGP stuff work with GNU Emacs <22, I have pulled pgp*.el
# from the GNU Emacs CVS - see Source11-16. These were pulled from CVS on 10th
# February 2007.
-#
-# Vcard handling has been added - see Source21-22. These were pulled from
-# http://www.splode.com/users/friedman/software/emacs-lisp/ on 10th February
-# 2007.
-#
-# Font-lock support of message bodies was added (Source31) from
-# http://de.geocities.com/ulf_jasper/emacs.html on 10th February 2007.
-%define vmversion 7.19
-%define vmrfversion devo282
+# Upstream used rather odd versioning: there is a version number, and then a
+# "devo" number which is the BZR tree revision, separated with a hypen. However,
+# rpm doesn't allow a hyphen in the versoion number.
+%define vmversion 8.0.0
+%define devoversion 453
+
+
+%define pkgdir %{_datadir}/emacs/site-lisp/vm
+%define pixmapdir %{pkgdir}/pixmaps
+%define startd %{_datadir}/emacs/site-lisp/site-start.d/
+%define initfile %{startd}/vm-mode-init.el
Summary: Emacs VM mailreader
Name: emacs-vm
-Version: %{vmversion}.%{vmrfversion}
-Release: 9%{?dist}
+Version: %{vmversion}.%{devoversion}
+Release: 1%{?dist}
License: GPL
Group: Applications/Internet
-URL: http://www.wonderworks.com/vm/
+URL: http://www.nongnu.org/viewmail/
-Source0: http://www.seanet.com/~kylemonger/vm/vm-%{vmversion}.tar.gz
-Source1: pixmaps-small-fuzzy.tar.gz
+Source0: http://download.savannah.nongnu.org/releases/viewmail/vm-%{vmversion}-%{devoversion}.tgz
+Source1: u-vm-color.el
Source11: pgg.el
Source12: pgg-def.el
Source13: pgg-gpg.el
Source14: pgg-parse.el
Source15: pgg-pgp.el
Source16: pgg-pgp5.el
-Source21: vcard.el
-Source22: vm-vcard.el
-Source31: u-vm-color.el
-Patch0: vm-7.19-devo-282.patch.gz
+Patch0: makefile-add-extra-lisp.patch
Requires: emacs
Requires(pre): /sbin/install-info
@@ -53,10 +50,6 @@
digests, message forwarding, and organizing message presentation
according to various criteria.
-This package includes Robert widhopf-Fenk's patchset %{vmrfversion}
-(http://www.robf.de/Hacking/elisp/). Please read that webpage to find
-out how to configure the extra features offered by that patchset.
-
%package el
Group: Applications/Internet
Summary: Elisp source files for VM mailreader for emacs
@@ -67,81 +60,60 @@
package. It is not necessary to install this if you want to run vm.
%prep
-%setup -q -n vm-%{vmversion}
-
-tar -zxf %SOURCE1
-cp pixmaps-small-fuzzy/* pixmaps/
+%setup -q -n vm-%{vmversion}-%{devoversion}
-%patch0 -p1
-mv Makefile Makefile.bk
-sed -e 's/mkdirhier/mkdir -p/g' Makefile.bk > Makefile
-
-cp %{SOURCE11} .
-cp %{SOURCE12} .
-cp %{SOURCE13} .
-cp %{SOURCE14} .
-cp %{SOURCE15} .
-cp %{SOURCE16} .
-cp %{SOURCE21} .
-cp %{SOURCE22} .
-cp %{SOURCE31} .
+# Add extra elisp source files and modify Makefile.in so they get compiled
+cp %{SOURCE1} lisp
+cp %{SOURCE11} lisp
+cp %{SOURCE12} lisp
+cp %{SOURCE13} lisp
+cp %{SOURCE14} lisp
+cp %{SOURCE15} lisp
+cp %{SOURCE16} lisp
+%patch0
%build
-%define pkgdir %{_datadir}/emacs/site-lisp/vm
-%define pixmapdir %{pkgdir}/pixmaps
-
export CFLAGS="$RPM_OPT_FLAGS"
-
-make %{?_smp_mflags} all \
- prefix=%{_prefix} \
- INFODIR=%{_infodir} \
- LISPDIR=%{pkgdir} \
- BINDIR=%{_bindir} \
- PIXMAPDIR=%{pixmapdir} \
- EMACS=emacs
+%configure
+make
%install
rm -rf %{buildroot}
-echo %{buildroot}%{_prefix}
-make install \
- prefix=%{buildroot}%{_prefix} \
- INFODIR=%{buildroot}%{_infodir} \
- LISPDIR=%{buildroot}%{pkgdir} \
- BINDIR=%{buildroot}%{_bindir} \
- PIXMAPDIR=%{buildroot}%{pixmapdir}
-cp *.el %{buildroot}%{pkgdir}
+install -d %{buildroot}%{_bindir}
+install -d %{buildroot}%{_infodir}
-%define startd %{_datadir}/emacs/site-lisp/site-start.d/
-%define initfile %{startd}/vm-mode-init.el
+make install \
+ prefix=%{buildroot}%{_prefix} \
+ bindir=%{buildroot}%{_bindir} \
+ info_dir=%{buildroot}%{_infodir}
+
+# Copy source lisp files into buildroot for emacs-vm-el sub-package
+(cd lisp ; install -m 644 *.el %{buildroot}%{pkgdir})
# Create initialization file.
install -d %{buildroot}/%{startd}
cat > %{buildroot}/%{initfile} <<EOF
+;; Startup settings for VM
(setq vm-toolbar-pixmap-directory "%{pixmapdir}")
(setq vm-image-directory "%{pixmapdir}")
-(autoload 'vm "vm" "Start VM on your primary inbox." t)
-(autoload 'vm-other-frame "vm" "Like \`vm' but starts in another frame." t)
-(autoload 'vm-visit-folder "vm" "Start VM on an arbitrary folder." t)
-(autoload 'vm-visit-virtual-folder "vm" "Visit a VM virtual folder." t)
-(autoload 'vm-mode "vm" "Run VM major mode on a buffer" t)
-(autoload 'vm-mail "vm" "Send a mail message using VM." t)
-(autoload 'vm-submit-bug-report "vm" "Send a bug report about VM." t)
+(require 'vm-autoloads)
;; Settings for u-vm-color.el
(require 'u-vm-color)
(add-hook 'vm-summary-mode-hook 'u-vm-color-summary-mode)
(add-hook 'vm-select-message-hook 'u-vm-color-fontify-buffer)
+
+(defadvice vm-fill-paragraphs-containing-long-lines
+ (after u-vm-color activate)
+ (u-vm-color-fontify-buffer))
EOF
%clean
rm -rf %{buildroot}
%post
-# Without the --entry part here, we get a malformed entry in info.
-/sbin/install-info \
- --entry="* VM: (vm). An Emacs mailreader" \
- %{_infodir}/vm.info.gz %{_infodir}/dir 2>/dev/null || :
+/sbin/install-info %{_infodir}/vm.info.gz %{_infodir}/dir 2>/dev/null || :
%preun
if [ "$1" = "0" ] ; then
@@ -163,6 +135,12 @@
%{pkgdir}/*.el
%changelog
+* Tue Jun 19 2007 Jonathan G. Underwood <jonathan.underwood at gmail.com> - 8.0.0.453-1
+- Update to version 8.0.0 devo 453 which removes the need for thr vmrf patch
+- No longer need to bundle vcard stuff as that is included upstream
+- Spec file cleanups
+- No longer use separate pixmaps
+
* Sun Mar 18 2007 Jonathan G. Underwood <jonathan.underwood at gmail.com> - 7.19.%{vmrfversion}-9
- Bump release to fix problem with CVS sources file
Index: sources
===================================================================
RCS file: /cvs/extras/rpms/emacs-vm/FC-6/sources,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- sources 18 Mar 2007 21:28:29 -0000 1.6
+++ sources 21 Jun 2007 22:00:51 -0000 1.7
@@ -1,12 +1 @@
-7866f6243e398d76ae32356a4af76fa3 vm-7.19.tar.gz
-fadfef52b6b8eded9a84afdcd0282de9 vm-7.19-devo-282.patch.gz
-27e7b1da04d4976a8d33c9d2a6033e24 pixmaps-small-fuzzy.tar.gz
-55a7c54b0de0959550675c18016073a1 u-vm-color.el
-1ae781a8e5565b5ba88b74a507a84822 vcard.el
-e7269b9591ba0378f445097e494e312c vm-vcard.el
-13f1830392aeba72443483fa8d8d60ae pgg-def.el
-e74a78646320b62299925eb60f89c0a7 pgg.el
-6f9c568414e4871dea5af2c059d87a1d pgg-gpg.el
-dd1ef66498597788cd7ecb32e4d079ed pgg-parse.el
-0fbd82bb43a1136210c11fcb34aa0768 pgg-pgp5.el
-b2c210f93534a9b8c342439d43629827 pgg-pgp.el
+d0e7ea8ab75fd380f26a3506d1f1d73d vm-8.0.0-453.tgz
- Previous message (by thread): rpms/puppet/FC-5 .cvsignore, 1.14, 1.15 puppet.spec, 1.15, 1.16 sources, 1.14, 1.15
- Next message (by thread): rpms/puppet/EL-4 .cvsignore, 1.12, 1.13 puppet.spec, 1.13, 1.14 sources, 1.12, 1.13
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the fedora-extras-commits
mailing list