From 7f1f6fca222a32fc153ffddfc180d3d0855c2650 Mon Sep 17 00:00:00 2001 From: ueno Date: Sun, 16 Apr 2006 19:39:19 +0000 Subject: [PATCH] * epa-setup.el: New file. * epa-dired.el: New file. * epg.el (epg-colons-pub-spec): Abolished. (epg-colons-sec-spec): Abolished. (epg-colons-uid-spec): Abolished. (epg-colons-fpr-spec): Abolished. (epg-key-validity-alist): New variable. (epg-key-capablity-alist): New variable. (epg-make-key): New object epg-key. (epg-make-sub-key): New object epg-sub-key. (epg-make-user-id): New object epg-user-id. (epg-list-keys-1): Renamed from epg-list-keys. (epg-list-keys): Rewritten. --- COMPILE | 2 +- ChangeLog | 21 +++ Makefile.am | 2 +- README | 27 +--- epa-dired.el | 90 ++++++++++++ epa-setup.el | 6 + epa.el | 463 +++++++++++++++++++++++++++++----------------------------- epg.el | 284 ++++++++++++++++++++++------------- 8 files changed, 540 insertions(+), 355 deletions(-) create mode 100644 epa-dired.el create mode 100644 epa-setup.el diff --git a/COMPILE b/COMPILE index 71b4764..fb09266 100644 --- a/COMPILE +++ b/COMPILE @@ -1,7 +1,7 @@ ;;; -*- Emacs-Lisp -*- (defvar epg-modules - '(epg epa epf)) + '(epg epa epa-dired epa-setup)) (defun epg-compile-modules (modules) (let ((load-path (cons nil load-path)) diff --git a/ChangeLog b/ChangeLog index 83dcf23..9399ce7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,24 @@ +2006-04-16 Daiki Ueno + + * epa-setup.el: New file. + * epa-dired.el: New file. + + * epg.el (epg-colons-pub-spec): Abolished. + (epg-colons-sec-spec): Abolished. + (epg-colons-uid-spec): Abolished. + (epg-colons-fpr-spec): Abolished. + (epg-key-validity-alist): New variable. + (epg-key-capablity-alist): New variable. + (epg-make-key): New object epg-key. + (epg-make-sub-key): New object epg-sub-key. + (epg-make-user-id): New object epg-user-id. + (epg-list-keys-1): Renamed from epg-list-keys. + (epg-list-keys): Rewritten. + +2006-04-15 Daiki Ueno + + * epg.el (epg-list-keys): Make the NAME argument optional. + 2006-04-13 Daiki Ueno * epa.el: Added header. diff --git a/Makefile.am b/Makefile.am index d6fcf39..5af9349 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,6 +1,6 @@ AUTOMAKE_OPTIONS = no-dependencies -EXTRA_DIST = epg.el epa.el epf.el pgg-epg.el +EXTRA_DIST = epg.el epa.el epa-dired.el pgg-epg.el CLEANFILES = auto-autoloads.el custom-load.el *.elc FLAGS ?= -batch -q -no-site-file diff --git a/README b/README index bfd5bb9..64700a6 100644 --- a/README +++ b/README @@ -1,8 +1,11 @@ * What's this? -EasyPG is yet another GnuPG interface for Emacs. It consists of three -parts: transparent file encryption utility, Gnus/PGG backend, and -elisp library to interact with GnuPG. +EasyPG is yet another GnuPG interface for Emacs. It consists of two parts: + +epa.el - EasyPG Assistant, a basic GUI of GnuPG +epg.el - the EasyPG library which interacts with GnuPG + +NOTE: EasyPG is not a fork or a re-implementation of Gnus/PGG. * Requirements @@ -10,8 +13,6 @@ elisp library to interact with GnuPG. ** GnuPG 1.4.3 or later -** Gnus 5.10.8 or later (optional) - * Quick start ** Installation @@ -19,21 +20,9 @@ elisp library to interact with GnuPG. $ ./configure $ sudo make install -** Transparent file encryption utility - -EasyPG provides transparent file encryption utility similar to -crypt++, alpaca.el, hedgehog. To try this, add the following line to -your ~/.emacs and C-x C-f ~/test.txt.gpg. - -(require 'epf) - -** Gnus/PGG backend - -EasyPG provides an implementation of the backend interface of -Gnus/PGG. To use EasyPG instead of pgg-gpg, install pgg-epg.el and -add the following line to your ~/.gnus. +Add the following line to your ~/.emacs -(setq pgg-scheme 'epg) +(require 'epa-setup) * Advantages over other competitors diff --git a/epa-dired.el b/epa-dired.el new file mode 100644 index 0000000..4a3d6ea --- /dev/null +++ b/epa-dired.el @@ -0,0 +1,90 @@ +(require 'epa) +(require 'dired) + +(defvar epa-dired-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap "d" 'epa-dired-do-decrypt) + (define-key keymap "v" 'epa-dired-do-verify) + (define-key keymap "s" 'epa-dired-do-sign) + (define-key keymap "e" 'epa-dired-do-encrypt) + keymap)) + +(fset 'epa-dired-prefix epa-dired-map) + +(defun epa-dired-setup () + (add-hook 'dired-mode-hook 'epa-dired-mode-hook)) + +(defun epa-dired-mode-hook () + (define-key dired-mode-map ":" 'epa-dired-prefix)) + +(defun epa-dired-decrypt-file (file) + (let ((context (epg-make-context))) + (message "Decrypting %s..." (file-name-nondirectory file)) + (epg-decrypt-file context file) + (message "Decrypting %s...done" (file-name-nondirectory file)))) + +(defun epa-dired-do-decrypt () + (interactive) + (let ((file-list (dired-get-marked-files))) + (while file-list + (epa-dired-decrypt-file (car file-list)) + (setq file-list (cdr file-list))))) + +(defun epa-dired-verify-file (file) + (let* ((context (epg-make-context)) + (plain (if (equal (file-name-extension file) "sig") + (file-name-sans-extension file)))) + (message "Verifying %s..." (file-name-nondirectory file)) + (epg-verify-file context file plain) + (message "Verifying %s...done" (file-name-nondirectory file)))) + +(defun epa-dired-do-verify () + (interactive) + (let ((file-list (dired-get-marked-files))) + (while file-list + (epa-dired-verify-file (car file-list)) + (setq file-list (cdr file-list))))) + +(defun epa-dired-sign-file (file detached) + (let ((signature (concat file (if detached ".sig" ".gpg"))) + (context (epg-make-context))) + (message "Signing %s..." (file-name-nondirectory file)) + (epg-sign-file context + file + signature) + (message "Signing %s...done" (file-name-nondirectory file)))) + +(defun epa-dired-do-sign (&optional detached) + (interactive "p") + (let ((file-list (dired-get-marked-files))) + (while file-list + (epa-dired-sign-file (expand-file-name (car file-list)) detached) + (setq file-list (cdr file-list))) + (revert-buffer))) + +(defun epa-dired-encrypt-file (keys file) + (let ((cipher (concat file ".gpg")) + (context (epg-make-context))) + (message "Encrypting %s..." (file-name-nondirectory file)) + (epg-encrypt-file context + file + (mapcar (lambda (key) + (epg-sub-key-id + (car (epg-key-sub-key-list key)))) + keys) + cipher) + (message "Encrypting %s...done" (file-name-nondirectory file)))) + +(defun epa-dired-do-encrypt () + (interactive) + (let ((file-list (dired-get-marked-files))) + (while file-list + (epa-ask-keys "Select keys for encryption. \ +If no keys are selected, symmetric encryption will be performed. " + #'epa-dired-encrypt-file nil + (expand-file-name (car file-list))) + (setq file-list (cdr file-list))))) + +(provide 'epa-dired) + +;;; epa-dired.el ends here diff --git a/epa-setup.el b/epa-setup.el new file mode 100644 index 0000000..3d3d3af --- /dev/null +++ b/epa-setup.el @@ -0,0 +1,6 @@ +(require 'epa-dired) +(epa-dired-setup) + +(provide 'epa-setup) + +;;; epa-setup.el ends here \ No newline at end of file diff --git a/epa.el b/epa.el index 8ef81b9..6e96a7b 100644 --- a/epa.el +++ b/epa.el @@ -25,6 +25,8 @@ (require 'epg) (require 'font-lock) +(require 'widget) +(eval-when-compile (require 'wid-edit)) (defgroup epa nil "EasyPG Assistant, GUI of EasyPG." @@ -36,39 +38,39 @@ (defvar epa-buffer nil) -(defface epa-validity-full-face +(defface epa-validity-high-face '((((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) (t (:bold t))) - "Face used for displaying the validity-full addon." + "Face used for displaying the high validity." :group 'epa-faces) -(defvar epa-validity-full-face 'epa-validity-full-face) +(defvar epa-validity-high-face 'epa-validity-high-face) -(defface epa-validity-disabled-face +(defface epa-validity-medium-face '((((class color) (background dark)) (:foreground "PaleTurquoise" :italic t)) (t ())) - "Face used for displaying the disabled validity." + "Face used for displaying the medium validity." :group 'epa-faces) -(defvar epa-validity-disabled-face 'epa-validity-disabled-face) +(defvar epa-validity-medium-face 'epa-validity-medium-face) -(defface epa-validity-unknown-face +(defface epa-validity-low-face '((t (:italic t))) - "Face used for displaying the validity-unknown addon." + "Face used for displaying the low validity." :group 'epa-faces) -(defvar epa-validity-unknown-face 'epa-validity-unknown-face) +(defvar epa-validity-low-face 'epa-validity-low-face) -(defface epa-validity-marginal-face +(defface epa-validity-disabled-face '((t (:italic t :inverse-video t))) - "Face used for displaying the validity-marginal addon." + "Face used for displaying the disabled validity." :group 'epa-faces) -(defvar epa-validity-marginal-face 'epa-validity-marginal-face) +(defvar epa-validity-disabled-face 'epa-validity-disabled-face) -(defface epa-user-id-face +(defface epa-string-face '((((class color) (background dark)) (:foreground "lightyellow")) @@ -77,274 +79,271 @@ (:foreground "blue4")) (t ())) - "Face used for displaying the user-id addon." + "Face used for displaying the string." :group 'epa-faces) -(defvar epa-user-id-face 'epa-user-id-face) +(defvar epa-string-face 'epa-string-face) + +(defface epa-field-name-face + '((((class color) (background dark)) + (:foreground "PaleTurquoise" :bold t)) + (t (:bold t))) + "Face for the name of the attribute field." + :group 'epa) +(defvar epa-field-name-face 'epa-field-name-face) + +(defface epa-field-body-face + '((((class color) (background dark)) + (:foreground "turquoise" :italic t)) + (t (:italic t))) + "Face for the body of the attribute field." + :group 'epa) +(defvar epa-field-body-face 'epa-field-body-face) (defcustom epa-validity-face-alist - '((?o . epa-validity-unknown-face) + '((?o . epa-validity-disabled-face) (?i . epa-validity-disabled-face) (?d . epa-validity-disabled-face) (?r . epa-validity-disabled-face) (?e . epa-validity-disabled-face) - (?- . epa-validity-unknown-face) - (?q . epa-validity-unknown-face) - (?n . epa-validity-disabled-face) - (?m . epa-validity-marginal-face) - (?f . epa-validity-full-face) - (?u . epa-validity-full-face) - (? . epa-validity-full-face)) - "An alist mapping marks on epa-buffer to faces." + (?- . epa-validity-low-face) + (?q . epa-validity-low-face) + (?n . epa-validity-low-face) + (?m . epa-validity-medium-face) + (?f . epa-validity-high-face) + (?u . epa-validity-high-face)) + "An alist mapping marks on epa-keys-buffer to faces." :type 'list :group 'epa) (defcustom epa-font-lock-keywords - '(("^[* ]\\([-oidreqnmfu ]\\)\\s-+\\(\\S-+\\)\\s-+\\(.*\\)" - (2 (cdr (assq (aref (match-string 1) 0) - epa-validity-face-alist))) - (3 epa-user-id-face))) + '(("^[* ]\\(\\([oidreqnmfu-]\\) .*\\)" + (1 (cdr (assq (aref (match-string 2) 0) + epa-validity-face-alist)))) + ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$" + (1 epa-field-name-face) + (2 epa-field-body-face))) "Default expressions to addon in epa-mode." :type '(repeat (list string)) :group 'epa) -(defvar epa-mode-map +(defconst epa-pubkey-algorithm-letter-alist + '((1 . ?R) + (2 . ?r) + (3 . ?s) + (16 . ?g) + (17 . ?D) + (20 . G))) + +(defvar epa-keys-buffer nil) +(defvar epa-key-buffer-alist nil) +(defvar epa-key nil) + +(defvar epa-keys-mode-map (let ((keymap (make-sparse-keymap))) - (define-key keymap "m" 'epa-command-mark-key) - (define-key keymap "u" 'epa-command-unmark-key) - (define-key keymap "n" 'epa-command-next-line) + (define-key keymap "m" 'epa-mark) + (define-key keymap "u" 'epa-unmark) + (define-key keymap "n" 'next-line) (define-key keymap "p" 'previous-line) - (define-key keymap "e" 'epa-command-encrypt-file) - (define-key keymap "s" 'epa-command-sign-file) (define-key keymap " " 'scroll-up) (define-key keymap [delete] 'scroll-down) (define-key keymap "q" 'bury-buffer) keymap)) -(defun epa-mode () - "Major mode for EasyPG Assistant. -All normal editing commands are turned off." +(defun epa-keys-mode () + "Major mode for `epa-list-keys'." (kill-all-local-variables) (buffer-disable-undo) - (setq major-mode 'epa-mode - mode-name "EPA" + (setq major-mode 'epa-keys-mode + mode-name "Keys" truncate-lines t buffer-read-only t) - (use-local-map epa-mode-map) + (use-local-map epa-keys-mode-map) + (set-keymap-parent (current-local-map) widget-keymap) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(epa-font-lock-keywords t)) ;; In XEmacs, auto-initialization of font-lock is not effective ;; if buffer-file-name is not set. (font-lock-set-defaults) - (make-local-variable 'epa-marked-keys) - (run-hooks 'epa-mode-hook)) + (widget-setup) + (run-hooks 'epa-keys-mode-hook)) -(defun epa () - "EasyPG Assistant." - (interactive) - (unless epa-buffer - (setq epa-buffer (generate-new-buffer "*EPA*"))) - (set-buffer epa-buffer) - (epa-mode) +(defvar epa-key-mode-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap "q" 'bury-buffer) + keymap)) + +(defun epa-key-mode () + "Major mode for `epa-show-key'." + (kill-all-local-variables) + (buffer-disable-undo) + (setq major-mode 'epa-key-mode + mode-name "Key" + truncate-lines t + buffer-read-only t) + (use-local-map epa-key-mode-map) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(epa-font-lock-keywords t)) + ;; In XEmacs, auto-initialization of font-lock is not effective + ;; if buffer-file-name is not set. + (font-lock-set-defaults) + (run-hooks 'epa-key-mode-hook)) + +;;;###autoload +(defun epa-list-keys (&optional name) + (interactive "sPattern: ") + (unless (and epa-keys-buffer + (buffer-live-p epa-keys-buffer)) + (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) + (set-buffer epa-keys-buffer) + (erase-buffer) + (epa-list-keys-1 name) + (epa-keys-mode) + (goto-char (point-min)) + (pop-to-buffer (current-buffer))) + +(defun epa-list-keys-1 (name) (let ((inhibit-read-only t) buffer-read-only - configuration pointer entry point key-id) + keys point primary-sub-key primary-user-id) + (setq keys (epg-list-keys)) + (while keys + (setq point (point) + primary-sub-key (car (epg-key-sub-key-list (car keys))) + primary-user-id (car (epg-key-user-id-list (car keys)))) + (insert " " (or (char-to-string + (car (rassq (epg-sub-key-validity primary-sub-key) + epg-key-validity-alist))) + " ") " ") + (widget-create 'link + :tag (epg-sub-key-id primary-sub-key) + :notify 'epa-show-key-notify + (car keys)) + (insert " " (epg-user-id-name primary-user-id) "\n") + (put-text-property point (point) 'epa-key (car keys)) + (setq keys (cdr keys))))) + +(defun epa-ask-keys (prompt function &optional names &rest args) + (unless (and epa-keys-buffer + (buffer-live-p epa-keys-buffer)) + (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) + (let ((buffer (current-buffer)) + (inhibit-read-only t) + buffer-read-only) + (set-buffer epa-keys-buffer) + (erase-buffer) + (insert prompt) + (widget-create 'push-button + :tag "Done" + :notify (lambda (widget &rest ignore) + (let ((callback (widget-value widget)) + keys key) + (while (re-search-forward "^\\*" nil t) + (if (setq key (get-text-property (point) + 'epa-key)) + (setq keys (cons key keys)))) + (set-buffer (car callback)) + (apply (car (cdr callback)) keys + (cdr (cdr callback))))) + (cons buffer (cons function args))) + (insert "\n\n") + (if names + (while names + (epa-list-keys-1 (car names)) + (setq names (cdr names))) + (epa-list-keys-1 nil)) + (epa-keys-mode) + (goto-char (point-min)) + (pop-to-buffer (current-buffer)))) + +(defun epa-show-key (key) + (let* ((primary-sub-key (car (epg-key-sub-key-list key))) + (entry (assoc (epg-sub-key-id primary-sub-key) + epa-key-buffer-alist)) + (inhibit-read-only t) + buffer-read-only + pointer) + (unless entry + (setq entry (cons (epg-sub-key-id primary-sub-key) nil) + epa-key-buffer-alist (cons entry epa-key-buffer-alist))) + (unless (and (cdr entry) + (buffer-live-p (cdr entry))) + (setcdr entry (generate-new-buffer + (format "*Key*%s" (epg-sub-key-id primary-sub-key))))) + (set-buffer (cdr entry)) + (make-local-variable 'epa-key) + (setq epa-key key) (erase-buffer) - (insert "EasyPG Assistant\n\n") - (setq configuration (epg-configuration)) - (if (setq entry (assq 'version configuration)) - (insert (format "GnuPG %s\n" (cdr entry)))) - (if (setq entry (assq 'pubkey configuration)) - (insert (format "Pubkey: %s\n" - (mapconcat - (lambda (algorithm) - (if (setq entry - (assq algorithm - epg-pubkey-algorithm-alist)) - (cdr entry) - (format "(unknown: %d)" algorithm))) - (cdr entry) ", ")))) - (if (setq entry (assq 'cipher configuration)) - (insert (format "Cipher: %s\n" - (mapconcat - (lambda (algorithm) - (if (setq entry - (assq algorithm - epg-cipher-algorithm-alist)) - (cdr entry) - (format "(unknown: %d)" algorithm))) - (cdr entry) ", ")))) - (if (setq entry (assq 'digest configuration)) - (insert (format "Hash: %s\n" - (mapconcat - (lambda (algorithm) - (if (setq entry - (assq algorithm - epg-digest-algorithm-alist)) - (cdr entry) - (format "(unknown: %d)" algorithm))) - (cdr entry) ", ")))) - (if (setq entry (assq 'compress configuration)) - (insert (format "Compression: %s\n" - (mapconcat - (lambda (algorithm) - (if (setq entry - (assq algorithm - epg-compress-algorithm-alist)) - (cdr entry) - (format "(unknown: %d)" algorithm))) - (cdr entry) ", ")))) - (insert "\nSecret keys:\n\n") - (setq pointer (epg-list-keys nil t)) + (setq pointer (epg-key-user-id-list key)) (while pointer - (setq point (point) - entry (cdr (assq 'sec (car pointer))) - key-id (cdr (assq 'key-id entry))) - (insert (format " %s %s\n" - key-id - (cdr (assq 'user-id (assq 'uid (car pointer)))))) - (put-text-property point (point) 'epa-key-id key-id) - (put-text-property point (point) 'epa-key-secret t) + (insert " " + (char-to-string + (car (rassq (epg-user-id-validity (car pointer)) + epg-key-validity-alist))) + " " + (epg-user-id-name (car pointer)) + "\n") (setq pointer (cdr pointer))) - (insert "\nPublic keys:\n\n") - (setq pointer (epg-list-keys nil)) + (setq pointer (epg-key-sub-key-list key)) (while pointer - (setq point (point) - entry (cdr (assq 'pub (car pointer))) - key-id (cdr (assq 'key-id entry))) - (insert (format " %s %s %s\n" - (or (cdr (assq 'validity entry)) ? ) - key-id - (cdr (assq 'user-id (assq 'uid (car pointer)))))) - (put-text-property point (point) 'epa-key-id key-id) + (insert " " + (char-to-string + (car (rassq (epg-sub-key-validity (car pointer)) + epg-key-validity-alist))) + " " + (epg-sub-key-id (car pointer)) + " " + (format "%dbits" + (epg-sub-key-length (car pointer))) + " " + (cdr (assq (epg-sub-key-algorithm (car pointer)) + epg-pubkey-algorithm-alist)) + "\n\tCreated: " + (epg-sub-key-creation-time (car pointer)) + (if (epg-sub-key-expiration-time (car pointer)) + (format "\n\tExpires: %s" (epg-sub-key-expiration-time + (car pointer))) + "") + "\n\tCapabilities: " + (mapconcat #'symbol-name + (epg-sub-key-capability (car pointer)) + " ") + "\n\tFingerprint: " + (epg-sub-key-fingerprint (car pointer)) + "\n") (setq pointer (cdr pointer))) (goto-char (point-min)) (pop-to-buffer (current-buffer)) - (delete-other-windows))) - -(defun epa-key-id (point) - (let ((key-id (get-text-property point 'epa-key-id))) - (unless key-id - (setq point (next-single-property-change point 'epa-key-id)) - (when point - (goto-char point) - (setq key-id (get-text-property point 'epa-key-id)))) - key-id)) - -(defun epa-command-mark-key (key-id) - "Mark a key on the current line." - (interactive - (progn - (unless (eq major-mode 'epa-mode) - (error "Not in `epa-mode'")) - (list (epa-key-id (point))))) - (let ((point (point)) - (inhibit-read-only t) - buffer-read-only) - (while (and point - (not (equal (get-text-property point 'epa-key-id) key-id))) - (setq point (next-single-property-change point))) - (unless point - (error "Key %s not found" key-id)) - (goto-char point) + (epa-key-mode))) + +(defun epa-show-key-notify (widget &rest ignore) + (epa-show-key (widget-value widget))) + +(defun epa-mark () + "Mark the current line." + (interactive) + (let ((inhibit-read-only t) + buffer-read-only + properties) (beginning-of-line) - (delete-char) - (setq point (point)) + (setq properties (text-properties-at (point))) + (delete-char 1) (insert "*") - (put-text-property point (point) 'epa-key-id key-id) + (set-text-properties (1- (point)) (point) properties) (forward-line))) -(defun epa-command-unmark-key (key-id) - "Unmark a key on the current line." - (interactive - (progn - (unless (eq major-mode 'epa-mode) - (error "Not in `epa-mode'")) - (list (epa-key-id (point))))) - (let ((point (point)) - (inhibit-read-only t) - buffer-read-only) - (while (and point - (not (equal (get-text-property point 'epa-key-id) key-id))) - (setq point (next-single-property-change point))) - (unless point - (error "Key %s not found" key-id)) - (goto-char point) +(defun epa-unmark () + "Unmark the current line." + (interactive) + (let ((inhibit-read-only t) + buffer-read-only + properties) (beginning-of-line) - (delete-char) - (setq point (point)) + (setq properties (text-properties-at (point))) + (delete-char 1) (insert " ") - (put-text-property point (point) 'epa-key-id key-id) + (set-text-properties (1- (point)) (point) properties) (forward-line))) -(defun epa-command-next-line (count) - "Same as next-line except that if you are at the beginning of buffer, -you will be jumped to the first secret key." - (interactive "p") - (if (get-text-property (point) 'epa-key-id) - (next-line count) - (let ((point (next-single-property-change (point) 'epa-key-id))) - (if (and point - (get-text-property point 'epa-key-id)) - (goto-char point))))) - -(defun epa-command-encrypt-file (plain cipher recipients sign) - "Encrypt a file PLAIN for RECIPIENTS." - (interactive - (save-excursion - (set-buffer epa-buffer) - (goto-char (point-min)) - (let (plain recipients) - (while (re-search-forward "^\\*" nil t) - (unless (get-text-property (point) 'epa-key-secret) - (setq recipients (cons (get-text-property (point) 'epa-key-id) - recipients)))) - (list (setq plain (expand-file-name (read-file-name "Plain file: "))) - (expand-file-name - (read-file-name (format "Cipher file (default %s.gpg) " - (file-name-nondirectory plain)) - (file-name-directory plain) - (concat plain ".gpg"))) - recipients - current-prefix-arg)))) - (message "Encrypting %s..." (file-name-nondirectory plain)) - (epg-encrypt-file (epg-make-context) - plain - recipients - (expand-file-name cipher) - sign) - (message "Encrypting %s...done" (file-name-nondirectory plain))) - -(defun epa-command-sign-file (plain signature detached signers) - "Sign a file PLAIN." - (interactive - (save-excursion - (set-buffer epa-buffer) - (goto-char (point-min)) - (let ((extension (if current-prefix-arg ".sig" ".gpg")) - plain signers) - (while (re-search-forward "^\\*" nil t) - (if (get-text-property (point) 'epa-key-secret) - (setq signers (cons (get-text-property (point) 'epa-key-id) - signers)))) - - (list (setq plain (expand-file-name (read-file-name "Plain file: "))) - (expand-file-name - (read-file-name (format "Signature file (default %s%s) " - (file-name-nondirectory plain) - extension) - (file-name-directory plain) - (concat plain extension))) - current-prefix-arg - signers)))) - (let ((context (epg-make-context))) - (epg-context-set-signers context signers) - (message "Signing %s..." (file-name-nondirectory plain)) - (epg-sign-file context - plain - signature - (if detached 'detached)) - (message "Signing %s...done" (file-name-nondirectory plain)))) - (provide 'epa) ;;; epa.el ends here diff --git a/epg.el b/epg.el index 605f0d1..6356fae 100644 --- a/epg.el +++ b/epg.el @@ -45,62 +45,7 @@ (defvar epg-context nil) (defvar epg-debug nil) -(defvar epg-colons-pub-spec - '((validity "[^:]") - (length "[0-9]+" 0 string-to-number) - (algorithm "[0-9]+" 0 string-to-number) - (key-id "[^:]+") - (creation-date "[0-9]+") - (expiration-date "[0-9]+") - nil - (owner-trust "[^:]") - nil - nil - (capability "[escaESCA]+")) - "The schema of keylisting output whose type is \"pub\". -This is used by `epg-list-keys'.") - -(defvar epg-colons-sec-spec - '((validity "[^:]") - (length "[0-9]+" 0 string-to-number) - (algorithm "[0-9]+" 0 string-to-number) - (key-id "[^:]+") - (creation-date "[0-9]+") - (expiration-date "[0-9]+") - nil - (owner-trust "[^:]") - nil - nil - (capability "[escaESCA]+")) -"The schema of keylisting output whose type is \"sec\". -This is used by `epg-list-keys'.") - -(defvar epg-colons-uid-spec - '((validity "[^:]") - nil - nil - nil - (creation-date "[0-9]+") - (expiration-date "[0-9]+") - (hash "[^:]+") - nil - (user-id "[^:]+")) - "The schema of keylisting output whose type is \"uid\". -This is used by `epg-list-keys'.") - -(defvar epg-colons-fpr-spec - '(nil - nil - nil - nil - nil - nil - nil - nil - (fingerprint "[^:]+")) - "The schema of keylisting output whose type is \"fpr\". -This is used by `epg-list-keys'.") - +;; from gnupg/include/cipher.h (defconst epg-cipher-algorithm-alist '((0 . "NONE") (1 . "IDEA") @@ -113,6 +58,7 @@ This is used by `epg-list-keys'.") (10 . "TWOFISH") (110 . "DUMMY"))) +;; from gnupg/include/cipher.h (defconst epg-pubkey-algorithm-alist '((1 . "RSA") (2 . "RSA_E") @@ -121,6 +67,7 @@ This is used by `epg-list-keys'.") (17 . "DSA") (20 . "ELGAMAL"))) +;; from gnupg/include/cipher.h (defconst epg-digest-algorithm-alist '((1 . "MD5") (2 . "SHA1") @@ -129,12 +76,32 @@ This is used by `epg-list-keys'.") (9 . "SHA384") (10 . "SHA512"))) +;; from gnupg/include/cipher.h (defconst epg-compress-algorithm-alist '((0 . "NONE") (1 . "ZIP") (2 . "ZLIB") (3 . "BZIP2"))) +(defvar epg-key-validity-alist + '((?o . unknown) + (?i . invalid) + (?d . disabled) + (?r . revoked) + (?e . expired) + (?- . none) + (?q . undefined) + (?n . never) + (?m . marginal) + (?f . full) + (?u . ultimate))) + +(defvar epg-key-capablity-alist + '((?e . encrypt) + (?s . sign) + (?c . certify) + (?a . authentication))) + (defvar epg-prompt-alist nil) (defun epg-make-data-from-file (file) @@ -290,6 +257,97 @@ This function is for internal use only." "Set the fingerprint of SIGNATURE." (aset signature 4 fingerprint)) +(defun epg-make-key (owner-trust) + "Return a key object." + (vector owner-trust nil nil)) + +(defun epg-key-owner-trust (key) + "Return the owner trust of KEY." + (aref key 0)) + +(defun epg-key-sub-key-list (key) + "Return the sub key list of KEY." + (aref key 1)) + +(defun epg-key-user-id-list (key) + "Return the user ID list of KEY." + (aref key 2)) + +(defun epg-key-set-sub-key-list (key sub-key-list) + "Set the sub key list of KEY." + (aset key 1 sub-key-list)) + +(defun epg-key-set-user-id-list (key user-id-list) + "Set the user ID list of KEY." + (aset key 2 user-id-list)) + +(defun epg-make-sub-key (validity capability secret algorithm length id + creation-time expiration-time) + "Return a sub key object." + (vector validity capability secret algorithm length id creation-time + expiration-time nil)) + +(defun epg-sub-key-validity (sub-key) + "Return the validity of SUB-KEY." + (aref sub-key 0)) + +(defun epg-sub-key-capability (sub-key) + "Return the capability of SUB-KEY." + (aref sub-key 1)) + +(defun epg-sub-key-secret (sub-key) + "Return non-nil if SUB-KEY is a secret key." + (aref sub-key 2)) + +(defun epg-sub-key-algorithm (sub-key) + "Return the algorithm of SUB-KEY." + (aref sub-key 3)) + +(defun epg-sub-key-length (sub-key) + "Return the length of SUB-KEY." + (aref sub-key 4)) + +(defun epg-sub-key-id (sub-key) + "Return the ID of SUB-KEY." + (aref sub-key 5)) + +(defun epg-sub-key-creation-time (sub-key) + "Return the creation time of SUB-KEY." + (aref sub-key 6)) + +(defun epg-sub-key-expiration-time (sub-key) + "Return the expiration time of SUB-KEY." + (aref sub-key 7)) + +(defun epg-sub-key-fingerprint (sub-key) + "Return the fingerprint of SUB-KEY." + (aref sub-key 8)) + +(defun epg-sub-key-set-fingerprint (sub-key fingerprint) + "Set the fingerprint of SUB-KEY. +This function is for internal use only." + (aset sub-key 8 fingerprint)) + +(defun epg-make-user-id (validity name) + "Return a user ID object." + (vector validity name nil)) + +(defun epg-user-id-validity (user-id) + "Return the validity of USER-ID." + (aref user-id 0)) + +(defun epg-user-id-name (user-id) + "Return the name of USER-ID." + (aref user-id 1)) + +(defun epg-user-id-signature-list (user-id) + "Return the signature list of USER-ID." + (aref user-id 2)) + +(defun epg-user-id-set-signature-list (user-id signature-list) + "Set the signature list of USER-ID." + (aset user-id 2 signature-list)) + (defun epg-context-result-for (context name) (cdr (assq name (epg-context-result context)))) @@ -526,7 +584,7 @@ This function is for internal use only." (let ((signature (car (epg-context-result-for epg-context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'fully)))) + (epg-signature-set-validity signature 'full)))) (defun epg-status-TRUST_ULTIMATE (process string) (let ((signature (car (epg-context-result-for epg-context 'verify)))) @@ -617,59 +675,81 @@ This function is for internal use only." config)))) config)) -(defun epg-list-keys (name &optional secret) - "List keys associated with STRING." +(defun epg-list-keys-1 (name mode) (let ((args (append (list "--with-colons" "--no-greeting" "--batch" "--fixed-list-mode" "--with-fingerprint" - (if secret "--list-secret-keys" "--list-keys")) + "--with-fingerprint" + (if mode "--list-secret-keys" "--list-keys")) (if name (list name)))) - keys type symbol pointer) + keys string field index) (with-temp-buffer (apply #'call-process epg-gpg-program nil (list t nil) nil args) (goto-char (point-min)) - (while (re-search-forward "^\\([a-z][a-z][a-z]\\):\\(.*\\)" nil t) - (setq type (match-string 1) - symbol (intern-soft (format "epg-colons-%s-spec" type))) - (if (member type '("pub" "sec")) - (setq keys (cons nil keys))) - (if (and symbol - (boundp symbol)) - (setcar keys (cons (cons (intern type) - (epg-parse-colons - (symbol-value symbol) - (match-string 2))) - (car keys)))) - (forward-line))) - (setq pointer keys) - (while pointer - (setcar pointer (nreverse (car pointer))) - (setq pointer (cdr pointer))) + (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t) + (setq keys (cons (make-vector 15 nil) keys) + string (match-string 0) + index 0 + field 0) + (while (eq index + (string-match "\\([^:]+\\)?:" string index)) + (setq index (match-end 0)) + (aset (car keys) field (match-string 1 string)) + (setq field (1+ field)))) + (nreverse keys)))) + +(defun epg-make-sub-key-1 (line) + (epg-make-sub-key + (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)) + (delq nil + (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist))) + (aref line 11))) + (member (aref line 0) '("sec" "ssb")) + (string-to-number (aref line 3)) + (string-to-number (aref line 2)) + (aref line 4) + (aref line 5) + (aref line 6))) + +(defun epg-list-keys (&optional name mode) + (let ((lines (epg-list-keys-1 name mode)) + keys) + (while lines + (cond + ((member (aref (car lines) 0) '("pub" "sec")) + (when (car keys) + (epg-key-set-sub-key-list + (car keys) + (nreverse (epg-key-sub-key-list (car keys)))) + (epg-key-set-user-id-list + (car keys) + (nreverse (epg-key-user-id-list (car keys))))) + (setq keys (cons (epg-make-key + (cdr (assq (string-to-char (aref (car lines) 8)) + epg-key-validity-alist))) + keys)) + (epg-key-set-sub-key-list + (car keys) + (cons (epg-make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys))))) + ((member (aref (car lines) 0) '("sub" "ssb")) + (epg-key-set-sub-key-list + (car keys) + (cons (epg-make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys))))) + ((equal (aref (car lines) 0) "uid") + (epg-key-set-user-id-list + (car keys) + (cons (epg-make-user-id + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist)) + (aref (car lines) 9)) + (epg-key-user-id-list (car keys))))) + ((equal (aref (car lines) 0) "fpr") + (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys))) + (aref (car lines) 9)))) + (setq lines (cdr lines))) (nreverse keys))) -(defun epg-parse-colons (alist string) - (let ((index 0) - result) - (while (and alist - (or (null (car alist)) - (eq index - (string-match - (concat "\\(" (nth 1 (car alist)) "\\)?:") - string index)))) - (if (car alist) - (progn - (setq index (match-end 0)) - (if (match-beginning 1) - (setq result - (cons (cons (car (car alist)) - (funcall (or (nth 3 (car alist)) #'identity) - (match-string - (1+ (or (nth 2 (car alist)) 0)) - string))) - result)))) - (setq index (1+ index))) - (setq alist (cdr alist))) - (nreverse result))) - (if (fboundp 'make-temp-file) (defalias 'epg-make-temp-file 'make-temp-file) ;; stolen from poe.el. -- 1.7.10.4