* epa.el: New file.

diff --git a/ChangeLog b/ChangeLog
index 3a2e62b..9183968 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
 2006-04-13  Daiki Ueno  <ueno@unixuser.org>
 
+       * 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 (file)
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