X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=147eda528525cfa5bfdecaf6f5d18b58d6305a45;hb=5312c05cb5a923991a4d5ab8de4b9fc53d21f0d2;hp=f0842373927a406bcff324f067702e2c53b363ba;hpb=901bcf657b18066f580c9548e81a5ca500654548;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index f084237..147eda5 100644 --- a/epg.el +++ b/epg.el @@ -46,6 +46,7 @@ (defvar epg-key-id nil) (defvar epg-context nil) (defvar epg-debug nil) +(defvar epg-debug-buffer nil) ;; from gnupg/include/cipher.h (defconst epg-cipher-algorithm-alist @@ -405,6 +406,19 @@ This function is for internal use only." (setcdr entry value) (epg-context-set-result context (cons (cons name value) result))))) +(defun epg-signature-to-string (signature) + (format "%s signature from %s %s%s" + (capitalize (symbol-name (epg-signature-status signature))) + (epg-signature-key-id signature) + (epg-signature-user-id signature) + (if (epg-signature-validity signature) + (format " (trust %s)" + (epg-signature-validity signature)) + ""))) + +(defun epg-verify-result-to-string (verify-result) + (mapconcat #'epg-signature-to-string verify-result "\n")) + (defun epg-start (context args) "Start `epg-gpg-program' in a subprocess with given ARGS." (let* ((args (append (list "--no-tty" @@ -423,7 +437,9 @@ This function is for internal use only." process) (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 (format "%s %s\n" epg-gpg-program (mapconcat #'identity args " "))))) @@ -448,7 +464,9 @@ This function is for internal use only." (defun epg-process-filter (process input) (if epg-debug (save-excursion - (set-buffer (get-buffer-create " *epg-debug*")) + (unless epg-debug-buffer + (setq epg-debug-buffer (generate-new-buffer " *epg-debug*"))) + (set-buffer epg-debug-buffer) (goto-char (point-max)) (insert input))) (if (buffer-live-p (process-buffer process)) @@ -490,15 +508,16 @@ This function is for internal use only." epg-pending-status-list) (accept-process-output (epg-context-process context) 1)))) -(defun epg-wait-for-completion (context &optional no-eof) - (if (and (not no-eof) - (eq (process-status (epg-context-process context)) 'run)) - (process-send-eof (epg-context-process context))) +(defun epg-wait-for-completion (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)))) @@ -721,6 +740,21 @@ This function is for internal use only." (cons (cons 'delete-problem (string-to-number (match-string 1 string))) (epg-context-result-for epg-context 'error))))) +(defun epg-status-SIG_CREATED (process string) + (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \ +\\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string) + (epg-context-set-result-for + epg-context 'sign + (cons (list (cons 'type (string-to-char (match-string 1 string))) + (cons 'pubkey-algorithm + (string-to-number (match-string 2 string))) + (cons 'digest-algorithm + (string-to-number (match-string 3 string))) + (cons 'class (string-to-number (match-string 4 string) 16)) + (cons 'creation-time (match-string 5 string)) + (cons 'fingerprint (substring string (match-end 0)))) + (epg-context-result-for epg-context 'sign))))) + (defun epg-passphrase-callback-function (key-id handback) (read-passwd (if (eq key-id 'SYM) @@ -909,7 +943,7 @@ If PLAIN is nil, it returns the result as a string." (epg-context-set-output-file context (epg-make-temp-file "epg-output"))) (epg-start-decrypt context (epg-make-data-from-file cipher)) - (epg-wait-for-completion context t) + (epg-wait-for-completion context) (if (epg-context-result-for context 'error) (error "Decrypt failed: %S" (epg-context-result-for context 'error))) @@ -930,6 +964,7 @@ If PLAIN is nil, it returns the result as a string." (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start-decrypt context (epg-make-data-from-file input-file)) + (epg-flush context) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) (error "Decrypt failed: %S" @@ -990,7 +1025,7 @@ For a normal or a clear text signature, SIGNED-TEXT should be nil." (epg-make-data-from-file signed-text)) (epg-start-verify context (epg-make-data-from-file signature))) - (epg-wait-for-completion context t) + (epg-wait-for-completion context) (unless plain (epg-read-output context))) (unless plain @@ -1018,6 +1053,7 @@ For a normal or a clear text signature, SIGNED-TEXT should be nil." (epg-make-data-from-file input-file) (epg-make-data-from-string signed-text))) (epg-start-verify context (epg-make-data-from-string signature))) + (epg-flush context) (epg-wait-for-completion context) (epg-read-output context)) (epg-delete-output-file context) @@ -1048,9 +1084,12 @@ If you are unsure, use synchronous version of this function "--detach-sign" "--sign"))) (apply #'nconc - (mapcar (lambda (signer) - (list "-u" signer)) - (epg-context-signers context))) + (mapcar + (lambda (signer) + (list "-u" + (epg-sub-key-id + (car (epg-key-sub-key-list signer))))) + (epg-context-signers context))) (if (epg-data-file plain) (list (epg-data-file plain))))) (epg-wait-for-status context '("BEGIN_SIGNING")) @@ -1073,7 +1112,7 @@ Otherwise, it makes a normal signature." (epg-context-set-output-file context (epg-make-temp-file "epg-output"))) (epg-start-sign context (epg-make-data-from-file plain) mode) - (epg-wait-for-completion context t) + (epg-wait-for-completion context) (if (epg-context-result-for context 'error) (error "Sign failed: %S" (epg-context-result-for context 'error))) @@ -1094,6 +1133,7 @@ Otherwise, it makes a normal signature." (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start-sign context (epg-make-data-from-string plain) mode) + (epg-flush context) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) (error "Sign failed: %S" @@ -1125,9 +1165,12 @@ 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 @@ -1152,7 +1195,7 @@ If RECIPIENTS is nil, it performs symmetric encryption." (epg-make-temp-file "epg-output"))) (epg-start-encrypt context (epg-make-data-from-file plain) recipients sign always-trust) - (epg-wait-for-completion context t) + (epg-wait-for-completion context) (if (epg-context-result-for context 'error) (error "Encrypt failed: %S" (epg-context-result-for context 'error))) @@ -1173,6 +1216,7 @@ If RECIPIENTS is nil, it performs symmetric encryption." (epg-make-temp-file "epg-output")) (epg-start-encrypt context (epg-make-data-from-string plain) recipients sign always-trust) + (epg-flush context) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) (error "Encrypt failed: %S" @@ -1244,7 +1288,9 @@ If you are unsure, use synchronous version of this function (unwind-protect (progn (epg-start-import-keys context keys) - (epg-wait-for-completion context (epg-data-file 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")) (epg-read-output context)) @@ -1285,7 +1331,7 @@ If you are unsure, use synchronous version of this function (unwind-protect (progn (epg-start-delete-keys context keys) - (epg-wait-for-completion context t) + (epg-wait-for-completion context) (if (epg-context-result-for context 'error) (error "Delete key failed"))) (epg-reset context)))