* epa-file.el (epa-file-write-region): Don't attempt to write the
[elisp/epg.git] / epa.el
diff --git a/epa.el b/epa.el
index 948cf8f..1a84de3 100644 (file)
--- a/epa.el
+++ b/epa.el
   "The EasyPG Assistant"
   :group 'epg)
 
+(defcustom epa-protocol 'OpenPGP
+  "The default protocol."
+  :type '(choice (const :tag "OpenPGP" OpenPGP)
+                (const :tag "CMS" CMS))
+  :group 'epa)
+
 (defcustom epa-armor nil
   "If non-nil, epa commands create ASCII armored output."
   :type 'boolean
@@ -42,7 +48,7 @@
   :type 'boolean
   :group 'epa)
 
-(defcustom epa-popup-info-window nil
+(defcustom epa-popup-info-window t
   "If non-nil, status information from epa commands is displayed on
 the separate window."
   :type 'boolean
@@ -166,6 +172,7 @@ the separate window."
 (defvar epa-key nil)
 (defvar epa-list-keys-arguments nil)
 (defvar epa-info-buffer nil)
+(defvar epa-last-coding-system-specified nil)
 
 (defvar epa-keys-mode-map
   (let ((keymap (make-sparse-keymap)))
@@ -220,9 +227,11 @@ the separate window."
                      ? ))
            (epg-sub-key-id primary-sub-key)
            " "
-           (if (stringp (epg-user-id-string primary-user-id))
-               (epg-user-id-string primary-user-id)
-             (epg-decode-dn (epg-user-id-string primary-user-id))))))
+           (if primary-user-id
+               (if (stringp (epg-user-id-string primary-user-id))
+                   (epg-user-id-string primary-user-id)
+                 (epg-decode-dn (epg-user-id-string primary-user-id)))
+             ""))))
 
 (defun epa--key-widget-button-face-get (widget)
   (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
@@ -236,6 +245,14 @@ the separate window."
          (epg-sub-key-id (car (epg-key-sub-key-list
                                (widget-get widget :value))))))
 
+(if (fboundp 'encode-coding-string)
+    (defalias 'epa--encode-coding-string 'encode-coding-string)
+  (defalias 'epa--encode-coding-string 'identity))
+
+(if (fboundp 'decode-coding-string)
+    (defalias 'epa--decode-coding-string 'decode-coding-string)
+  (defalias 'epa--decode-coding-string 'identity))
+
 (defun epa-keys-mode ()
   "Major mode for `epa-list-keys'."
   (kill-all-local-variables)
@@ -245,13 +262,11 @@ the separate window."
        truncate-lines t
        buffer-read-only t)
   (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)
-  (widget-setup)
   (make-local-variable 'epa-exit-buffer-function)
   (run-hooks 'epa-keys-mode-hook))
 
@@ -315,18 +330,18 @@ If ARG is non-nil, mark the current line."
   (funcall epa-exit-buffer-function))
 
 ;;;###autoload
-(defun epa-list-keys (&optional name mode protocol)
+(defun epa-list-keys (&optional name mode)
+  "List all keys matched with NAME from the keyring.
+If MODE is non-nil, it reads the private keyring.  Otherwise, it
+reads the public keyring."
   (interactive
    (if current-prefix-arg
        (let ((name (read-string "Pattern: "
                                (if epa-list-keys-arguments
                                    (car epa-list-keys-arguments)))))
         (list (if (equal name "") nil name)
-              (y-or-n-p "Secret keys? ")
-              (intern (completing-read "Protocol? "
-                                       '(("OpenPGP") ("CMS"))
-                                       nil t))))
-     (or epa-list-keys-arguments (list nil nil nil))))
+              (y-or-n-p "Secret keys? ")))
+     (or epa-list-keys-arguments (list nil nil))))
   (unless (and epa-keys-buffer
               (buffer-live-p epa-keys-buffer))
     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
@@ -334,7 +349,7 @@ If ARG is non-nil, mark the current line."
   (let ((inhibit-read-only t)
        buffer-read-only
        (point (point-min))
-       (context (epg-make-context protocol)))
+       (context (epg-make-context epa-protocol)))
     (unless (get-text-property point 'epa-list-keys)
       (setq point (next-single-property-change point 'epa-list-keys)))
     (when point
@@ -342,14 +357,16 @@ If ARG is non-nil, mark the current line."
                     (or (next-single-property-change point 'epa-list-keys)
                         (point-max)))
       (goto-char point))
-    (epa-insert-keys context name mode)
-    (epa-keys-mode))
+    (epa--insert-keys context name mode)
+    (epa-keys-mode)
+    (widget-setup)
+    (set-keymap-parent (current-local-map) widget-keymap))
   (make-local-variable 'epa-list-keys-arguments)
-  (setq epa-list-keys-arguments (list name mode protocol))
+  (setq epa-list-keys-arguments (list name mode))
   (goto-char (point-min))
   (pop-to-buffer (current-buffer)))
 
-(defun epa-insert-keys (context name mode)
+(defun epa--insert-keys (context name mode)
   (save-excursion
     (save-restriction
       (narrow-to-region (point) (point))
@@ -422,18 +439,20 @@ If SECRET is non-nil, list secret keys instead of public keys."
       (insert "\n\n")
       (if names
          (while names
-           (epa-insert-keys context (car names) secret)
+           (epa--insert-keys context (car names) secret)
            (if (get-text-property (point) 'epa-list-keys)
                (epa-mark))
            (goto-char (point-max))
            (setq names (cdr names)))
        (if secret
            (progn
-             (epa-insert-keys context nil secret)
+             (epa--insert-keys context nil secret)
              (if (get-text-property (point) 'epa-list-keys)
                  (epa-mark)))
-         (epa-insert-keys context nil nil)))
+         (epa--insert-keys context nil nil)))
       (epa-keys-mode)
+      (widget-setup)
+      (set-keymap-parent (current-local-map) widget-keymap)
       (setq epa-exit-buffer-function #'abort-recursive-edit)
       (goto-char (point-min))
       (pop-to-buffer (current-buffer)))
@@ -465,17 +484,18 @@ If SECRET is non-nil, list secret keys instead of public keys."
     (erase-buffer)
     (setq pointer (epg-key-user-id-list key))
     (while pointer
-      (insert " "
-             (if (epg-user-id-validity (car pointer))
-                 (char-to-string
-                  (car (rassq (epg-user-id-validity (car pointer))
-                              epg-key-validity-alist)))
-               " ")
-             " "
-             (if (stringp (epg-user-id-string (car pointer)))
-                 (epg-user-id-string (car pointer))
-               (epg-decode-dn (epg-user-id-string (car pointer))))
-             "\n")
+      (if (car pointer)
+         (insert " "
+                 (if (epg-user-id-validity (car pointer))
+                     (char-to-string
+                      (car (rassq (epg-user-id-validity (car pointer))
+                                  epg-key-validity-alist)))
+                   " ")
+                 " "
+                 (if (stringp (epg-user-id-string (car pointer)))
+                     (epg-user-id-string (car pointer))
+                   (epg-decode-dn (epg-user-id-string (car pointer))))
+                 "\n"))
       (setq pointer (cdr pointer)))
     (setq pointer (epg-key-sub-key-list key))
     (while pointer
@@ -516,7 +536,7 @@ If SECRET is non-nil, list secret keys instead of public keys."
 
 (defun epa-display-info (info)
   (if epa-popup-info-window
-      (progn
+      (save-selected-window
        (unless epa-info-buffer
          (setq epa-info-buffer (generate-new-buffer "*Info*")))
        (save-excursion
@@ -525,11 +545,16 @@ If SECRET is non-nil, list secret keys instead of public keys."
                buffer-read-only)
            (erase-buffer)
            (insert info))
-         (epa-info-mode))
-       (pop-to-buffer epa-info-buffer)
-       (if (> (window-height) epa-info-window-height)
-           (shrink-window (- (window-height) epa-info-window-height)))
-       (goto-char (point-min)))
+         (epa-info-mode)
+         (goto-char (point-min)))
+       (if (> (window-height)
+              epa-info-window-height)
+           (set-window-buffer (split-window nil (- (window-height)
+                                                   epa-info-window-height))
+                              epa-info-buffer)
+         (pop-to-buffer epa-info-buffer)
+         (if (> (window-height) epa-info-window-height)
+             (shrink-window (- (window-height) epa-info-window-height)))))
     (message "%s" info)))
 
 (defun epa-display-verify-result (verify-result)
@@ -558,6 +583,7 @@ If SECRET is non-nil, list secret keys instead of public keys."
 (defun epa-decrypt-file (file)
   "Decrypt FILE."
   (interactive "fFile: ")
+  (setq file (expand-file-name file))
   (let* ((default-name (file-name-sans-extension file))
         (plain (expand-file-name
                 (read-file-name
@@ -566,14 +592,15 @@ If SECRET is non-nil, list secret keys instead of public keys."
                          ") ")
                  (file-name-directory default-name)
                  default-name)))
-        (context (epg-make-context)))
+        (context (epg-make-context epa-protocol)))
     (epg-context-set-passphrase-callback context
                                         #'epa-passphrase-callback-function)
     (epg-context-set-progress-callback context
                                       #'epa-progress-callback-function)
     (message "Decrypting %s..." (file-name-nondirectory file))
     (epg-decrypt-file context file plain)
-    (message "Decrypting %s...done" (file-name-nondirectory file))
+    (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
+            (file-name-nondirectory plain))
     (if (epg-context-result-for context 'verify)
        (epa-display-info (epg-verify-result-to-string
                           (epg-context-result-for context 'verify))))))
@@ -582,7 +609,8 @@ If SECRET is non-nil, list secret keys instead of public keys."
 (defun epa-verify-file (file)
   "Verify FILE."
   (interactive "fFile: ")
-  (let* ((context (epg-make-context))
+  (setq file (expand-file-name file))
+  (let* ((context (epg-make-context epa-protocol))
         (plain (if (equal (file-name-extension file) "sig")
                    (file-name-sans-extension file))))
     (epg-context-set-progress-callback context
@@ -599,21 +627,43 @@ If SECRET is non-nil, list secret keys instead of public keys."
   "Sign FILE by SIGNERS keys selected."
   (interactive
    (list (expand-file-name (read-file-name "File: "))
-        (epa-select-keys (epg-make-context) "Select keys for signing.
+        (epa-select-keys (epg-make-context epa-protocol)
+                         "Select keys for signing.
 If no one is selected, default secret key is used.  "
                          nil t)
-        (if (y-or-n-p "Make a detached signature? ")
-            'detached
-          (if (y-or-n-p "Make a cleartext signature? ")
-              'clear))))
+        (catch 'done
+          (while t
+            (message "Signature type (n,c,d,?) ")
+            (let ((c (read-char)))
+              (cond ((eq c ?c)
+                     (throw 'done 'clear))
+                    ((eq c ?d)
+                     (throw 'done 'detached))
+                    ((eq c ??)
+                     (with-output-to-temp-buffer "*Help*"
+                       (save-excursion
+                         (set-buffer standard-output)
+                         (insert "\
+n - Create a normal signature
+c - Create a cleartext signature
+d - Create a detached signature
+? - Show this help
+"))))
+                    (t
+                     (throw 'done nil))))))))
   (let ((signature (concat file
-                          (if (or epa-armor
-                                  (not (memq mode '(nil t normal detached))))
-                              ".asc"
+                          (if (eq epa-protocol 'OpenPGP)
+                              (if (or epa-armor
+                                      (not (memq mode
+                                                 '(nil t normal detached))))
+                                  ".asc"
+                                (if (memq mode '(t detached))
+                                    ".sig"
+                                  ".gpg"))
                             (if (memq mode '(t detached))
-                                ".sig"
-                              ".gpg"))))
-       (context (epg-make-context)))
+                                ".p7s"
+                              ".p7m"))))
+       (context (epg-make-context epa-protocol)))
     (epg-context-set-armor context epa-armor)
     (epg-context-set-textmode context epa-textmode)
     (epg-context-set-signers context signers)
@@ -623,17 +673,21 @@ If no one is selected, default secret key is used.  "
                                       #'epa-progress-callback-function)
     (message "Signing %s..." (file-name-nondirectory file))
     (epg-sign-file context file signature mode)
-    (message "Signing %s...done" (file-name-nondirectory file))))
+    (message "Signing %s...wrote %s" (file-name-nondirectory file)
+            (file-name-nondirectory signature))))
 
 ;;;###autoload
 (defun epa-encrypt-file (file recipients)
   "Encrypt FILE for RECIPIENTS."
   (interactive
    (list (expand-file-name (read-file-name "File: "))
-        (epa-select-keys (epg-make-context) "Select recipients for encryption.
+        (epa-select-keys (epg-make-context epa-protocol)
+                         "Select recipients for encryption.
 If no one is selected, symmetric encryption will be performed.  ")))
-  (let ((cipher (concat file (if epa-armor ".asc" ".gpg")))
-       (context (epg-make-context)))
+  (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
+                                (if epa-armor ".asc" ".gpg")
+                              ".p7m")))
+       (context (epg-make-context epa-protocol)))
     (epg-context-set-armor context epa-armor)
     (epg-context-set-textmode context epa-textmode)
     (epg-context-set-passphrase-callback context
@@ -642,7 +696,8 @@ If no one is selected, symmetric encryption will be performed.  ")))
                                       #'epa-progress-callback-function)
     (message "Encrypting %s..." (file-name-nondirectory file))
     (epg-encrypt-file context file recipients cipher)
-    (message "Encrypting %s...done" (file-name-nondirectory file))))
+    (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
+            (file-name-nondirectory cipher))))
 
 ;;;###autoload
 (defun epa-decrypt-region (start end)
@@ -651,7 +706,7 @@ If no one is selected, symmetric encryption will be performed.  ")))
 Don't use this command in Lisp programs!"
   (interactive "r")
   (save-excursion
-    (let ((context (epg-make-context))
+    (let ((context (epg-make-context epa-protocol))
          plain)
       (epg-context-set-passphrase-callback context
                                           #'epa-passphrase-callback-function)
@@ -662,7 +717,10 @@ Don't use this command in Lisp programs!"
       (message "Decrypting...done")
       (delete-region start end)
       (goto-char start)
-      (insert (decode-coding-string plain coding-system-for-read))
+      (insert (epa--decode-coding-string plain
+                                        (or coding-system-for-read
+                                            (get-text-property
+                                             start 'epa-coding-system-used))))
       (if (epg-context-result-for context 'verify)
          (epa-display-info (epg-verify-result-to-string
                             (epg-context-result-for context 'verify)))))))
@@ -695,19 +753,26 @@ Don't use this command in Lisp programs!"
          (let ((coding-system-for-read coding-system))
            (epa-decrypt-region start end)))))))
 
+(if (fboundp 'select-safe-coding-system)
+    (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
+  (defun epa--select-safe-coding-system (from to)
+    buffer-file-coding-system))
+
 ;;;###autoload
 (defun epa-verify-region (start end)
   "Verify the current region between START and END.
 
 Don't use this command in Lisp programs!"
   (interactive "r")
-  (let ((context (epg-make-context)))
+  (let ((context (epg-make-context epa-protocol)))
     (epg-context-set-progress-callback context
                                       #'epa-progress-callback-function)
     (epg-verify-string context
-                      (encode-coding-string
+                      (epa--encode-coding-string
                        (buffer-substring start end)
-                       coding-system-for-write))
+                       (or coding-system-for-write
+                           (get-text-property start
+                                              'epa-coding-system-used))))
     (if (epg-context-result-for context 'verify)
        (epa-display-info (epg-verify-result-to-string
                           (epg-context-result-for context 'verify))))))
@@ -743,19 +808,43 @@ Don't use this command in Lisp programs!"
 
 Don't use this command in Lisp programs!"
   (interactive
-   (list (region-beginning) (region-end)
-        (epa-select-keys (epg-make-context) "Select keys for signing.
+   (progn
+     (setq epa-last-coding-system-specified
+          (or coding-system-for-write
+              (epa--select-safe-coding-system
+               (region-beginning) (region-end))))
+     (list (region-beginning) (region-end)
+          (epa-select-keys (epg-make-context epa-protocol)
+                           "Select keys for signing.
 If no one is selected, default secret key is used.  "
-                         nil t)
-        (if (y-or-n-p "Make a detached signature? ")
-            'detached
-          (if (y-or-n-p "Make a cleartext signature? ")
-              'clear))))
+                           nil t)
+          (catch 'done
+            (while t
+              (message "Signature type (n,c,d,?) ")
+              (let ((c (read-char)))
+                (cond ((eq c ?c)
+                       (throw 'done 'clear))
+                      ((eq c ?d)
+                       (throw 'done 'detached))
+                      ((eq c ??)
+                       (with-output-to-temp-buffer "*Help*"
+                         (save-excursion
+                           (set-buffer standard-output)
+                           (insert "\
+n - Create a normal signature
+c - Create a cleartext signature
+d - Create a detached signature
+? - Show this help
+"))))
+                      (t
+                       (throw 'done nil)))))))))
   (save-excursion
-    (let ((context (epg-make-context))
+    (let ((context (epg-make-context epa-protocol))
          signature)
-      (epg-context-set-armor context epa-armor)
-      (epg-context-set-textmode context epa-textmode)
+      ;;(epg-context-set-armor context epa-armor)
+      (epg-context-set-armor context t)
+      ;;(epg-context-set-textmode context epa-textmode)
+      (epg-context-set-textmode context t)
       (epg-context-set-signers context signers)
       (epg-context-set-passphrase-callback context
                                           #'epa-passphrase-callback-function)
@@ -763,13 +852,25 @@ If no one is selected, default secret key is used.  "
                                         #'epa-progress-callback-function)
       (message "Signing...")
       (setq signature (epg-sign-string context
-                                      (encode-coding-string
+                                      (epa--encode-coding-string
                                        (buffer-substring start end)
-                                       coding-system-for-write)
+                                       epa-last-coding-system-specified)
                                       mode))
       (message "Signing...done")
       (delete-region start end)
-      (insert (decode-coding-string signature coding-system-for-read)))))
+      (add-text-properties (point)
+                          (progn
+                            (insert (epa--decode-coding-string
+                                     signature
+                                     (or coding-system-for-read
+                                         epa-last-coding-system-specified)))
+                            (point))
+                          (list 'epa-coding-system-used
+                                epa-last-coding-system-specified
+                                'front-sticky nil
+                                'rear-nonsticky t
+                                'start-open t
+                                'end-open t)))))
 
 ;;;###autoload
 (defun epa-encrypt-region (start end recipients)
@@ -777,27 +878,44 @@ If no one is selected, default secret key is used.  "
 
 Don't use this command in Lisp programs!"
   (interactive
-   (list (region-beginning) (region-end)
-        (epa-select-keys (epg-make-context) "Select recipients for encryption.
-If no one is selected, symmetric encryption will be performed.  ")))
+   (progn
+     (setq epa-last-coding-system-specified
+          (or coding-system-for-write
+              (epa--select-safe-coding-system
+               (region-beginning) (region-end))))
+     (list (region-beginning) (region-end)
+          (epa-select-keys (epg-make-context epa-protocol)
+                           "Select recipients for encryption.
+If no one is selected, symmetric encryption will be performed.  "))))
   (save-excursion
-    (let ((context (epg-make-context))
+    (let ((context (epg-make-context epa-protocol))
          cipher)
-      (epg-context-set-armor context epa-armor)
-      (epg-context-set-textmode context epa-textmode)
+      ;;(epg-context-set-armor context epa-armor)
+      (epg-context-set-armor context t)
+      ;;(epg-context-set-textmode context epa-textmode)
+      (epg-context-set-textmode context t)
       (epg-context-set-passphrase-callback context
                                           #'epa-passphrase-callback-function)
       (epg-context-set-progress-callback context
                                         #'epa-progress-callback-function)
       (message "Encrypting...")
       (setq cipher (epg-encrypt-string context
-                                      (encode-coding-string
+                                      (epa--encode-coding-string
                                        (buffer-substring start end)
-                                       coding-system-for-write)
+                                       epa-last-coding-system-specified)
                                       recipients))
       (message "Encrypting...done")
       (delete-region start end)
-      (insert cipher))))
+      (add-text-properties (point)
+                          (progn
+                            (insert cipher)
+                            (point))
+                          (list 'epa-coding-system-used
+                                epa-last-coding-system-specified
+                                'front-sticky nil
+                                'rear-nonsticky t
+                                'start-open t
+                                'end-open t)))))
 
 ;;;###autoload
 (defun epa-delete-keys (keys &optional allow-secret)
@@ -810,7 +928,7 @@ Don't use this command in Lisp programs!"
        (error "No keys selected"))
      (list keys
           (eq (nth 1 epa-list-keys-arguments) t))))
-  (let ((context (epg-make-context)))
+  (let ((context (epg-make-context epa-protocol)))
     (message "Deleting...")
     (epg-delete-keys context keys allow-secret)
     (message "Deleting...done")
@@ -822,16 +940,37 @@ Don't use this command in Lisp programs!"
 
 Don't use this command in Lisp programs!"
   (interactive "fFile: ")
-  (let ((context (epg-make-context)))
+  (setq file (expand-file-name file))
+  (let ((context (epg-make-context epa-protocol)))
     (message "Importing %s..." (file-name-nondirectory file))
     (condition-case nil
        (progn
-         (epg-import-keys-from-file context (expand-file-name file))
+         (epg-import-keys-from-file context file)
          (message "Importing %s...done" (file-name-nondirectory file)))
       (error
        (message "Importing %s...failed" (file-name-nondirectory file))))
     (if (epg-context-result-for context 'import)
        (epa-display-info (epg-import-result-to-string
+                          (epg-context-result-for context 'import))))
+    (if (eq major-mode 'epa-keys-mode)
+       (apply #'epa-list-keys epa-list-keys-arguments))))
+
+;;;###autoload
+(defun epa-import-keys-region (start end)
+  "Import keys from the region.
+
+Don't use this command in Lisp programs!"
+  (interactive "r")
+  (let ((context (epg-make-context epa-protocol)))
+    (message "Importing...")
+    (condition-case nil
+       (progn
+         (epg-import-keys-from-string context (buffer-substring start end))
+         (message "Importing...done"))
+      (error
+       (message "Importing...failed")))
+    (if (epg-context-result-for context 'import)
+       (epa-display-info (epg-import-result-to-string
                           (epg-context-result-for context 'import))))))
 
 ;;;###autoload
@@ -857,13 +996,26 @@ Don't use this command in Lisp programs!"
                     ") ")
             (file-name-directory default-name)
             default-name)))))
-  (let ((context (epg-make-context)))
+  (let ((context (epg-make-context epa-protocol)))
     (epg-context-set-armor context epa-armor)
     (message "Exporting to %s..." (file-name-nondirectory file))
     (epg-export-keys-to-file context keys file)
     (message "Exporting to %s...done" (file-name-nondirectory file))))
 
 ;;;###autoload
+(defun epa-insert-keys (keys)
+  "Insert selected KEYS after the point.
+
+Don't use this command in Lisp programs!"
+  (interactive
+   (list (epa-select-keys (epg-make-context epa-protocol)
+                         "Select keys to export.  ")))
+  (let ((context (epg-make-context epa-protocol)))
+    ;;(epg-context-set-armor context epa-armor)
+    (epg-context-set-armor context t)
+    (insert (epg-export-keys-to-string context keys))))
+
+;;;###autoload
 (defun epa-sign-keys (keys &optional local)
   "Sign selected KEYS.
 If a prefix-arg is specified, the signature is marked as non exportable.
@@ -874,7 +1026,7 @@ Don't use this command in Lisp programs!"
      (unless keys
        (error "No keys selected"))
      (list keys current-prefix-arg)))
-  (let ((context (epg-make-context)))
+  (let ((context (epg-make-context epa-protocol)))
     (epg-context-set-passphrase-callback context
                                         #'epa-passphrase-callback-function)
     (epg-context-set-progress-callback context