Merged epgsm.

diff --git a/ChangeLog b/ChangeLog
index 1baf960..bdccb6e 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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