X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=305883e2e377a704a77a5c44eb737d6590dd1be5;hb=0aaa0d9d521bd62d32cf5b4f2a1d56a901804a76;hp=75d210fe0c5ddc35acb575fb2c543467c28817f8;hpb=78708926c0bd79cf56080f48bf059e6f9053f3db;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index 75d210f..305883e 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 @@ -260,49 +261,49 @@ This function is for internal use only." "Set the result of the previous cryptographic operation." (aset context 12 result)) -(defun epg-make-signature (status key-id user-id) - "Return a signature object." +(defun epg-make-verify-result (status key-id user-id) + "Return a verify-result object." (vector status key-id user-id nil nil)) -(defun epg-signature-status (signature) - "Return the status code of SIGNATURE." - (aref signature 0)) +(defun epg-verify-result-status (verify-result) + "Return the status code of VERIFY-RESULT." + (aref verify-result 0)) -(defun epg-signature-key-id (signature) - "Return the key-id of SIGNATURE." - (aref signature 1)) +(defun epg-verify-result-key-id (verify-result) + "Return the key-id of VERIFY-RESULT." + (aref verify-result 1)) -(defun epg-signature-user-id (signature) - "Return the user-id of SIGNATURE." - (aref signature 2)) +(defun epg-verify-result-user-id (verify-result) + "Return the user-id of VERIFY-RESULT." + (aref verify-result 2)) -(defun epg-signature-validity (signature) - "Return the validity of SIGNATURE." - (aref signature 3)) +(defun epg-verify-result-validity (verify-result) + "Return the validity of VERIFY-RESULT." + (aref verify-result 3)) -(defun epg-signature-fingerprint (signature) - "Return the fingerprint of SIGNATURE." - (aref signature 4)) +(defun epg-verify-result-fingerprint (verify-result) + "Return the fingerprint of VERIFY-RESULT." + (aref verify-result 4)) -(defun epg-signature-set-status (signature status) - "Set the status code of SIGNATURE." - (aset signature 0 status)) +(defun epg-verify-result-set-status (verify-result status) + "Set the status code of VERIFY-RESULT." + (aset verify-result 0 status)) -(defun epg-signature-set-key-id (signature key-id) - "Set the key-id of SIGNATURE." - (aset signature 1 key-id)) +(defun epg-verify-result-set-key-id (verify-result key-id) + "Set the key-id of VERIFY-RESULT." + (aset verify-result 1 key-id)) -(defun epg-signature-set-user-id (signature user-id) - "Set the user-id of SIGNATURE." - (aset signature 2 user-id)) +(defun epg-verify-result-set-user-id (verify-result user-id) + "Set the user-id of VERIFY-RESULT." + (aset verify-result 2 user-id)) -(defun epg-signature-set-validity (signature validity) - "Set the validity of SIGNATURE." - (aset signature 3 validity)) +(defun epg-verify-result-set-validity (verify-result validity) + "Set the validity of VERIFY-RESULT." + (aset verify-result 3 validity)) -(defun epg-signature-set-fingerprint (signature fingerprint) - "Set the fingerprint of SIGNATURE." - (aset signature 4 fingerprint)) +(defun epg-verify-result-set-fingerprint (verify-result fingerprint) + "Set the fingerprint of VERIFY-RESULT." + (aset verify-result 4 fingerprint)) (defun epg-make-key (owner-trust) "Return a key object." @@ -387,13 +388,13 @@ This function is for internal use only." "Return the name of USER-ID." (aref user-id 1)) -(defun epg-user-id-signature-list (user-id) - "Return the signature list of USER-ID." +(defun epg-user-id-verify-result-list (user-id) + "Return the verify-result list of USER-ID." (aref 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)) +(defun epg-user-id-set-verify-result-list (user-id verify-result-list) + "Set the verify-result list of USER-ID." + (aset user-id 2 verify-result-list)) (defun epg-context-result-for (context name) (cdr (assq name (epg-context-result context)))) @@ -405,6 +406,16 @@ This function is for internal use only." (setcdr entry value) (epg-context-set-result context (cons (cons name value) result))))) +(defun epg-verify-result-to-string (verify-result) + (format "%s verify-result from %s %s%s" + (capitalize (symbol-name (epg-verify-result-status verify-result))) + (epg-verify-result-key-id verify-result) + (epg-verify-result-user-id verify-result) + (if (epg-verify-result-validity verify-result) + (format " (trust %s)" + (epg-verify-result-validity verify-result)) + ""))) + (defun epg-start (context args) "Start `epg-gpg-program' in a subprocess with given ARGS." (let* ((args (append (list "--no-tty" @@ -423,7 +434,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 +461,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)) @@ -468,12 +483,7 @@ This function is for internal use only." (setq epg-pending-status-list nil)) (if (and symbol (fboundp symbol)) - (funcall symbol process string)) - (condition-case nil - (run-hook-with-args-until-success - (intern (concat "epg-after-status-" status "-function")) - string) - (error))))) + (funcall symbol process string))))) (forward-line)) (setq epg-read-point (point))))) @@ -495,15 +505,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)))) @@ -536,22 +547,26 @@ 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)) - (if (consp (epg-context-passphrase-callback epg-context)) - (cdr (epg-context-passphrase-callback epg-context))))) - string) - (if passphrase - (unwind-protect - (progn - (setq string (concat passphrase "\n")) - (fillarray passphrase 0) - (setq passphrase nil) - (process-send-string process string)) - (if string - (fillarray string 0)))))) + (if (and epg-key-id + (string-match "\\`passphrase\\." 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 + (unwind-protect + (progn + (setq string (concat passphrase "\n")) + (fillarray passphrase 0) + (setq passphrase nil) + (process-send-string process string)) + (if string + (fillarray string 0))))))) (defun epg-status-GET_BOOL (process string) (let ((entry (assoc string epg-prompt-alist))) @@ -569,7 +584,7 @@ This function is for internal use only." (epg-context-set-result-for epg-context 'verify - (cons (epg-make-signature 'good + (cons (epg-make-verify-result 'good (match-string 1 string) (match-string 2 string)) (epg-context-result-for epg-context 'verify))))) @@ -579,7 +594,7 @@ This function is for internal use only." (epg-context-set-result-for epg-context 'verify - (cons (epg-make-signature 'expired + (cons (epg-make-verify-result 'expired (match-string 1 string) (match-string 2 string)) (epg-context-result-for epg-context 'verify))))) @@ -589,7 +604,7 @@ This function is for internal use only." (epg-context-set-result-for epg-context 'verify - (cons (epg-make-signature 'expired-key + (cons (epg-make-verify-result 'expired-key (match-string 1 string) (match-string 2 string)) (epg-context-result-for epg-context 'verify))))) @@ -599,7 +614,7 @@ This function is for internal use only." (epg-context-set-result-for epg-context 'verify - (cons (epg-make-signature 'revoked-key + (cons (epg-make-verify-result 'revoked-key (match-string 1 string) (match-string 2 string)) (epg-context-result-for epg-context 'verify))))) @@ -609,47 +624,47 @@ This function is for internal use only." (epg-context-set-result-for epg-context 'verify - (cons (epg-make-signature 'bad + (cons (epg-make-verify-result 'bad (match-string 1 string) (match-string 2 string)) (epg-context-result-for epg-context 'verify))))) (defun epg-status-VALIDSIG (process string) - (let ((signature (car (epg-context-result-for epg-context 'verify)))) - (if (and signature - (eq (epg-signature-status signature) 'good) + (let ((verify-result (car (epg-context-result-for epg-context 'verify)))) + (if (and verify-result + (eq (epg-verify-result-status verify-result) 'good) (string-match "\\`\\([^ ]+\\) " string)) - (epg-signature-set-fingerprint signature (match-string 1 string))))) + (epg-verify-result-set-fingerprint verify-result (match-string 1 string))))) (defun epg-status-TRUST_UNDEFINED (process string) - (let ((signature (car (epg-context-result-for epg-context 'verify)))) - (if (and signature - (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'undefined)))) + (let ((verify-result (car (epg-context-result-for epg-context 'verify)))) + (if (and verify-result + (eq (epg-verify-result-status verify-result) 'good)) + (epg-verify-result-set-validity verify-result 'undefined)))) (defun epg-status-TRUST_NEVER (process string) - (let ((signature (car (epg-context-result-for epg-context 'verify)))) - (if (and signature - (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'never)))) + (let ((verify-result (car (epg-context-result-for epg-context 'verify)))) + (if (and verify-result + (eq (epg-verify-result-status verify-result) 'good)) + (epg-verify-result-set-validity verify-result 'never)))) (defun epg-status-TRUST_MARGINAL (process string) - (let ((signature (car (epg-context-result-for epg-context 'verify)))) - (if (and signature - (eq (epg-signature-status signature) 'marginal)) - (epg-signature-set-validity signature 'marginal)))) + (let ((verify-result (car (epg-context-result-for epg-context 'verify)))) + (if (and verify-result + (eq (epg-verify-result-status verify-result) 'marginal)) + (epg-verify-result-set-validity verify-result 'marginal)))) (defun epg-status-TRUST_FULLY (process string) - (let ((signature (car (epg-context-result-for epg-context 'verify)))) - (if (and signature - (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'full)))) + (let ((verify-result (car (epg-context-result-for epg-context 'verify)))) + (if (and verify-result + (eq (epg-verify-result-status verify-result) 'good)) + (epg-verify-result-set-validity verify-result 'full)))) (defun epg-status-TRUST_ULTIMATE (process string) - (let ((signature (car (epg-context-result-for epg-context 'verify)))) - (if (and signature - (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'ultimate)))) + (let ((verify-result (car (epg-context-result-for epg-context 'verify)))) + (if (and verify-result + (eq (epg-verify-result-status verify-result) 'good)) + (epg-verify-result-set-validity verify-result 'ultimate)))) (defun epg-status-PROGRESS (process string) (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)" @@ -722,16 +737,31 @@ 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-passphrase-callback-function (handback) +(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 epg-key-id 'SYM) + (if (eq key-id 'SYM) "Passphrase for symmetric encryption: " - (if (eq epg-key-id 'PIN) + (if (eq key-id 'PIN) "Passphrase for PIN: " - (let ((entry (assoc epg-key-id epg-user-id-alist))) + (let ((entry (assoc key-id epg-user-id-alist))) (if entry - (format "Passphrase for %s %s: " epg-key-id (cdr entry)) - (format "Passphrase for %s: " epg-key-id))))))) + (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) (message "%s: %d%%/%d%%" what current total)) @@ -910,7 +940,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))) @@ -931,6 +961,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" @@ -991,7 +1022,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 @@ -1019,6 +1050,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) @@ -1049,9 +1081,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")) @@ -1074,7 +1109,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))) @@ -1095,6 +1130,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" @@ -1126,9 +1162,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 @@ -1153,7 +1192,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))) @@ -1174,6 +1213,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" @@ -1245,7 +1285,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)) @@ -1286,7 +1328,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)))