X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=68c1041c7f793c1fe948a4fc58f6ba7546d036e0;hb=07b1adf51415fe37c4e2d801afbd2a655490ab8c;hp=abd5d85e5b2b585a106b0698cf8f9970747dc3d1;hpb=4ead1528d539f9ef8c39238cf20e7e51e08f7503;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index abd5d85..68c1041 100644 --- a/epg.el +++ b/epg.el @@ -33,6 +33,13 @@ :group 'epg :type 'string) +(defcustom epg-gpgsm-program "gpgsm" + "The `gpgsm' executable." + :group 'epg + :type 'string) + +(defconst epg-version-number "0.0.1") + (defvar epg-user-id nil "GnuPG ID of your default identity.") @@ -44,6 +51,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 +104,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 +120,7 @@ (?n . never) (?m . marginal) (?f . full) - (?u . ultimate) - (? . empty))) + (?u . ultimate))) (defvar epg-key-capablity-alist '((?e . encrypt) @@ -116,278 +128,407 @@ (?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) "Make a data object from FILE." - (vector file nil)) + (cons 'epg-data (vector file nil))) (defun epg-make-data-from-string (string) "Make a data object from STRING." - (vector nil string)) + (cons 'epg-data (vector nil string))) (defun epg-data-file (data) "Return the file of DATA." - (aref data 0)) + (unless (eq (car data) 'epg-data) + (signal 'wrong-type-argument (list 'epg-data-p data))) + (aref (cdr data) 0)) (defun epg-data-string (data) "Return the string of DATA." - (aref data 1)) + (unless (eq (car data) 'epg-data) + (signal 'wrong-type-argument (list 'epg-data-p data))) + (aref (cdr data) 1)) (defun epg-make-context (&optional protocol armor textmode include-certs cipher-algorithm digest-algorithm compress-algorithm) "Return a context object." - (vector protocol armor textmode include-certs - cipher-algorithm digest-algorithm compress-algorithm - #'epg-passphrase-callback-function - #'epg-progress-callback-function - nil nil nil nil)) + (cons 'epg-context + (vector protocol armor textmode include-certs + cipher-algorithm digest-algorithm compress-algorithm + #'epg-passphrase-callback-function + #'epg-progress-callback-function + nil nil nil nil))) (defun epg-context-protocol (context) "Return the protocol used within CONTEXT." - (aref context 0)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 0)) (defun epg-context-armor (context) "Return t if the output shouled be ASCII armored in CONTEXT." - (aref context 1)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 1)) (defun epg-context-textmode (context) "Return t if canonical text mode should be used in CONTEXT." - (aref context 2)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 2)) (defun epg-context-include-certs (context) "Return how many certificates should be included in an S/MIME signed message." - (aref context 3)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 3)) (defun epg-context-cipher-algorithm (context) "Return the cipher algorithm in CONTEXT." - (aref context 4)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 4)) (defun epg-context-digest-algorithm (context) "Return the digest algorithm in CONTEXT." - (aref context 5)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 5)) (defun epg-context-compress-algorithm (context) "Return the compress algorithm in CONTEXT." - (aref context 6)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 6)) (defun epg-context-passphrase-callback (context) "Return the function used to query passphrase." - (aref context 7)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 7)) (defun epg-context-progress-callback (context) "Return the function which handles progress update." - (aref context 8)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 8)) (defun epg-context-signers (context) "Return the list of key-id for singning." - (aref context 9)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 9)) (defun epg-context-process (context) "Return the process object of `epg-gpg-program'. This function is for internal use only." - (aref context 10)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 10)) (defun epg-context-output-file (context) "Return the output file of `epg-gpg-program'. This function is for internal use only." - (aref context 11)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 11)) (defun epg-context-result (context) "Return the result of the previous cryptographic operation." - (aref context 12)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 12)) (defun epg-context-set-protocol (context protocol) "Set the protocol used within CONTEXT." - (aset context 0 protocol)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 0 protocol)) (defun epg-context-set-armor (context armor) "Specify if the output shouled be ASCII armored in CONTEXT." - (aset context 1 armor)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 1 armor)) (defun epg-context-set-textmode (context textmode) "Specify if canonical text mode should be used in CONTEXT." - (aset context 2 textmode)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 2 textmode)) (defun epg-context-set-include-certs (context include-certs) "Set how many certificates should be included in an S/MIME signed message." - (aset context 3 include-certs)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 3 include-certs)) (defun epg-context-set-cipher-algorithm (context cipher-algorithm) "Set the cipher algorithm in CONTEXT." - (aset context 4 cipher-algorithm)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 4 cipher-algorithm)) (defun epg-context-set-digest-algorithm (context digest-algorithm) "Set the digest algorithm in CONTEXT." - (aset context 5 digest-algorithm)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 5 digest-algorithm)) (defun epg-context-set-compress-algorithm (context compress-algorithm) "Set the compress algorithm in CONTEXT." - (aset context 6 compress-algorithm)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 6 compress-algorithm)) (defun epg-context-set-passphrase-callback (context passphrase-callback) "Set the function used to query passphrase." - (aset context 7 passphrase-callback)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 7 passphrase-callback)) (defun epg-context-set-progress-callback (context progress-callback) "Set the function which handles progress update." - (aset context 8 progress-callback)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 8 progress-callback)) (defun epg-context-set-signers (context signers) "Set the list of key-id for singning." - (aset context 9 signers)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 9 signers)) (defun epg-context-set-process (context process) "Set the process object of `epg-gpg-program'. This function is for internal use only." - (aset context 10 process)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 10 process)) (defun epg-context-set-output-file (context output-file) "Set the output file of `epg-gpg-program'. This function is for internal use only." - (aset context 11 output-file)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 11 output-file)) (defun epg-context-set-result (context result) "Set the result of the previous cryptographic operation." - (aset context 12 result)) + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 12 result)) (defun epg-make-signature (status key-id user-id) "Return a signature object." - (vector status key-id user-id nil nil)) + (cons 'epg-signature (vector status key-id user-id nil nil))) (defun epg-signature-status (signature) "Return the status code of SIGNATURE." - (aref signature 0)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 0)) (defun epg-signature-key-id (signature) "Return the key-id of SIGNATURE." - (aref signature 1)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 1)) (defun epg-signature-user-id (signature) "Return the user-id of SIGNATURE." - (aref signature 2)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 2)) (defun epg-signature-validity (signature) "Return the validity of SIGNATURE." - (aref signature 3)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 3)) (defun epg-signature-fingerprint (signature) "Return the fingerprint of SIGNATURE." - (aref signature 4)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 4)) (defun epg-signature-set-status (signature status) "Set the status code of SIGNATURE." - (aset signature 0 status)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 0 status)) (defun epg-signature-set-key-id (signature key-id) "Set the key-id of SIGNATURE." - (aset signature 1 key-id)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 1 key-id)) (defun epg-signature-set-user-id (signature user-id) "Set the user-id of SIGNATURE." - (aset signature 2 user-id)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 2 user-id)) (defun epg-signature-set-validity (signature validity) "Set the validity of SIGNATURE." - (aset signature 3 validity)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 3 validity)) (defun epg-signature-set-fingerprint (signature fingerprint) "Set the fingerprint of SIGNATURE." - (aset signature 4 fingerprint)) + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 4 fingerprint)) (defun epg-make-key (owner-trust) "Return a key object." - (vector owner-trust nil nil)) + (cons 'epg-key (vector owner-trust nil nil))) (defun epg-key-owner-trust (key) "Return the owner trust of KEY." - (aref key 0)) + (unless (eq (car key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aref (cdr key) 0)) (defun epg-key-sub-key-list (key) "Return the sub key list of KEY." - (aref key 1)) + (unless (eq (car key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aref (cdr key) 1)) (defun epg-key-user-id-list (key) "Return the user ID list of KEY." - (aref key 2)) + (unless (eq (car key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aref (cdr key) 2)) (defun epg-key-set-sub-key-list (key sub-key-list) "Set the sub key list of KEY." - (aset key 1 sub-key-list)) + (unless (eq (car key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aset (cdr key) 1 sub-key-list)) (defun epg-key-set-user-id-list (key user-id-list) "Set the user ID list of KEY." - (aset key 2 user-id-list)) + (unless (eq (car key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aset (cdr key) 2 user-id-list)) (defun epg-make-sub-key (validity capability secret algorithm length id creation-time expiration-time) "Return a sub key object." - (vector validity capability secret algorithm length id creation-time - expiration-time nil)) + (cons 'epg-sub-key + (vector validity capability secret algorithm length id creation-time + expiration-time nil))) (defun epg-sub-key-validity (sub-key) "Return the validity of SUB-KEY." - (aref sub-key 0)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 0)) (defun epg-sub-key-capability (sub-key) "Return the capability of SUB-KEY." - (aref sub-key 1)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 1)) (defun epg-sub-key-secret (sub-key) "Return non-nil if SUB-KEY is a secret key." - (aref sub-key 2)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 2)) (defun epg-sub-key-algorithm (sub-key) "Return the algorithm of SUB-KEY." - (aref sub-key 3)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 3)) (defun epg-sub-key-length (sub-key) "Return the length of SUB-KEY." - (aref sub-key 4)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 4)) (defun epg-sub-key-id (sub-key) "Return the ID of SUB-KEY." - (aref sub-key 5)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 5)) (defun epg-sub-key-creation-time (sub-key) "Return the creation time of SUB-KEY." - (aref sub-key 6)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 6)) (defun epg-sub-key-expiration-time (sub-key) "Return the expiration time of SUB-KEY." - (aref sub-key 7)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 7)) (defun epg-sub-key-fingerprint (sub-key) "Return the fingerprint of SUB-KEY." - (aref sub-key 8)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 8)) (defun epg-sub-key-set-fingerprint (sub-key fingerprint) "Set the fingerprint of SUB-KEY. This function is for internal use only." - (aset sub-key 8 fingerprint)) + (unless (eq (car sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aset (cdr sub-key) 8 fingerprint)) (defun epg-make-user-id (validity name) "Return a user ID object." - (vector validity name nil)) + (cons 'epg-user-id (vector validity name nil))) (defun epg-user-id-validity (user-id) "Return the validity of USER-ID." - (aref user-id 0)) + (unless (eq (car user-id) 'epg-user-id) + (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) + (aref (cdr user-id) 0)) (defun epg-user-id-name (user-id) "Return the name of USER-ID." - (aref user-id 1)) + (unless (eq (car user-id) 'epg-user-id) + (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) + (aref (cdr user-id) 1)) (defun epg-user-id-signature-list (user-id) "Return the signature list of USER-ID." - (aref user-id 2)) + (unless (eq (car user-id) 'epg-user-id) + (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) + (aref (cdr user-id) 2)) (defun epg-user-id-set-signature-list (user-id signature-list) "Set the signature list of USER-ID." - (aset user-id 2 signature-list)) + (unless (eq (car user-id) 'epg-user-id) + (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) + (aset (cdr user-id) 2 signature-list)) (defun epg-context-result-for (context name) (cdr (assq name (epg-context-result context)))) @@ -399,12 +540,26 @@ 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" "--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) @@ -415,6 +570,17 @@ 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" + (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) (setq epg-read-point (point-min)) @@ -428,15 +594,22 @@ 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) + (set-process-sentinel process #'epg-process-sentinel) (epg-context-set-process context process))) (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 +619,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)) @@ -460,6 +633,21 @@ This function is for internal use only." (forward-line)) (setq epg-read-point (point))))) +(defun epg-process-sentinel (process status) + (if (and (buffer-live-p (process-buffer process)) + (not (equal status "finished\n"))) + (save-excursion + (set-buffer (process-buffer process)) + ;; gpg process exited abnormally, but we have not received an + ;; error response from it. Set it here. + (unless (epg-context-result-for epg-context 'error) + (if (string-match "\\`exited abnormally with code \\(.*\\)\n" status) + (epg-context-set-result-for + epg-context 'error + (list (cons 'exit (string-to-number (match-string 1 status))))) + (epg-context-set-result-for epg-context 'error + (list (cons 'signal status)))))))) + (defun epg-read-output (context) (with-temp-buffer (if (fboundp 'set-buffer-multibyte) @@ -479,13 +667,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,43 +708,85 @@ 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 + (if (and epg-key-id + (string-match "\\`passphrase\\." string)) + (let (inhibit-quit + passphrase + passphrase-with-new-line) (unwind-protect - (progn - (setq string (concat passphrase "\n")) - (fillarray passphrase 0) - (setq passphrase nil) - (process-send-string process string)) - (if string - (fillarray string 0)))))) + (condition-case nil + (progn + (setq passphrase + (funcall + (if (consp (epg-context-passphrase-callback + epg-context)) + (car (epg-context-passphrase-callback + epg-context)) + (epg-context-passphrase-callback epg-context)) + epg-context + epg-key-id + (if (consp (epg-context-passphrase-callback + epg-context)) + (cdr (epg-context-passphrase-callback + epg-context))))) + (when passphrase + (setq passphrase-with-new-line (concat passphrase "\n")) + (fillarray passphrase 0) + (setq passphrase nil) + (process-send-string process passphrase-with-new-line))) + (quit + (epg-context-set-result-for + epg-context 'error + (cons 'quit + (epg-context-result-for epg-context 'error))) + (delete-process process))) + (if passphrase + (fillarray passphrase 0)) + (if passphrase-with-new-line + (fillarray passphrase-with-new-line 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")))) + (let ((entry (assoc string epg-prompt-alist)) + inhibit-quit) + (condition-case nil + (if (y-or-n-p (if entry (cdr entry) (concat string "? "))) + (process-send-string process "y\n") + (process-send-string process "n\n")) + (quit + (epg-context-set-result-for + epg-context 'error + (cons 'quit + (epg-context-result-for epg-context 'error))) + (delete-process process))))) (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")))) + (let ((entry (assoc string epg-prompt-alist)) + inhibit-quit) + (condition-case nil + (process-send-string + process + (concat (read-string (if entry (cdr entry) (concat string ": "))) + "\n")) + (quit + (epg-context-set-result-for + epg-context 'error + (cons 'quit + (epg-context-result-for epg-context 'error))) + (delete-process process))))) (defun epg-status-GOODSIG (process string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) (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) @@ -562,9 +794,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) @@ -572,9 +809,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) @@ -582,9 +824,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) @@ -592,9 +839,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) @@ -634,12 +886,25 @@ This function is for internal use only." (eq (epg-signature-status signature) 'good)) (epg-signature-set-validity signature 'ultimate)))) +(defun epg-status-NO_PUBKEY (process string) + (epg-context-set-result-for + epg-context 'error + (cons (cons 'no-pubkey string) + (epg-context-result-for epg-context 'error)))) + +(defun epg-status-NO_SECKEY (process string) + (epg-context-set-result-for + epg-context 'error + (cons (cons 'no-seckey string) + (epg-context-result-for epg-context 'error)))) + (defun epg-status-PROGRESS (process string) (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)" string) (funcall (if (consp (epg-context-progress-callback epg-context)) (car (epg-context-progress-callback epg-context)) (epg-context-progress-callback epg-context)) + epg-context (match-string 1 string) (match-string 2 string) (string-to-number (match-string 3 string)) @@ -698,7 +963,29 @@ This function is for internal use only." (cons 'no-recipients (epg-context-result-for epg-context 'error)))) -(defun epg-passphrase-callback-function (key-id handback) +(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 (context key-id handback) (read-passwd (if (eq key-id 'SYM) "Passphrase for symmetric encryption: " @@ -709,7 +996,8 @@ This function is for internal use only." (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) +(defun epg-progress-callback-function (context what char current total + handback) (message "%s: %d%%/%d%%" what current total)) (defun epg-configuration () @@ -732,15 +1020,25 @@ 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" - (if mode "--list-secret-keys" "--list-keys")) + "--with-fingerprint" + (if (or (eq mode t) (eq mode 'secret)) + "--list-secret-keys" + (if mode + "--list-sigs" + "--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) @@ -757,8 +1055,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))) @@ -769,12 +1066,17 @@ 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) + "Return a list of epg-key objects matched with NAME. +If MODE is nil, only public keyring should be searched. +If MODE is t or 'secret, only secret keyring should be searched. +Otherwise, only public keyring should be searched and the key +signatures should be included." + (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) @@ -782,11 +1084,11 @@ 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)) - 'empty)) + epg-key-validity-alist)))) keys)) (epg-key-set-sub-key-list (car keys) @@ -803,14 +1105,24 @@ 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) - (aref (car lines) 9)) + epg-key-validity-alist))) + (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) @@ -863,6 +1175,11 @@ You can then use `write-region' to write new data into the file." (delete-directory tempdir)))))) ;;;###autoload +(defun epg-cancel (context) + (if (eq (process-status (epg-context-process context)) 'run) + (delete-process (epg-context-process context)))) + +;;;###autoload (defun epg-start-decrypt (context cipher) "Initiate a decrypt operation on CIPHER. CIPHER is a data object. @@ -876,7 +1193,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) @@ -906,10 +1225,11 @@ If PLAIN is nil, it returns the result as a string." (coding-system-for-write 'binary)) (unwind-protect (progn - (write-region cipher nil input-file) + (write-region cipher nil input-file nil 'quiet) (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" @@ -993,11 +1313,12 @@ For a normal or a clear text signature, SIGNED-TEXT should be nil." (if signed-text (progn (setq input-file (epg-make-temp-file "epg-signature")) - (write-region signature nil input-file) + (write-region signature nil input-file nil 'quiet) (epg-start-verify context (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,12 +1349,17 @@ 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")) + ;; `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) @@ -1054,9 +1380,14 @@ Otherwise, it makes a normal signature." (epg-make-temp-file "epg-output"))) (epg-start-sign context (epg-make-data-from-file plain) mode) (epg-wait-for-completion context) - (if (epg-context-result-for context 'error) - (error "Sign failed: %S" - (epg-context-result-for context 'error))) + (if (epg-context-result-for context 'sign) + (if (epg-context-result-for context 'error) + (message "Sign warning: %S" + (epg-context-result-for context 'error))) + (if (epg-context-result-for context 'error) + (error "Sign failed: %S" + (epg-context-result-for context 'error)) + (error "Sign failed"))) (unless signature (epg-read-output context))) (unless signature @@ -1074,10 +1405,16 @@ 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" - (epg-context-result-for context 'error))) + (if (epg-context-result-for context 'sign) + (if (epg-context-result-for context 'error) + (message "Sign warning: %S" + (epg-context-result-for context 'error))) + (if (epg-context-result-for context 'error) + (error "Sign failed: %S" + (epg-context-result-for context 'error)) + (error "Sign failed"))) (epg-read-output context)) (epg-delete-output-file context) (epg-reset context))) @@ -1105,15 +1442,19 @@ 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")))) + ;; `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) @@ -1134,6 +1475,15 @@ If RECIPIENTS is nil, it performs symmetric encryption." (epg-start-encrypt context (epg-make-data-from-file plain) recipients sign always-trust) (epg-wait-for-completion context) + (if sign + (if (epg-context-result-for context 'sign) + (if (epg-context-result-for context 'error) + (message "Sign warning: %S" + (epg-context-result-for context 'error))) + (if (epg-context-result-for context 'error) + (error "Sign failed: %S" + (epg-context-result-for context 'error)) + (error "Sign failed")))) (if (epg-context-result-for context 'error) (error "Encrypt failed: %S" (epg-context-result-for context 'error))) @@ -1154,7 +1504,17 @@ 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 sign + (if (epg-context-result-for context 'sign) + (if (epg-context-result-for context 'error) + (message "Sign warning: %S" + (epg-context-result-for context 'error))) + (if (epg-context-result-for context 'error) + (error "Sign failed: %S" + (epg-context-result-for context 'error)) + (error "Sign failed")))) (if (epg-context-result-for context 'error) (error "Encrypt failed: %S" (epg-context-result-for context 'error))) @@ -1163,31 +1523,48 @@ 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)) + (error "Export keys failed: %S" + (epg-context-result-for context 'error))) + (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 +1576,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,9 +1586,12 @@ 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")) + (error "Import keys failed: %S" + (epg-context-result-for context 'error))) (epg-read-output context)) (epg-reset context))) @@ -1225,6 +1605,150 @@ 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 allow-secret) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Delete keys failed: %S" + (epg-context-result-for context 'error)))) + (epg-reset context))) + +;;;###autoload +(defun epg-start-sign-keys (context keys &optional local) + "Initiate an sign 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-sign-keys' instead." + (epg-context-set-result context nil) + (epg-start context (cons (if local + "--lsign-key" + "--sign-key") + (mapcar + (lambda (key) + (epg-sub-key-id + (car (epg-key-sub-key-list key)))) + keys)))) + +;;;###autoload +(defun epg-sign-keys (context keys &optional local) + "Sign KEYS from the key ring." + (unwind-protect + (progn + (epg-start-sign-keys context keys local) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Sign keys failed: %S" + (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 "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\ +\\([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)) + (if (match-beginning 3) + (setq string (replace-match "\\x\\3" t nil string) + index (+ index 4)) + (setq string (replace-match "\\\\\\\\\\4" t nil string) + index (+ index 3))))) + (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 + "\\([^,=+<>#;\\\"]\\|\\\\.\\)+" + 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 "\"\\([^\\\"]\\|\\\\.\\)*\"" + 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