* epg.el (epg-status-GET_BOOL): New function.

[elisp/epg.git] / epg.el

diff --git a/epg.el b/epg.el
index cd5ecb6..de72571 100644 (file)
--- a/epg.el
+++ b/epg.el
@@ -1,3 +1,30 @@
+;;; epg.el --- EasyPG, yet another GnuPG interface.
+;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2006 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Keywords: PGP, GnuPG
+
+;; This file is part of EasyPG.
+
+;; This program 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.
+
+;; This program 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 epg ()
   "EasyPG, yet another GnuPG interface.")
 
 (defgroup epg ()
   "EasyPG, yet another GnuPG interface.")
 

@@ -57,6 +84,8 @@ This is used by `epg-list-keys'.")
     (user-id "[^:]+"))
   "The schema of keylisting output whose type is \"uid\".
 This is used by `epg-list-keys'.")
     (user-id "[^:]+"))
   "The schema of keylisting output whose type is \"uid\".
 This is used by `epg-list-keys'.")

+
+(defvar epg-prompt-alist nil)

     
 (defun epg-make-context (&optional protocol armor textmode include-certs)
   "Return a context object."
     
 (defun epg-make-context (&optional protocol armor textmode include-certs)
   "Return a context object."

@@ -153,7 +182,7 @@ This function is for internal use only."
 
 (defun epg-make-signature (status key-id user-id)
   "Return a signature object."
 
 (defun epg-make-signature (status key-id user-id)
   "Return a signature object."

-  (vector status key-id user-id nil))
+  (vector status key-id user-id nil nil))

 
 (defun epg-signature-status (signature)
   "Return the status code of SIGNATURE."
 
 (defun epg-signature-status (signature)
   "Return the status code of SIGNATURE."

@@ -171,6 +200,10 @@ This function is for internal use only."
   "Return the validity of SIGNATURE."
   (aref signature 3))
 
   "Return the validity of SIGNATURE."
   (aref signature 3))
 

+(defun epg-signature-fingerprint (signature)
+  "Return the fingerprint of SIGNATURE."
+  (aref signature 4))
+

 (defun epg-signature-set-status (signature status)
  "Set the status code of SIGNATURE."
   (aset signature 0 status))
 (defun epg-signature-set-status (signature status)
  "Set the status code of SIGNATURE."
   (aset signature 0 status))

@@ -187,6 +220,10 @@ This function is for internal use only."
  "Set the validity of SIGNATURE."
   (aset signature 3 validity))
 
  "Set the validity of SIGNATURE."
   (aset signature 3 validity))
 

+(defun epg-signature-set-fingerprint (signature fingerprint)
+ "Set the fingerprint of SIGNATURE."
+  (aset signature 4 fingerprint))
+

 (defun epg-context-result-for (context name)
   (cdr (assq name (epg-context-result context))))
 
 (defun epg-context-result-for (context name)
   (cdr (assq name (epg-context-result context))))
 

@@ -260,7 +297,8 @@ This function is for internal use only."
 
 (defun epg-read-output (context)
   (with-temp-buffer
 
 (defun epg-read-output (context)
   (with-temp-buffer

-    (set-buffer-multibyte nil)
+    (if (fboundp 'set-buffer-multibyte)
+       (set-buffer-multibyte nil))

     (if (file-exists-p (epg-context-output-file context))
        (let ((coding-system-for-read (if (epg-context-textmode context)
                                          'raw-text
     (if (file-exists-p (epg-context-output-file context))
        (let ((coding-system-for-read (if (epg-context-textmode context)
                                          'raw-text

@@ -276,7 +314,8 @@ This function is for internal use only."
       (accept-process-output (epg-context-process context) 1))))
 
 (defun epg-wait-for-completion (context)
       (accept-process-output (epg-context-process context) 1))))
 
 (defun epg-wait-for-completion (context)

-  (process-send-eof (epg-context-process context))
+  (if (eq (process-status (epg-context-process context)) 'run)
+      (process-send-eof (epg-context-process context)))

   (while (eq (process-status (epg-context-process context)) 'run)
     ;; We can't use accept-process-output instead of sit-for here
     ;; because it may cause an interrupt during the sentinel execution.
   (while (eq (process-status (epg-context-process context)) 'run)
     ;; We can't use accept-process-output instead of sit-for here
     ;; because it may cause an interrupt during the sentinel execution.

@@ -288,8 +327,7 @@ This function is for internal use only."
       (kill-buffer (process-buffer (epg-context-process context))))
   (epg-context-set-process context nil)
   (if (file-exists-p (epg-context-output-file context))
       (kill-buffer (process-buffer (epg-context-process context))))
   (epg-context-set-process context nil)
   (if (file-exists-p (epg-context-output-file context))

-      (delete-file (epg-context-output-file context)))
-  (aset context 9 nil))
+      (delete-file (epg-context-output-file context))))

 
 (defun epg-status-USERID_HINT (process string)
   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 
 (defun epg-status-USERID_HINT (process string)
   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)

@@ -327,6 +365,17 @@ This function is for internal use only."
          (if string
              (fillarray string 0))))))
 
          (if string
              (fillarray string 0))))))
 

+(defun epg-status-GET_BOOL (process string)
+  (let ((entry (assoc string epg-prompt-alist)))
+    (if (y-or-n-p (if entry (cdr entry) (concat string "? ")))
+       (process-send-string process "y\n")
+      (process-send-string process "n\n"))))
+
+(defun epg-status-GET_LINE (process string)
+  (let* ((entry (assoc string epg-prompt-alist))
+        (string (read-string (if entry (cdr entry) (concat string ": ")))))
+    (process-send-string process (concat string "\n")))))
+

 (defun epg-status-GOODSIG (process string)
   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
       (epg-context-set-result-for
 (defun epg-status-GOODSIG (process string)
   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
       (epg-context-set-result-for

@@ -377,11 +426,18 @@ This function is for internal use only."
                                 (match-string 2 string))
             (epg-context-result-for epg-context 'verify)))))
 
                                 (match-string 2 string))
             (epg-context-result-for epg-context 'verify)))))
 

+(defun epg-status-VALIDSIG (process string)
+  (let ((signature (car (epg-context-result-for epg-context 'verify))))
+    (if (and signature
+            (eq (epg-signature-status signature) 'good)
+            (string-match "\\`\\([^ ]+\\) " string))
+       (epg-signature-set-fingerprint signature (match-string 1 string)))))
+

 (defun epg-status-TRUST_UNDEFINED (process string)
 (defun epg-status-TRUST_UNDEFINED (process string)

-  (let ((signature (car (epg-context-result-for-for epg-context 'verify))))
+  (let ((signature (car (epg-context-result-for epg-context 'verify))))

     (if (and signature
             (eq (epg-signature-status signature) 'good))
     (if (and signature
             (eq (epg-signature-status signature) 'good))

-       (epg-signature-set-validity signature 'unknown))))
+       (epg-signature-set-validity signature 'undefined))))

 
 (defun epg-status-TRUST_NEVER (process string)
   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 
 (defun epg-status-TRUST_NEVER (process string)
   (let ((signature (car (epg-context-result-for epg-context 'verify))))

@@ -399,16 +455,13 @@ 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))
   (let ((signature (car (epg-context-result-for epg-context 'verify))))
     (if (and signature
             (eq (epg-signature-status signature) 'good))

-       (epg-signature-set-validity signature 'full))))
+       (epg-signature-set-validity signature 'fully))))

 
 (defun epg-status-TRUST_ULTIMATE (process string)
   (let ((signature (car (epg-context-result-for epg-context 'verify))))
     (if (and signature
             (eq (epg-signature-status signature) 'good))
 
 (defun epg-status-TRUST_ULTIMATE (process string)
   (let ((signature (car (epg-context-result-for epg-context 'verify))))
     (if (and signature
             (eq (epg-signature-status signature) 'good))

-       (epg-signature-set-validity signature 'full))))
-
-(defun epg-status-DECRYPTION_FAILED (process string)
-  (epg-context-set-result-for epg-context 'decrypt 'failed))
+       (epg-signature-set-validity signature 'ultimate))))

 
 (defun epg-status-PROGRESS (process string)
   (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
 
 (defun epg-status-PROGRESS (process string)
   (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"

@@ -420,17 +473,52 @@ This function is for internal use only."
               (string-to-number (match-string 4 string))
               (cdr (epg-context-progress-callback-info epg-context)))))
 
               (string-to-number (match-string 4 string))
               (cdr (epg-context-progress-callback-info epg-context)))))
 

+(defun epg-status-DECRYPTION_FAILED (process string)
+  (epg-context-set-result-for
+   epg-context 'error
+   (cons 'decryption-failed
+        (epg-context-result-for epg-context 'error))))
+
+(defun epg-status-NODATA (process string)
+  (epg-context-set-result-for
+   epg-context 'error
+   (cons (cons 'no-data (string-to-number string))
+        (epg-context-result-for epg-context 'error))))
+
+(defun epg-status-UNEXPECTED (process string)
+  (epg-context-set-result-for
+   epg-context 'error
+   (cons (cons 'unexpected (string-to-number string))
+        (epg-context-result-for epg-context 'error))))
+
+(defun epg-status-KEYEXPIRED (process string)
+  (epg-context-set-result-for
+   epg-context 'error
+   (cons (cons 'key-expired string)
+        (epg-context-result-for epg-context 'error))))
+
+(defun epg-status-KEYREVOKED (process string)
+  (epg-context-set-result-for
+   epg-context 'error
+   (cons 'key-revoked
+        (epg-context-result-for epg-context 'error))))
+
+(defun epg-status-BADARMOR (process string)
+  (epg-context-set-result-for
+   epg-context 'error
+   (cons 'bad-armor
+        (epg-context-result-for epg-context 'error))))
+

 (defun epg-passphrase-callback-function (key-id handback)
   (read-passwd
    (if (eq key-id 'SYM)
        "Passphrase for symmetric encryption: "
      (if (eq key-id 'PIN)
         "Passphrase for PIN: "
 (defun epg-passphrase-callback-function (key-id handback)
   (read-passwd
    (if (eq key-id 'SYM)
        "Passphrase for symmetric encryption: "
      (if (eq key-id 'PIN)
         "Passphrase for PIN: "

-       (format "Passphrase for %s: "
-              (let ((entry (assoc key-id epg-user-id-alist)))
-                (if entry
-                    (cdr entry)
-                  key-id)))))))
+       (let ((entry (assoc key-id epg-user-id-alist)))
+        (if entry
+            (format "Passphrase for %s %s: " key-id (cdr entry))
+          (format "Passphrase for %s: " key-id)))))))

 
 (defun epg-progress-callback-function (what char current total handback)
   (message "%s: %d%%/%d%%" what current total))
 
 (defun epg-progress-callback-function (what char current total handback)
   (message "%s: %d%%/%d%%" what current total))

@@ -488,10 +576,57 @@ This function is for internal use only."
       (setq alist (cdr alist)))
     (nreverse result)))
 
       (setq alist (cdr alist)))
     (nreverse result)))
 

-(defalias 'epg-make-temp-file 'make-temp-file)
+(if (fboundp 'make-temp-file)
+    (defalias 'epg-make-temp-file 'make-temp-file)
+  ;; stolen from poe.el.
+  (defun epg-make-temp-file (prefix)
+    "Create a temporary file.
+The returned file name (created by appending some random characters at the end
+of PREFIX, and expanding against `temporary-file-directory' if necessary),
+is guaranteed to point to a newly created empty file.
+You can then use `write-region' to write new data into the file."
+    (let (tempdir tempfile)
+      (unwind-protect
+         (let (file)
+           ;; First, create a temporary directory.
+           (while (condition-case ()
+                      (progn
+                        (setq tempdir (make-temp-name
+                                       (concat
+                                        (file-name-directory prefix)
+                                        "DIR")))
+                        ;; return nil or signal an error.
+                        (make-directory tempdir))
+                    ;; let's try again.
+                    (file-already-exists t)))
+           (set-file-modes tempdir 448)
+           ;; Second, create a temporary file in the tempdir.
+           ;; There *is* a race condition between `make-temp-name'
+           ;; and `write-region', but we don't care it since we are
+           ;; in a private directory now.
+           (setq tempfile (make-temp-name (concat tempdir "/EMU")))
+           (write-region "" nil tempfile nil 'silent)
+           (set-file-modes tempfile 384)
+           ;; Finally, make a hard-link from the tempfile.
+           (while (condition-case ()
+                      (progn
+                        (setq file (make-temp-name prefix))
+                        ;; return nil or signal an error.
+                        (add-name-to-file tempfile file))
+                    ;; let's try again.
+                    (file-already-exists t)))
+           file)
+       ;; Cleanup the tempfile.
+       (and tempfile
+            (file-exists-p tempfile)
+            (delete-file tempfile))
+       ;; Cleanup the tempdir.
+       (and tempdir
+            (file-directory-p tempdir)
+            (delete-directory tempdir))))))

 
 ;;;###autoload
 
 ;;;###autoload

-(defun epg-decrypt-start (context input-file)
+(defun epg-start-decrypt (context input-file)

   "Initiate a decrypt operation on INPUT-FILE.
 
 If you use this function, you will need to wait for the completion of
   "Initiate a decrypt operation on INPUT-FILE.
 
 If you use this function, you will need to wait for the completion of

@@ -499,6 +634,7 @@ If you use this function, you will need to wait for the completion of
 `epg-reset' to clear a temporaly output file.
 If you are unsure, use synchronous version of this function
 `epg-decrypt-string' instead."
 `epg-reset' to clear a temporaly output file.
 If you are unsure, use synchronous version of this function
 `epg-decrypt-string' instead."

+  (epg-context-set-result context nil)

   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
   (epg-start context
             (list "--decrypt" input-file))
   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
   (epg-start context
             (list "--decrypt" input-file))

@@ -509,13 +645,12 @@ If you are unsure, use synchronous version of this function
   "Decrypt INPUT-FILE and return the plain text."
   (unwind-protect
       (progn
   "Decrypt INPUT-FILE and return the plain text."
   (unwind-protect
       (progn

-       (epg-decrypt-start context input-file)
+       (epg-start-decrypt context input-file)

        (epg-wait-for-completion context)
        (epg-wait-for-completion context)

-       (unless (epg-context-result-for context 'decrypt)
-         (epg-read-output context)))
-    (epg-reset context)
-    (if (file-exists-p input-file)
-       (delete-file input-file))))
+       (if (epg-context-result-for context 'error)
+           (error "Decryption failed"))
+       (epg-read-output context))
+    (epg-reset context)))

 
 ;;;###autoload
 (defun epg-decrypt-string (context string)
 
 ;;;###autoload
 (defun epg-decrypt-string (context string)

@@ -530,7 +665,7 @@ If you are unsure, use synchronous version of this function
          (delete-file input-file)))))
 
 ;;;###autoload
          (delete-file input-file)))))
 
 ;;;###autoload

-(defun epg-verify-start (context signature &optional string)
+(defun epg-start-verify (context signature &optional string)

   "Initiate a verify operation on SIGNATURE.
 
 For a detached signature, both SIGNATURE and STRING should be string.
   "Initiate a verify operation on SIGNATURE.
 
 For a detached signature, both SIGNATURE and STRING should be string.

@@ -541,6 +676,7 @@ If you use this function, you will need to wait for the completion of
 `epg-reset' to clear a temporaly output file.
 If you are unsure, use synchronous version of this function
 `epg-verify-string' instead."
 `epg-reset' to clear a temporaly output file.
 If you are unsure, use synchronous version of this function
 `epg-verify-string' instead."

+  (epg-context-set-result context nil)

   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
   (if string
       ;; Detached signature.
   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
   (if string
       ;; Detached signature.

@@ -556,6 +692,19 @@ If you are unsure, use synchronous version of this function
        (process-send-string (epg-context-process context) signature))))
 
 ;;;###autoload
        (process-send-string (epg-context-process context) signature))))
 
 ;;;###autoload

+(defun epg-verify-file (context input-file &optional string)
+  "Verify INPUT-FILE.
+
+For a detached signature, both INPUT-FILE and STRING should be string.
+For a normal or a clear text signature, STRING should be nil."
+  (unwind-protect
+      (progn
+       (epg-start-verify context input-file string)
+       (epg-wait-for-completion context)
+       (epg-context-result-for context 'verify))
+    (epg-reset context)))
+
+;;;###autoload

 (defun epg-verify-string (context signature &optional string)
   "Verify SIGNATURE.
 
 (defun epg-verify-string (context signature &optional string)
   "Verify SIGNATURE.
 

@@ -567,15 +716,12 @@ For a normal or a clear text signature, STRING should be nil."
        (progn
          (if string
              (write-region signature nil input-file))
        (progn
          (if string
              (write-region signature nil input-file))

-         (epg-verify-start context input-file string)
-         (epg-wait-for-completion context)
-         (epg-context-result-for context 'verify))
-      (epg-reset context)
+         (epg-verify-file context input-file string))

       (if (file-exists-p input-file)
          (delete-file input-file)))))
 
 ;;;###autoload
       (if (file-exists-p input-file)
          (delete-file input-file)))))
 
 ;;;###autoload

-(defun epg-sign-start (context string &optional mode)
+(defun epg-start-sign (context string &optional mode)

   "Initiate a sign operation on STRING.
 
 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
   "Initiate a sign operation on STRING.
 
 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.

@@ -587,9 +733,10 @@ If you use this function, you will need to wait for the completion of
 `epg-reset' to clear a temporaly output file.
 If you are unsure, use synchronous version of this function
 `epg-sign-string' instead."
 `epg-reset' to clear a temporaly output file.
 If you are unsure, use synchronous version of this function
 `epg-sign-string' instead."

+  (epg-context-set-result context nil)

   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
   (epg-start context
   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
   (epg-start context

-            (append (list (if (eq 'clearsign)
+            (append (list (if (eq mode 'clearsign)

                               "--clearsign"
                             (if (or (eq mode t) (eq mode 'detached))
                                 "--detach-sign"
                               "--clearsign"
                             (if (or (eq mode t) (eq mode 'detached))
                                 "--detach-sign"

@@ -610,15 +757,17 @@ If MODE is t or 'detached, it makes a detached signature.
 Otherwise, it makes a normal signature."
   (unwind-protect
       (progn
 Otherwise, it makes a normal signature."
   (unwind-protect
       (progn

-       (epg-sign-start context string mode)
+       (epg-start-sign context string mode)

        (epg-wait-for-completion context)
        (epg-wait-for-completion context)

+       (if (epg-context-result-for context 'error)
+           (error "Sign failed"))

        (epg-read-output context))
     (epg-reset context)))
 
 ;;;###autoload
        (epg-read-output context))
     (epg-reset context)))
 
 ;;;###autoload

-(defun epg-encrypt-start (context string recipients
+(defun epg-start-encrypt (context string recipients

                                  &optional sign always-trust)
                                  &optional sign always-trust)

-  "Initiate a encrypt operation on STRING.
+  "Initiate an encrypt operation on STRING.

 If RECIPIENTS is nil, it performs symmetric encryption.
 
 If you use this function, you will need to wait for the completion of
 If RECIPIENTS is nil, it performs symmetric encryption.
 
 If you use this function, you will need to wait for the completion of

@@ -626,6 +775,7 @@ If you use this function, you will need to wait for the completion of
 `epg-reset' to clear a temporaly output file.
 If you are unsure, use synchronous version of this function
 `epg-encrypt-string' instead."
 `epg-reset' to clear a temporaly output file.
 If you are unsure, use synchronous version of this function
 `epg-encrypt-string' instead."

+  (epg-context-set-result context nil)

   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
   (epg-start context
             (append (if always-trust '("--always-trust"))
   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
   (epg-start context
             (append (if always-trust '("--always-trust"))

@@ -654,8 +804,62 @@ If you are unsure, use synchronous version of this function
 If RECIPIENTS is nil, it performs symmetric encryption."
   (unwind-protect
       (progn
 If RECIPIENTS is nil, it performs symmetric encryption."
   (unwind-protect
       (progn

-       (epg-encrypt-start context string recipients sign always-trust)
+       (epg-start-encrypt context string recipients sign always-trust)
+       (epg-wait-for-completion context)
+       (if (epg-context-result-for context 'error)
+           (error "Encrypt failed"))
+       (epg-read-output context))
+    (epg-reset context)))
+
+;;;###autoload
+(defun epg-start-export-keys (context pattern)
+  "Initiate an export keys operation.
+
+If you use this function, you will need to wait for the completion of
+`epg-gpg-program' by using `epg-wait-for-completion' and call
+`epg-reset' to clear a temporaly output file.
+If you are unsure, use synchronous version of this function
+`epg-export-keys' instead."
+  (epg-context-set-result context nil)
+  (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
+  (epg-start context (list "--export" pattern)))
+
+;;;###autoload
+(defun epg-export-keys (context pattern)
+  "Extract public keys matched with PATTERN and return them."
+  (unwind-protect
+      (progn
+       (epg-start-export-keys context pattern)
+       (epg-wait-for-completion context)
+       (if (epg-context-result-for context 'error)
+           (error "Export keys failed"))
+       (epg-read-output context))
+    (epg-reset context)))
+
+;;;###autoload
+(defun epg-start-import-keys (context keys)
+  "Initiate an import key operation.
+
+If you use this function, you will need to wait for the completion of
+`epg-gpg-program' by using `epg-wait-for-completion' and call
+`epg-reset' to clear a temporaly output file.
+If you are unsure, use synchronous version of this function
+`epg-import-keys' instead."
+  (epg-context-set-result context nil)
+  (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
+  (epg-start context (list "--import"))
+  (if (eq (process-status (epg-context-process context)) 'run)
+      (process-send-string (epg-context-process context) keys)))
+
+;;;###autoload
+(defun epg-import-keys (context keys)
+  "Add KEYS."
+  (unwind-protect
+      (progn
+       (epg-start-import-keys context keys)

        (epg-wait-for-completion context)
        (epg-wait-for-completion context)

+       (if (epg-context-result-for context 'error)
+           (error "Import keys failed"))

        (epg-read-output context))
     (epg-reset context)))
 
        (epg-read-output context))
     (epg-reset context)))