From f60e21560324db2d229d2297ae79ec39b8d818b3 Mon Sep 17 00:00:00 2001 From: ueno Date: Sun, 23 Apr 2006 01:10:13 +0000 Subject: [PATCH] Merged epgsm. --- ChangeLog | 13 ++++ epa-dired.el | 2 +- epa-file.el | 3 +- epa.el | 36 ++++++---- epg.el | 218 +++++++++++++++++++++++++++++++++++++++++++++++++--------- 5 files changed, 224 insertions(+), 48 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1baf960..bdccb6e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2006-04-22 Daiki Ueno + + * 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 * 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 -- 1.7.10.4