X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=3ba189ff49cecead62558434214b246b13868f3c;hb=5944a44f16964313efa58244a1ad0e62f32237fb;hp=abd5d85e5b2b585a106b0698cf8f9970747dc3d1;hpb=4ead1528d539f9ef8c39238cf20e7e51e08f7503;p=elisp%2Fepg.git

diff --git a/epg.el b/epg.el
index abd5d85..3ba189f 100644
--- a/epg.el
+++ b/epg.el
@@ -33,6 +33,8 @@
   :group 'epg
   :type 'string)
 
+(defconst epg-version-number "0.0.0")
+
 (defvar epg-user-id nil
   "GnuPG ID of your default identity.")
 
@@ -44,6 +46,7 @@
 (defvar epg-key-id nil)
 (defvar epg-context nil)
 (defvar epg-debug nil)
+(defvar epg-debug-buffer nil)
 
 ;; from gnupg/include/cipher.h
 (defconst epg-cipher-algorithm-alist
@@ -96,6 +99,11 @@
     (9 . "Not a secret key")
     (10 . "Key not trusted")))
 
+(defconst epg-delete-problem-alist
+  '((1 . "No such key")
+    (2 . "Must delete secret key first")
+    (3 . "Ambigious specification")))
+
 (defvar epg-key-validity-alist
   '((?o . unknown)
     (?i . invalid)
@@ -107,8 +115,7 @@
     (?n . never)
     (?m . marginal)
     (?f . full)
-    (?u . ultimate)
-    (?  . empty)))
+    (?u . ultimate)))
 
 (defvar epg-key-capablity-alist
   '((?e . encrypt)
@@ -399,6 +406,19 @@ This function is for internal use only."
 	(setcdr entry value)
       (epg-context-set-result context (cons (cons name value) result)))))
 
+(defun epg-signature-to-string (signature)
+  (format "%s signature from %s %s%s"
+	  (capitalize (symbol-name (epg-signature-status signature)))
+	  (epg-signature-key-id signature)
+	  (epg-signature-user-id signature)
+	  (if (epg-signature-validity signature)
+	      (format " (trust %s)"
+		      (epg-signature-validity signature))
+	    "")))
+
+(defun epg-verify-result-to-string (verify-result)
+  (mapconcat #'epg-signature-to-string verify-result "\n"))
+
 (defun epg-start (context args)
   "Start `epg-gpg-program' in a subprocess with given ARGS."
   (let* ((args (append (list "--no-tty"
@@ -415,6 +435,14 @@ This function is for internal use only."
 	 (orig-mode (default-file-modes))
 	 (buffer (generate-new-buffer " *epg*"))
 	 process)
+    (if epg-debug
+	(save-excursion
+	  (unless epg-debug-buffer
+	    (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
+	  (set-buffer epg-debug-buffer)
+	  (goto-char (point-max))
+	  (insert (format "%s %s\n" epg-gpg-program
+			  (mapconcat #'identity args " ")))))
     (with-current-buffer buffer
       (make-local-variable 'epg-read-point)
       (setq epg-read-point (point-min))
@@ -436,7 +464,9 @@ This function is for internal use only."
 (defun epg-process-filter (process input)
   (if epg-debug
       (save-excursion
-	(set-buffer (get-buffer-create  " *epg-debug*"))
+	(unless epg-debug-buffer
+	  (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
+	(set-buffer epg-debug-buffer)
 	(goto-char (point-max))
 	(insert input)))
   (if (buffer-live-p (process-buffer process))
@@ -446,7 +476,7 @@ This function is for internal use only."
 	(insert input)
 	(goto-char epg-read-point)
 	(beginning-of-line)
-	(while (looking-at ".*\n")	;the input line is finished
+	(while (looking-at ".*\n")	;the input line finished
 	  (save-excursion
 	    (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
 		(let* ((status (match-string 1))
@@ -479,13 +509,15 @@ This function is for internal use only."
       (accept-process-output (epg-context-process context) 1))))
 
 (defun epg-wait-for-completion (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.
     (sit-for 0.1)))
 
+(defun epg-flush (context)
+  (if (eq (process-status (epg-context-process context)) 'run)
+      (process-send-eof (epg-context-process context))))
+
 (defun epg-reset (context)
   (if (and (epg-context-process context)
 	   (buffer-live-p (process-buffer (epg-context-process context))))
@@ -518,23 +550,26 @@ This function is for internal use only."
   (setq epg-key-id 'PIN))
 
 (defun epg-status-GET_HIDDEN (process string)
-  (let ((passphrase
-	 (funcall (if (consp (epg-context-passphrase-callback epg-context))
-		      (car (epg-context-passphrase-callback epg-context))
-		    (epg-context-passphrase-callback epg-context))
-		  epg-key-id
-		  (if (consp (epg-context-passphrase-callback epg-context))
-		      (cdr (epg-context-passphrase-callback epg-context)))))
-	string)
-    (if passphrase
-	(unwind-protect
-	    (progn
-	      (setq string (concat passphrase "\n"))
-	      (fillarray passphrase 0)
-	      (setq passphrase nil)
-	      (process-send-string process string))
-	  (if string
-	      (fillarray string 0))))))
+  (if (and epg-key-id
+	   (string-match "\\`passphrase\\." string))
+    (let ((passphrase
+	   (funcall
+	    (if (consp (epg-context-passphrase-callback epg-context))
+		(car (epg-context-passphrase-callback epg-context))
+	      (epg-context-passphrase-callback epg-context))
+	    epg-key-id
+	    (if (consp (epg-context-passphrase-callback epg-context))
+		(cdr (epg-context-passphrase-callback epg-context)))))
+	  string)
+      (if passphrase
+	  (unwind-protect
+	      (progn
+		(setq string (concat passphrase "\n"))
+		(fillarray passphrase 0)
+		(setq passphrase nil)
+		(process-send-string process string))
+	    (if string
+		(fillarray string 0)))))))
 
 (defun epg-status-GET_BOOL (process string)
   (let ((entry (assoc string epg-prompt-alist)))
@@ -698,6 +733,28 @@ This function is for internal use only."
    (cons 'no-recipients
 	 (epg-context-result-for epg-context 'error))))
 
+(defun epg-status-DELETE_PROBLEM (process string)
+  (if (string-match "\\`\\([0-9]+\\)" string)
+      (epg-context-set-result-for
+       epg-context 'error
+       (cons (cons 'delete-problem (string-to-number (match-string 1 string)))
+	     (epg-context-result-for epg-context 'error)))))
+
+(defun epg-status-SIG_CREATED (process string)
+  (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
+\\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
+      (epg-context-set-result-for
+       epg-context 'sign
+       (cons (list (cons 'type (string-to-char (match-string 1 string)))
+		   (cons 'pubkey-algorithm
+			 (string-to-number (match-string 2 string)))
+		   (cons 'digest-algorithm
+			 (string-to-number (match-string 3 string)))
+		   (cons 'class (string-to-number (match-string 4 string) 16))
+		   (cons 'creation-time (match-string 5 string))
+		   (cons 'fingerprint (substring string (match-end 0))))
+	     (epg-context-result-for epg-context 'sign)))))
+
 (defun epg-passphrase-callback-function (key-id handback)
   (read-passwd
    (if (eq key-id 'SYM)
@@ -757,8 +814,7 @@ This function is for internal use only."
 (defun epg-make-sub-key-1 (line)
   (epg-make-sub-key
    (if (aref line 1)
-       (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist))
-     'empty)
+       (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)))
@@ -785,8 +841,7 @@ This function is for internal use only."
 	(setq keys (cons (epg-make-key
 			  (if (aref (car lines) 8)
 			      (cdr (assq (string-to-char (aref (car lines) 8))
-					 epg-key-validity-alist))
-			    'empty))
+					 epg-key-validity-alist))))
 			 keys))
 	(epg-key-set-sub-key-list
 	 (car keys)
@@ -803,8 +858,7 @@ This function is for internal use only."
 	 (cons (epg-make-user-id
 		(if (aref (car lines) 1)
 		    (cdr (assq (string-to-char (aref (car lines) 1))
-			       epg-key-validity-alist))
-		  'empty)
+			       epg-key-validity-alist)))
 		(aref (car lines) 9))
 	       (epg-key-user-id-list (car keys)))))
        ((equal (aref (car lines) 0) "fpr")
@@ -910,6 +964,7 @@ If PLAIN is nil, it returns the result as a string."
 	  (epg-context-set-output-file context
 				       (epg-make-temp-file "epg-output"))
 	  (epg-start-decrypt context (epg-make-data-from-file input-file))
+	  (epg-flush context)
 	  (epg-wait-for-completion context)
 	  (if (epg-context-result-for context 'error)
 	      (error "Decrypt failed: %S"
@@ -998,6 +1053,7 @@ For a normal or a clear text signature, SIGNED-TEXT should be nil."
 				  (epg-make-data-from-file input-file)
 				  (epg-make-data-from-string signed-text)))
 	    (epg-start-verify context (epg-make-data-from-string signature)))
+	  (epg-flush context)
 	  (epg-wait-for-completion context)
 	  (epg-read-output context))
       (epg-delete-output-file context)
@@ -1028,9 +1084,12 @@ If you are unsure, use synchronous version of this function
 				 "--detach-sign"
 			       "--sign")))
 		     (apply #'nconc
-			    (mapcar (lambda (signer)
-				      (list "-u" signer))
-				    (epg-context-signers context)))
+			    (mapcar
+			     (lambda (signer)
+			       (list "-u"
+				     (epg-sub-key-id
+				      (car (epg-key-sub-key-list signer)))))
+			     (epg-context-signers context)))
 		     (if (epg-data-file plain)
 			 (list (epg-data-file plain)))))
   (epg-wait-for-status context '("BEGIN_SIGNING"))
@@ -1074,6 +1133,7 @@ Otherwise, it makes a normal signature."
 	(epg-context-set-output-file context
 				     (epg-make-temp-file "epg-output"))
 	(epg-start-sign context (epg-make-data-from-string plain) mode)
+	(epg-flush context)
 	(epg-wait-for-completion context)
 	(if (epg-context-result-for context 'error)
 	    (error "Sign failed: %S"
@@ -1105,15 +1165,17 @@ If you are unsure, use synchronous version of this function
 						(list "-u" signer))
 					      (epg-context-signers context)))))
 		     (apply #'nconc
-			    (mapcar (lambda (recipient)
-				      (list "-r" recipient))
-				    recipients))
+			    (mapcar
+			     (lambda (recipient)
+			       (list "-r"
+				     (epg-sub-key-id
+				      (car (epg-key-sub-key-list recipient)))))
+			     recipients))
 		     (if (epg-data-file plain)
 			 (list (epg-data-file plain)))))
   (if sign
       (epg-wait-for-status context '("BEGIN_SIGNING"))
-    (if (null recipients)
-	(epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
+    (epg-wait-for-status context '("BEGIN_ENCRYPTION")))
   (if (and (epg-data-string plain)
 	   (eq (process-status (epg-context-process context)) 'run))
       (process-send-string (epg-context-process context)
@@ -1154,6 +1216,7 @@ If RECIPIENTS is nil, it performs symmetric encryption."
 				     (epg-make-temp-file "epg-output"))
 	(epg-start-encrypt context (epg-make-data-from-string plain)
 			   recipients sign always-trust)
+	(epg-flush context)
 	(epg-wait-for-completion context)
 	(if (epg-context-result-for context 'error)
 	    (error "Encrypt failed: %S"
@@ -1163,31 +1226,47 @@ If RECIPIENTS is nil, it performs symmetric encryption."
     (epg-reset context)))
 
 ;;;###autoload
-(defun epg-start-export-keys (context pattern)
+(defun epg-start-export-keys (context keys)
   "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-export-keys-to-file' or `epg-export-keys-to-string' 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)))
+  (epg-start context (cons "--export"
+			   (mapcar
+			    (lambda (key)
+			      (epg-sub-key-id
+			       (car (epg-key-sub-key-list key))))
+			    keys))))
 
 ;;;###autoload
-(defun epg-export-keys (context pattern)
-  "Extract public keys matched with PATTERN and return them."
+(defun epg-export-keys-to-file (context keys file)
+  "Extract public KEYS."
   (unwind-protect
       (progn
-	(epg-start-export-keys context pattern)
+	(if keys
+	    (epg-context-set-output-file context file)
+	  (epg-context-set-output-file context
+				       (epg-make-temp-file "epg-output")))
+	(epg-start-export-keys context keys)
 	(epg-wait-for-completion context)
 	(if (epg-context-result-for context 'error)
 	    (error "Export keys failed"))
-	(epg-read-output context))
+	(unless file
+	  (epg-read-output context)))
+    (unless file
+      (epg-delete-output-file context))
     (epg-reset context)))
 
 ;;;###autoload
+(defun epg-export-keys-to-string (context keys)
+  "Extract public KEYS and return them as a string."
+  (epg-export-keys-to-file context keys nil))
+
+;;;###autoload
 (defun epg-start-import-keys (context keys)
   "Initiate an import keys operation.
 KEYS is a data object.
@@ -1199,7 +1278,7 @@ If you are unsure, use synchronous version of this function
 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
   (epg-context-set-result context nil)
   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
-  (epg-start context (append (list "--import") (epg-data-file keys)))
+  (epg-start context (list "--import" (epg-data-file keys)))
   (if (and (epg-data-string keys)
 	   (eq (process-status (epg-context-process context)) 'run))
       (process-send-string (epg-context-process context)
@@ -1209,6 +1288,8 @@ If you are unsure, use synchronous version of this function
   (unwind-protect
       (progn
 	(epg-start-import-keys context keys)
+	(if (epg-data-file keys)
+	    (epg-flush context))
 	(epg-wait-for-completion context)
 	(if (epg-context-result-for context 'error)
 	    (error "Import keys failed"))
@@ -1225,6 +1306,36 @@ If you are unsure, use synchronous version of this function
   "Add keys from a string KEYS."
   (epg-import-keys-1 context (epg-make-data-from-string keys)))
 
+;;;###autoload
+(defun epg-start-delete-keys (context keys &optional allow-secret)
+  "Initiate an delete 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-delete-keys' instead."
+  (epg-context-set-result context nil)
+  (epg-start context (cons (if allow-secret
+			       "--delete-secret-key"
+			     "--delete-key")
+			   (mapcar
+			    (lambda (key)
+			      (epg-sub-key-id
+			       (car (epg-key-sub-key-list key))))
+			    keys))))
+
+;;;###autoload
+(defun epg-delete-keys (context keys &optional allow-secret)
+  "Delete KEYS from the key ring."
+  (unwind-protect
+      (progn
+	(epg-start-delete-keys context keys)
+	(epg-wait-for-completion context)
+	(if (epg-context-result-for context 'error)
+	    (error "Delete key failed")))
+    (epg-reset context)))
+
 (provide 'epg)
 
 ;;; epg.el ends here