X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=bcf3675a929e421641b2f66c73a7b2af59e37506;hb=3ac19de3136bb8dec6581b8ef49a3e04c3c656a9;hp=2a8c2f3ae51851e81c3270e5b26ae46d5f775aa9;hpb=82717ed0a95cf74266c4ac39bbe649029027f897;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index 2a8c2f3..bcf3675 100644 --- a/epg.el +++ b/epg.el @@ -38,7 +38,7 @@ :group 'epg :type 'string) -(defconst epg-version-number "0.0.0") +(defconst epg-version-number "0.0.1") (defvar epg-user-id nil "GnuPG ID of your default identity.") @@ -145,274 +145,426 @@ (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 (or protocol 'OpenPGP) 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) +(defun epg-make-signature (status &optional key-id) "Return a signature object." - (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." - (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)) - (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) 2)) (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) 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." - (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)) - (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) 2 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) 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." - (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)))) @@ -425,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")) @@ -485,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-filter process #'epg-process-sentinel) (epg-context-set-process context process))) (defun epg-process-filter (process input) @@ -517,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. - (unless (epg-context-result-for epg-context 'error) - (if (string-match "\\`exited abnormally with code \\(.*\\)\n" status) - (epg-context-result-for - epg-context 'error - (list (cons 'exit (string-to-number (match-string 1 status))))) - (epg-context-result-for epg-context 'error - (list (cons 'signal status)))))))) - (defun epg-read-output (context) (with-temp-buffer (if (fboundp 'set-buffer-multibyte) @@ -607,6 +761,7 @@ This function is for internal use only." (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)) @@ -657,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)))) @@ -775,6 +950,7 @@ This function is for internal use only." (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)) @@ -855,7 +1031,7 @@ This function is for internal use only." (cons 'fingerprint (substring string (match-end 0)))) (epg-context-result-for epg-context 'sign))))) -(defun epg-passphrase-callback-function (key-id handback) +(defun epg-passphrase-callback-function (context key-id handback) (read-passwd (if (eq key-id 'SYM) "Passphrase for symmetric encryption: " @@ -866,7 +1042,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 () @@ -893,7 +1070,11 @@ This function is for internal use only." (let ((args (append (list "--with-colons" "--no-greeting" "--batch" "--with-fingerprint" "--with-fingerprint" - (if mode "--list-secret-keys" "--list-keys")) + (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)))) @@ -932,6 +1113,11 @@ This function is for internal use only." (aref line 6))) (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 @@ -1035,6 +1221,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. @@ -1146,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 @@ -1175,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 @@ -1235,9 +1432,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 @@ -1257,9 +1459,11 @@ 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 'error) - (error "Sign failed: %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)) + (error "Sign failed"))) (epg-read-output context)) (epg-delete-output-file context) (epg-reset context))) @@ -1320,6 +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 (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))) @@ -1342,6 +1552,12 @@ If RECIPIENTS is nil, it performs symmetric encryption." recipients sign always-trust) (epg-flush context) (epg-wait-for-completion context) + (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)))