From: ueno <ueno>
Date: Sun, 23 Apr 2006 01:10:13 +0000 (+0000)
Subject: Merged epgsm.
X-Git-Tag: epg-0_0_1~32
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f60e21560324db2d229d2297ae79ec39b8d818b3;p=elisp%2Fepg.git

Merged epgsm.
---

diff --git a/ChangeLog b/ChangeLog
index 1baf960..bdccb6e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2006-04-22  Daiki Ueno  <ueno@unixuser.org>
+
+	* epa.el (epa-key-widget-value-create): Decode DN.
+	(epa-list-keys): Add the PROTOCOL argument.
+	(epa-select-keys): Require CONTEXT as the first argument.
+
+	* epg.el (epg-gpgsm-program): New user option.
+	(epg-dn-type-alist): New variable.
+	(epg-start): Don't specify --command-fd if protocol is CMS.
+	(epg-list-keys): Require CONTEXT as the first argument.
+	(epg-dn-from-string): New function.
+	(epg-decode-dn): New function.
+
 2006-04-21  Daiki Ueno  <ueno@unixuser.org>
 
 	* epa.el (epa-sign-keys): New command.
diff --git a/epa-dired.el b/epa-dired.el
index 06d382c..ddb5805 100644
--- a/epa-dired.el
+++ b/epa-dired.el
@@ -73,7 +73,7 @@
     (while file-list
       (epa-encrypt-file
        (expand-file-name (car file-list))
-       (epa-select-keys "Select recipents for encryption.
+       (epa-select-keys (epg-make-context) "Select recipents for encryption.
 If no one is selected, symmetric encryption will be performed.  "))
       (setq file-list (cdr file-list)))
     (revert-buffer)))
diff --git a/epa-file.el b/epa-file.el
index d4c9fb2..435976c 100644
--- a/epa-file.el
+++ b/epa-file.el
@@ -137,7 +137,8 @@
 				       coding-system))
 	       (unless (assoc file epa-file-passphrase-alist)
 			 (epa-select-keys
-		    "Select recipents for encryption.
+			  context
+			  "Select recipents for encryption.
 If no one is selected, symmetric encryption will be performed.  "))))
       (error
        (if (setq entry (assoc file epa-file-passphrase-alist))
diff --git a/epa.el b/epa.el
index 579fcf9..cdd14fb 100644
--- a/epa.el
+++ b/epa.el
@@ -189,7 +189,9 @@
 		      ? ))
 	    (epg-sub-key-id primary-sub-key)
 	    " "
-	    (epg-user-id-name primary-user-id))))
+	    (if (stringp (epg-user-id-name primary-user-id))
+		(epg-user-id-name primary-user-id)
+	      (epg-decode-dn (epg-user-id-name primary-user-id))))))
 
 (defun epa-key-widget-button-face-get (widget)
   (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
@@ -244,22 +246,26 @@
   (run-hooks 'epa-key-mode-hook))
 
 ;;;###autoload
-(defun epa-list-keys (&optional name mode)
+(defun epa-list-keys (&optional name mode protocol)
   (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? ")))
-     (or epa-list-keys-arguments (list nil nil))))
+	       (y-or-n-p "Secret keys? ")
+	       (intern (completing-read "Protocol? "
+					'(("OpenPGP") ("CMS"))
+					nil t))))
+     (or epa-list-keys-arguments (list nil nil nil))))
   (unless (and epa-keys-buffer
 	       (buffer-live-p epa-keys-buffer))
     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
   (set-buffer epa-keys-buffer)
   (let ((inhibit-read-only t)
 	buffer-read-only
-	(point (point-min)))
+	(point (point-min))
+	(context (epg-make-context protocol)))
     (unless (get-text-property point 'epa-list-keys)
       (setq point (next-single-property-change point 'epa-list-keys)))
     (when point
@@ -267,19 +273,19 @@
 		     (or (next-single-property-change point 'epa-list-keys)
 			 (point-max)))
       (goto-char point))
-    (epa-list-keys-1 name mode)
+    (epa-list-keys-1 context name mode)
     (epa-keys-mode))
   (make-local-variable 'epa-list-keys-arguments)
-  (setq epa-list-keys-arguments (list name mode))
+  (setq epa-list-keys-arguments (list name mode protocol))
   (goto-char (point-min))
   (pop-to-buffer (current-buffer)))
 
-(defun epa-list-keys-1 (name mode)
+(defun epa-list-keys-1 (context name mode)
   (save-restriction
     (narrow-to-region (point) (point))
     (let ((inhibit-read-only t)
 	  buffer-read-only
-	  (keys (epg-list-keys name mode))
+	  (keys (epg-list-keys context name mode))
 	  point)
       (while keys
 	(setq point (point))
@@ -306,7 +312,7 @@
 	  (if key
 	      (list key))))))
 
-(defun epa-select-keys (prompt &optional names mode)
+(defun epa-select-keys (context prompt &optional names mode)
   (save-excursion
     (unless (and epa-keys-buffer
 		 (buffer-live-p epa-keys-buffer))
@@ -333,12 +339,12 @@
       (if names
 	  (while names
 	    (setq point (point))
-	    (epa-list-keys-1 (car names) mode)
+	    (epa-list-keys-1 context (car names) mode)
 	    (goto-char point)
 	    (epa-mark)
 	    (goto-char (point-max))
 	    (setq names (cdr names)))
-	(epa-list-keys-1 nil mode))
+	(epa-list-keys-1 context nil mode))
       (epa-keys-mode)
       (setq epa-exit-buffer-function #'abort-recursive-edit)
       (goto-char (point-min))
@@ -378,7 +384,9 @@
 			       epg-key-validity-alist)))
 		" ")
 	      " "
-	      (epg-user-id-name (car pointer))
+	      (if (stringp (epg-user-id-name (car pointer)))
+		  (epg-user-id-name (car pointer))
+		(epg-decode-dn (epg-user-id-name (car pointer))))
 	      "\n")
       (setq pointer (cdr pointer)))
     (setq pointer (epg-key-sub-key-list key))
@@ -480,7 +488,7 @@
 (defun epa-encrypt-file (file recipients)
   (interactive
    (list (expand-file-name (read-file-name "File: "))
-	 (epa-select-keys "Select recipents for encryption.
+	 (epa-select-keys (epg-make-context) "Select recipents for encryption.
 If no one is selected, symmetric encryption will be performed.  ")))
   (let ((cipher (concat file ".gpg"))
 	(context (epg-make-context)))
diff --git a/epg.el b/epg.el
index 843e463..82de421 100644
--- a/epg.el
+++ b/epg.el
@@ -33,6 +33,11 @@
   :group 'epg
   :type 'string)
 
+(defcustom epg-gpgsm-program "gpgsm"
+  "The `gpgsm' executable."
+  :group 'epg
+  :type 'string)
+
 (defconst epg-version-number "0.0.0")
 
 (defvar epg-user-id nil
@@ -123,6 +128,19 @@
     (?c . certify)
     (?a . authentication)))
 
+(defvar epg-dn-type-alist
+  '(("1.2.840.113549.1.9.1" . "EMail")
+    ("2.5.4.12" . "T")
+    ("2.5.4.42" . "GN")
+    ("2.5.4.4" . "SN")
+    ("0.2.262.1.10.7.20" . "NameDistinguisher")
+    ("2.5.4.16" . "ADDR")
+    ("2.5.4.15" . "BC")
+    ("2.5.4.13" . "D")
+    ("2.5.4.17" . "PostalCode")
+    ("2.5.4.65" . "Pseudo")
+    ("2.5.4.5" . "SerialNumber")))
+
 (defvar epg-prompt-alist nil)
 
 (defun epg-make-data-from-file (file)
@@ -423,8 +441,9 @@ This function is for internal use only."
   "Start `epg-gpg-program' in a subprocess with given ARGS."
   (let* ((args (append (list "--no-tty"
 			     "--status-fd" "1"
-			     "--command-fd" "0"
 			     "--yes")
+		       (unless (eq (epg-context-protocol context) 'CMS)
+			 (list "--command-fd" "0"))
 		       (if (epg-context-armor context) '("--armor"))
 		       (if (epg-context-textmode context) '("--textmode"))
 		       (if (epg-context-output-file context)
@@ -441,7 +460,10 @@ This function is for internal use only."
 	    (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
+	  (insert (format "%s %s\n"
+			  (if (eq (epg-context-protocol context) 'CMS)
+			      epg-gpgsm-program
+			   epg-gpg-program)
 			  (mapconcat #'identity args " ")))))
     (with-current-buffer buffer
       (make-local-variable 'epg-read-point)
@@ -456,7 +478,11 @@ This function is for internal use only."
 	(progn
 	  (set-default-file-modes 448)
 	  (setq process
-		(apply #'start-process "epg" buffer epg-gpg-program args)))
+		(apply #'start-process "epg" buffer
+		       (if (eq (epg-context-protocol context) 'CMS)
+			   epg-gpgsm-program
+			 epg-gpg-program)
+		       args)))
       (set-default-file-modes orig-mode))
     (set-process-filter process #'epg-process-filter)
     (epg-context-set-process context process)))
@@ -620,9 +646,14 @@ This function is for internal use only."
       (epg-context-set-result-for
        epg-context
        'verify
-       (cons (epg-make-signature 'good
-				 (match-string 1 string)
-				 (match-string 2 string))
+       (cons (epg-make-signature
+	      'good
+	      (match-string 1 string)
+	      (if (eq (epg-context-protocol epg-context) 'CMS)
+		  (condition-case nil
+		      (epg-dn-from-string (match-string 2 string))
+		    (error (match-string 2 string)))
+		(match-string 2 string)))
 	     (epg-context-result-for epg-context 'verify)))))
 
 (defun epg-status-EXPSIG (process string)
@@ -630,9 +661,14 @@ This function is for internal use only."
       (epg-context-set-result-for
        epg-context
        'verify
-       (cons (epg-make-signature 'expired
-				 (match-string 1 string)
-				 (match-string 2 string))
+       (cons (epg-make-signature
+	      'expired
+	      (match-string 1 string)
+	      (if (eq (epg-context-protocol epg-context) 'CMS)
+		  (condition-case nil
+		      (epg-dn-from-string (match-string 2 string))
+		    (error (match-string 2 string)))
+		(match-string 2 string)))
 	     (epg-context-result-for epg-context 'verify)))))
 
 (defun epg-status-EXPKEYSIG (process string)
@@ -640,9 +676,14 @@ This function is for internal use only."
       (epg-context-set-result-for
        epg-context
        'verify
-       (cons (epg-make-signature 'expired-key
-				 (match-string 1 string)
-				 (match-string 2 string))
+       (cons (epg-make-signature
+	      'expired-key
+	      (match-string 1 string)
+	      (if (eq (epg-context-protocol epg-context) 'CMS)
+		  (condition-case nil
+		      (epg-dn-from-string (match-string 2 string))
+		    (error (match-string 2 string)))
+		(match-string 2 string)))
 	     (epg-context-result-for epg-context 'verify)))))
 
 (defun epg-status-REVKEYSIG (process string)
@@ -650,9 +691,14 @@ This function is for internal use only."
       (epg-context-set-result-for
        epg-context
        'verify
-       (cons (epg-make-signature 'revoked-key
-				 (match-string 1 string)
-				 (match-string 2 string))
+       (cons (epg-make-signature
+	      'revoked-key
+	      (match-string 1 string)
+	      (if (eq (epg-context-protocol epg-context) 'CMS)
+		  (condition-case nil
+		      (epg-dn-from-string (match-string 2 string))
+		    (error (match-string 2 string)))
+		(match-string 2 string)))
 	     (epg-context-result-for epg-context 'verify)))))
 
 (defun epg-status-BADSIG (process string)
@@ -660,9 +706,14 @@ This function is for internal use only."
       (epg-context-set-result-for
        epg-context
        'verify
-       (cons (epg-make-signature 'bad
-				 (match-string 1 string)
-				 (match-string 2 string))
+       (cons (epg-make-signature
+	      'bad
+	      (match-string 1 string)
+	      (if (eq (epg-context-protocol epg-context) 'CMS)
+		  (condition-case nil
+		      (epg-dn-from-string (match-string 2 string))
+		    (error (match-string 2 string)))
+		(match-string 2 string)))
 	     (epg-context-result-for epg-context 'verify)))))
 
 (defun epg-status-VALIDSIG (process string)
@@ -822,15 +873,21 @@ This function is for internal use only."
 			   config))))
     config))
 
-(defun epg-list-keys-1 (name mode)
+(defun epg-list-keys-1 (context name mode)
   (let ((args (append (list "--with-colons" "--no-greeting" "--batch"
-			    "--fixed-list-mode" "--with-fingerprint"
+			    "--with-fingerprint"
 			    "--with-fingerprint"
 			    (if mode "--list-secret-keys" "--list-keys"))
+		      (unless (eq (epg-context-protocol context) 'CMS)
+			'("--fixed-list-mode"))
 		      (if name (list name))))
 	keys string field index)
     (with-temp-buffer
-      (apply #'call-process epg-gpg-program nil (list t nil) nil args)
+      (apply #'call-process
+	     (if (eq (epg-context-protocol context) 'CMS)
+		 epg-gpgsm-program
+	       epg-gpg-program)
+	     nil (list t nil) nil args)
       (goto-char (point-min))
       (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
 	(setq keys (cons (make-vector 15 nil) keys)
@@ -858,12 +915,12 @@ This function is for internal use only."
    (aref line 5)
    (aref line 6)))
 
-(defun epg-list-keys (&optional name mode)
-  (let ((lines (epg-list-keys-1 name mode))
-	keys)
+(defun epg-list-keys (context &optional name mode)
+  (let ((lines (epg-list-keys-1 context name mode))
+	keys cert)
     (while lines
       (cond
-       ((member (aref (car lines) 0) '("pub" "sec"))
+       ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))
 	(when (car keys)
 	  (epg-key-set-sub-key-list
 	   (car keys)
@@ -871,7 +928,8 @@ This function is for internal use only."
 	  (epg-key-set-user-id-list
 	   (car keys)
 	   (nreverse (epg-key-user-id-list (car keys)))))
-	(setq keys (cons (epg-make-key
+	(setq cert (member (aref (car lines) 0) '("crt" "crs"))
+	      keys (cons (epg-make-key
 			  (if (aref (car lines) 8)
 			      (cdr (assq (string-to-char (aref (car lines) 8))
 					 epg-key-validity-alist))))
@@ -892,12 +950,23 @@ This function is for internal use only."
 		(if (aref (car lines) 1)
 		    (cdr (assq (string-to-char (aref (car lines) 1))
 			       epg-key-validity-alist)))
-		(aref (car lines) 9))
+		(if cert
+		    (condition-case nil
+			(epg-dn-from-string (aref (car lines) 9))
+		      (error (aref (car lines) 9)))
+		  (aref (car lines) 9)))
 	       (epg-key-user-id-list (car keys)))))
        ((equal (aref (car lines) 0) "fpr")
 	(epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
 				     (aref (car lines) 9))))
       (setq lines (cdr lines)))
+    (when (car keys)
+      (epg-key-set-sub-key-list
+       (car keys)
+       (nreverse (epg-key-sub-key-list (car keys))))
+      (epg-key-set-user-id-list
+       (car keys)
+       (nreverse (epg-key-user-id-list (car keys)))))
     (nreverse keys)))
 
 (if (fboundp 'make-temp-file)
@@ -963,7 +1032,9 @@ If you are unsure, use synchronous version of this function
     (error "Not a file"))
   (epg-context-set-result context nil)
   (epg-start context (list "--decrypt" (epg-data-file cipher)))
-  (epg-wait-for-status context '("BEGIN_DECRYPTION")))
+  ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
+  (unless (eq (epg-context-protocol context) 'CMS)
+    (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
 
 ;;;###autoload
 (defun epg-decrypt-file (context cipher plain)
@@ -1125,7 +1196,9 @@ If you are unsure, use synchronous version of this function
 			     (epg-context-signers context)))
 		     (if (epg-data-file plain)
 			 (list (epg-data-file plain)))))
-  (epg-wait-for-status context '("BEGIN_SIGNING"))
+  ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
+  (unless (eq (epg-context-protocol context) 'CMS)
+    (epg-wait-for-status context '("BEGIN_SIGNING")))
   (if (and (epg-data-string plain)
 	   (eq (process-status (epg-context-process context)) 'run))
       (process-send-string (epg-context-process context)
@@ -1206,9 +1279,11 @@ If you are unsure, use synchronous version of this function
 			     recipients))
 		     (if (epg-data-file plain)
 			 (list (epg-data-file plain)))))
-  (if sign
-      (epg-wait-for-status context '("BEGIN_SIGNING"))
-    (epg-wait-for-status context '("BEGIN_ENCRYPTION")))
+  ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
+  (unless (eq (epg-context-protocol context) 'CMS)
+    (if sign
+	(epg-wait-for-status context '("BEGIN_SIGNING"))
+      (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)
@@ -1403,6 +1478,85 @@ If you are unsure, use synchronous version of this function
 		   (epg-context-result-for context 'error))))
     (epg-reset context)))
 
+(defun epg-decode-hexstring (string)
+  (let ((index 0))
+    (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
+      (setq string (replace-match "\\x\\&" t nil string)
+	    index (+ index 4)))
+    (car (read-from-string (concat "\"" string "\"")))))
+
+(defun epg-decode-quotedstring (string)
+  (let ((index 0))
+    (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|x?\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)" string index)
+      (if (match-beginning 2)
+	  (setq string (replace-match "\\2" t nil string)
+		index (1+ index))
+	(setq string (replace-match "\\x\\3" t nil string)
+	      index (+ index 4))))
+    (car (read-from-string (concat "\"" string "\"")))))
+
+(defun epg-dn-from-string (string)
+  "Parse STRING as LADPv3 Distinguished Names (RFC2253).
+The return value is an alist mapping from types to values."
+  (let ((index 0)
+	(length (length string))
+	alist type value group)
+    (while (< index length)
+      (if (eq index (string-match "[ \t\n\r]*" string index))
+	  (setq index (match-end 0)))
+      (if (eq index (string-match
+		     "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
+		     string index))
+	  (setq type (match-string 1 string)
+		index (match-end 0))
+	(if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
+				    string index))
+	    (setq type (match-string 1 string)
+		  index (match-end 0))))
+      (unless type
+	(error "Invalid type"))
+      (if (eq index (string-match
+		     "\\([^,=+<>#;\\\"]\\|\
+\\\\[,=+<>#;\\\"]\\|\\\\x?[0-9A-Fa-f][0-9A-Fa-f]\\)+"
+		     string index))
+	  (setq index (match-end 0)
+		value (epg-decode-quotedstring (match-string 0 string)))
+	(if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
+	    (setq index (match-end 0)
+		  value (epg-decode-hexstring (match-string 1 string)))
+	  (if (eq index (string-match "\"\\([^\\\"]\\|\
+\\(\\\\[,=+<>#;\\\"]\\|\\\\x?[0-9A-Fa-f][0-9A-Fa-f]\\)\\)*\""
+				      string index))
+	      (setq index (match-end 0)
+		    value (epg-decode-quotedstring (match-string 0 string))))))
+      (if group
+	  (if (stringp (car (car alist)))
+	      (setcar alist (list (cons type value) (car alist)))
+	    (setcar alist (cons (cons type value) (car alist))))
+	(if (consp (car (car alist)))
+	    (setcar alist (nreverse (car alist))))
+	(setq alist (cons (cons type value) alist)
+	      type nil
+	      value nil))
+      (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
+	  (setq index (match-end 0)
+		group (eq (aref string (match-beginning 1)) ?+))))
+    (nreverse alist)))
+
+(defun epg-decode-dn (alist)
+  "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
+Type names are resolved using `epg-dn-type-alist'."
+  (mapconcat
+   (lambda (rdn)
+     (if (stringp (car rdn))
+	 (let ((entry (assoc (car rdn) epg-dn-type-alist)))
+	   (if entry
+	       (format "%s=%s" (cdr entry) (cdr rdn))
+	     (format "%s=%s" (car rdn) (cdr rdn))))
+       (concat "(" (epg-decode-dn rdn) ")")))
+   alist
+   ", "))
+
 (provide 'epg)
 
 ;;; epg.el ends here