From: ueno Date: Thu, 13 Apr 2006 08:50:37 +0000 (+0000) Subject: * epa.el: New file. X-Git-Tag: epgsm-branchpoint~85 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=1d58f2ad2e1a0335075bf4fcee9ca20e118032f5;p=elisp%2Fepg.git * epa.el: New file. --- diff --git a/ChangeLog b/ChangeLog index 3a2e62b..9183968 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,7 @@ 2006-04-13 Daiki Ueno + * epa.el: New file. + * epg.el (epg-cipher-algorithm-alist): New constant. (epg-pubkey-algorithm-alist): New constant. (epg-digest-algorithm-alist): New constant. diff --git a/epa.el b/epa.el new file mode 100644 index 0000000..36e6f8f --- /dev/null +++ b/epa.el @@ -0,0 +1,318 @@ +(require 'epg) +(require 'font-lock) + +(defgroup epa nil + "EasyPG Assistant, GUI for EasyPG." + :group 'epg) + +(defgroup epa-faces nil + "Faces for epa-mode." + :group 'epa) + +(defvar epa-buffer nil) + +(defface epa-trust-full-face + '((((class color) (background dark)) + (:foreground "PaleTurquoise" :bold t)) + (t + (:bold t))) + "Face used for displaying the trust-full addon." + :group 'epa-faces) +(defvar epa-trust-full-face 'epa-trust-full-face) + +(defface epa-trust-disabled-face + '((((class color) (background dark)) + (:foreground "PaleTurquoise" :italic t)) + (t + ())) + "Face used for displaying the disabled trust." + :group 'epa-faces) +(defvar epa-trust-disabled-face 'epa-trust-disabled-face) + +(defface epa-trust-unknown-face + '((t + (:italic t))) + "Face used for displaying the trust-unknown addon." + :group 'epa-faces) +(defvar epa-trust-unknown-face 'epa-trust-unknown-face) + +(defface epa-trust-marginal-face + '((t + (:italic t :inverse-video t))) + "Face used for displaying the trust-marginal addon." + :group 'epa-faces) +(defvar epa-trust-marginal-face 'epa-trust-marginal-face) + +(defface epa-user-id-face + '((((class color) + (background dark)) + (:foreground "lightyellow")) + (((class color) + (background light)) + (:foreground "blue4")) + (t + ())) + "Face used for displaying the user-id addon." + :group 'epa-faces) +(defvar epa-user-id-face 'epa-user-id-face) + +(defcustom epa-validity-face-alist + '((?o . epa-trust-unknown-face) + (?i . epa-trust-disabled-face) + (?d . epa-trust-disabled-face) + (?r . epa-trust-disabled-face) + (?e . epa-trust-disabled-face) + (?- . epa-trust-unknown-face) + (?q . epa-trust-unknown-face) + (?n . epa-trust-disabled-face) + (?m . epa-trust-marginal-face) + (?f . epa-trust-full-face) + (?u . epa-trust-full-face) + (? . epa-trust-full-face)) + "An alist mapping marks on epa-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))) + "Default expressions to addon in epa-mode." + :type '(repeat (list string)) + :group 'epa) + +(defvar epa-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 "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 displaying addon list. +All normal editing commands are turned off." + (kill-all-local-variables) + (buffer-disable-undo) + (setq major-mode 'epa-mode + mode-name "EPA" + truncate-lines t + buffer-read-only t) + (use-local-map epa-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) + (make-local-variable 'epa-marked-keys) + (run-hooks 'epa-mode-hook)) + +(defun epa () + (interactive) + (unless epa-buffer + (setq epa-buffer (generate-new-buffer "*EPA*"))) + (set-buffer epa-buffer) + (epa-mode) + (let ((inhibit-read-only t) + buffer-read-only + configuration pointer entry point) + (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)) + (while pointer + (setq point (point)) + (setq entry (cdr (assq 'sec (car pointer)))) + (setq 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) + (setq pointer (cdr pointer))) + (insert "\nPublic keys:\n\n") + (setq pointer (epg-list-keys nil)) + (while pointer + (setq point (point)) + (setq entry (cdr (assq 'pub (car pointer)))) + (setq key-id (cdr (assq 'key-id entry))) + (insert (format " %s %s %s\n" + (or (cdr (assq 'trust entry)) ? ) + key-id + (cdr (assq 'user-id (assq 'uid (car pointer)))))) + (put-text-property point (point) 'epa-key-id key-id) + (setq pointer (cdr pointer))) + (goto-char (point-min)) + (pop-to-buffer (current-buffer)) + (delete-other-windows))) + +(defun epa-key-id () + (let ((key-id (get-text-property (point) 'epa-key-id)) + point) + (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) + (interactive + (progn + (unless (eq major-mode 'epa-mode) + (error "Not in `epa-mode'")) + (list (epa-key-id)))) + (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) + (beginning-of-line) + (delete-char) + (setq point (point)) + (insert "*") + (put-text-property point (point) 'epa-key-id key-id) + (forward-line))) + +(defun epa-command-unmark-key (key-id) + (interactive + (progn + (unless (eq major-mode 'epa-mode) + (error "Not in `epa-mode'")) + (list (epa-key-id)))) + (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) + (beginning-of-line) + (delete-char) + (setq point (point)) + (insert " ") + (put-text-property point (point) 'epa-key-id key-id) + (forward-line))) + +(defun epa-command-next-line (count) + (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) + (interactive + (save-excursion + (set-buffer epa-buffer) + (goto-char (point-min)) + (let (plain recipients) + (while (re-search-forward "^\\*" nil t) + (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) + (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