X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=bcf3675a929e421641b2f66c73a7b2af59e37506;hb=3ac19de3136bb8dec6581b8ef49a3e04c3c656a9;hp=68c1041c7f793c1fe948a4fc58f6ba7546d036e0;hpb=07b1adf51415fe37c4e2d801afbd2a655490ab8c;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index 68c1041..bcf3675 100644 --- a/epg.el +++ b/epg.el @@ -168,7 +168,7 @@ compress-algorithm) "Return a context object." (cons 'epg-context - (vector protocol armor textmode include-certs + (vector (or protocol 'OpenPGP) armor textmode include-certs cipher-algorithm digest-algorithm compress-algorithm #'epg-passphrase-callback-function #'epg-progress-callback-function @@ -336,9 +336,9 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-context-p context))) (aset (cdr context) 12 result)) -(defun epg-make-signature (status key-id user-id) +(defun epg-make-signature (status &optional key-id) "Return a signature object." - (cons 'epg-signature (vector status key-id user-id nil nil))) + (cons 'epg-signature (vector status key-id nil nil nil nil nil nil))) (defun epg-signature-status (signature) "Return the status code of SIGNATURE." @@ -352,24 +352,42 @@ This function is for internal use only." (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." - (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." (unless (eq (car signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 3)) + (aref (cdr signature) 2)) (defun epg-signature-fingerprint (signature) "Return the fingerprint of SIGNATURE." (unless (eq (car signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 3)) + +(defun epg-signature-creation-time (signature) + "Return the creation time of SIGNATURE." + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aref (cdr signature) 4)) +(defun epg-signature-expiration-time (signature) + "Return the expiration time of SIGNATURE." + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 5)) + +(defun epg-signature-pubkey-algorithm (signature) + "Return the public key algorithm of SIGNATURE." + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 6)) + +(defun epg-signature-digest-algorithm (signature) + "Return the digest algorithm of SIGNATURE." + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 7)) + (defun epg-signature-set-status (signature status) "Set the status code of SIGNATURE." (unless (eq (car signature) 'epg-signature) @@ -382,23 +400,41 @@ This function is for internal use only." (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." - (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." (unless (eq (car signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 3 validity)) + (aset (cdr signature) 2 validity)) (defun epg-signature-set-fingerprint (signature fingerprint) "Set the fingerprint of SIGNATURE." (unless (eq (car signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 4 fingerprint)) + (aset (cdr signature) 3 fingerprint)) + +(defun epg-signature-set-creation-time (signature creation-time) + "Set the creation time of SIGNATURE." + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 4 creation-time)) + +(defun epg-signature-set-expiration-time (signature expiration-time) + "Set the expiration time of SIGNATURE." + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 5 expiration-time)) + +(defun epg-signature-set-pubkey-algorithm (signature pubkey-algorithm) + "Set the public key algorithm of SIGNATURE." + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 6 pubkey-algorithm)) + +(defun epg-signature-set-digest-algorithm (signature digest-algorithm) + "Set the digest algorithm of SIGNATURE." + (unless (eq (car signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 7 digest-algorithm)) (defun epg-make-key (owner-trust) "Return a key object." @@ -541,14 +577,32 @@ This function is for internal use only." (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)) - ""))) + (let ((user-id (cdr (assoc (epg-signature-key-id signature) + epg-user-id-alist)))) + (concat + (cond ((eq (epg-signature-status signature) 'good) + "Good signature ") + ((eq (epg-signature-status signature) 'bad) + "Bad signature ") + ((eq (epg-signature-status signature) 'expired) + "Expired signature ") + ((eq (epg-signature-status signature) 'expired-key) + "Signature made by expired key ") + ((eq (epg-signature-status signature) 'revoked-key) + "Signature made by revoked key ") + ((eq (epg-signature-status signature) 'no-pubkey) + "No public key for ")) + (epg-signature-key-id signature) + (if user-id + (concat " from " + (if (stringp user-id) + user-id + (epg-decode-dn user-id)) + " ") + "") + (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")) @@ -601,7 +655,6 @@ This function is for internal use only." 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) @@ -633,21 +686,6 @@ 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) @@ -774,87 +812,107 @@ This function is for internal use only." (epg-context-result-for epg-context 'error))) (delete-process process))))) -(defun epg-status-GOODSIG (process string) +(defun epg-signature-status-internal (status string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result-for - epg-context - 'verify - (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))))) + (let* ((key-id (match-string 1 string)) + (user-id (match-string 2 string)) + (entry (assoc key-id epg-user-id-alist))) + (epg-context-set-result-for + epg-context + 'verify + (cons (epg-make-signature status key-id) + (epg-context-result-for epg-context 'verify))) + (if (eq (epg-context-protocol epg-context) 'CMS) + (condition-case nil + (setq user-id (epg-dn-from-string user-id)) + (error))) + (if entry + (setcdr entry user-id) + (setq epg-user-id-alist + (cons (cons key-id user-id) epg-user-id-alist)))) + (epg-context-set-result-for + epg-context + 'verify + (cons (epg-make-signature status) + (epg-context-result-for epg-context 'verify))))) + +(defun epg-status-GOODSIG (process string) + (epg-signature-status-internal 'good string)) (defun epg-status-EXPSIG (process string) - (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result-for - epg-context - 'verify - (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))))) + (epg-signature-status-internal 'expired string)) (defun epg-status-EXPKEYSIG (process string) - (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result-for - epg-context - 'verify - (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))))) + (epg-signature-status-internal 'expired-key string)) (defun epg-status-REVKEYSIG (process string) - (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result-for - epg-context - 'verify - (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))))) + (epg-signature-status-internal 'revoked-key string)) (defun epg-status-BADSIG (process string) - (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result-for - epg-context - 'verify - (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))))) + (epg-signature-status-internal 'bad string)) + +(defun epg-status-NO_PUBKEY (process string) + (epg-context-set-result-for + epg-context + 'verify + (cons (epg-make-signature 'no-pubkey string) + (epg-context-result-for epg-context 'verify)))) + +(defun epg-status-ERRSIG (process string) + (let ((signatures (car (epg-context-result-for epg-context 'verify)))) + (unless signatures + (setq signatures (list (epg-make-signature 'error))) + (epg-context-set-result-for epg-context 'verify signatures)) + (when (and (not (eq (epg-signature-status (car signatures)) 'good)) + (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \ +\\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)" + string)) + (epg-signature-set-key-id + (car signatures) + (match-string 1 string)) + (epg-signature-set-pubkey-algorithm + (car signatures) + (string-to-number (match-string 2 string))) + (epg-signature-set-digest-algorithm + (car signatures) + (string-to-number (match-string 3 string))) +; (epg-signature-set-class +; (car signatures) +; (string-to-number (match-string 4 string) 16)) + (epg-signature-set-creation-time + (car signatures) + (match-string 5 string))))) (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) - (string-match "\\`\\([^ ]+\\) " string)) - (epg-signature-set-fingerprint signature (match-string 1 string))))) + (when (and signature + (eq (epg-signature-status signature) 'good) + (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \ +\\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \ +\\(.*\\)" + string)) + (epg-signature-set-fingerprint + signature + (match-string 1 string)) + (epg-signature-set-creation-time + signature + (match-string 2 string)) + (epg-signature-set-expiration-time + signature + (match-string 3 string)) +; (epg-signature-set-version +; signature +; (string-to-number (match-string 4 string))) + (epg-signature-set-pubkey-algorithm + signature + (string-to-number (match-string 5 string))) + (epg-signature-set-digest-algorithm + signature + (string-to-number (match-string 6 string))) +; (epg-signature-set-class +; signature +; (string-to-number (match-string 7 string) 16)) + ))) (defun epg-status-TRUST_UNDEFINED (process string) (let ((signature (car (epg-context-result-for epg-context 'verify)))) @@ -886,18 +944,6 @@ 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) @@ -1291,6 +1337,9 @@ For a normal or a clear text signature, SIGNED-TEXT should be nil." (epg-start-verify context (epg-make-data-from-file signature))) (epg-wait-for-completion context) +; (if (epg-context-result-for context 'error) +; (error "Verify failed: %S" +; (epg-context-result-for context 'error))) (unless plain (epg-read-output context))) (unless plain @@ -1320,6 +1369,9 @@ For a normal or a clear text signature, SIGNED-TEXT should be nil." (epg-start-verify context (epg-make-data-from-string signature))) (epg-flush context) (epg-wait-for-completion context) +; (if (epg-context-result-for context 'error) +; (error "Verify failed: %S" +; (epg-context-result-for context 'error))) (epg-read-output context)) (epg-delete-output-file context) (if (and input-file @@ -1407,10 +1459,7 @@ Otherwise, it makes a normal signature." (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 'sign) - (if (epg-context-result-for context 'error) - (message "Sign warning: %S" - (epg-context-result-for context 'error))) + (unless (epg-context-result-for context 'sign) (if (epg-context-result-for context 'error) (error "Sign failed: %S" (epg-context-result-for context 'error)) @@ -1475,15 +1524,12 @@ 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 (and sign + (not (epg-context-result-for context 'sign))) + (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))) @@ -1506,15 +1552,12 @@ If RECIPIENTS is nil, it performs symmetric encryption." 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 (and sign + (not (epg-context-result-for context 'sign))) + (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)))