X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=18ef4b9367af5153dfae6c40ffae7d3b9829db83;hb=ba1a4d03b21a2575b3e3e4b3e686acd6b20aac2c;hp=d886f4e46236fdb28b17ec6e846f30670578e855;hpb=0d6a73036eef75068f8bcae5dc9b3c133761dcbd;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index d886f4e..18ef4b9 100644 --- a/epg.el +++ b/epg.el @@ -91,7 +91,7 @@ (2 . "ZLIB") (3 . "BZIP2"))) -(defconst epg-invalid-recipients-alist +(defconst epg-invalid-recipients-reason-alist '((0 . "No specific reason given") (1 . "Not Found") (2 . "Ambigious specification") @@ -104,11 +104,34 @@ (9 . "Not a secret key") (10 . "Key not trusted"))) -(defconst epg-delete-problem-alist +(defconst epg-delete-problem-reason-alist '((1 . "No such key") (2 . "Must delete secret key first") (3 . "Ambigious specification"))) +(defconst epg-import-ok-reason-alist + '((0 . "Not actually changed") + (1 . "Entirely new key") + (2 . "New user IDs") + (4 . "New signatures") + (8 . "New subkeys") + (16 . "Contains private key"))) + +(defconst epg-import-problem-reason-alist + '((0 . "No specific reason given") + (1 . "Invalid Certificate") + (2 . "Issuer Certificate missing") + (3 . "Certificate Chain too long") + (4 . "Error storing certificate"))) + +(defconst epg-no-data-reason-alist + '((1 . "No armored data") + (2 . "Expected a packet but did not found one") + (3 . "Invalid packet found, this may indicate a non OpenPGP message") + (4 . "Signature expected but not found"))) + +(defconst epg-unexpected-reason-alist nil) + (defvar epg-key-validity-alist '((?o . unknown) (?i . invalid) @@ -177,7 +200,7 @@ cipher-algorithm digest-algorithm compress-algorithm #'epg-passphrase-callback-function #'epg-progress-callback-function - nil nil nil nil))) + nil nil nil nil nil))) (defun epg-context-protocol (context) "Return the protocol used within CONTEXT." @@ -260,6 +283,12 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-context-p context))) (aref (cdr context) 12)) +(defun epg-context-operation (context) + "Return the name of the current cryptographic operation." + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 13)) + (defun epg-context-set-protocol (context protocol) "Set the protocol used within CONTEXT." (unless (eq (car context) 'epg-context) @@ -341,6 +370,12 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-context-p context))) (aset (cdr context) 12 result)) +(defun epg-context-set-operation (context operation) + "Set the name of the current cryptographic operation." + (unless (eq (car context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 13 operation)) + (defun epg-make-signature (status &optional key-id) "Return a signature object." (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil))) @@ -541,11 +576,11 @@ This function is for internal use only." (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 +(defun epg-make-sub-key (validity capability secret-p algorithm length id creation-time expiration-time) "Return a sub key object." (cons 'epg-sub-key - (vector validity capability secret algorithm length id creation-time + (vector validity capability secret-p algorithm length id creation-time expiration-time nil))) (defun epg-sub-key-validity (sub-key) @@ -560,7 +595,7 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) (aref (cdr sub-key) 1)) -(defun epg-sub-key-secret (sub-key) +(defun epg-sub-key-secret-p (sub-key) "Return non-nil if SUB-KEY is a secret key." (unless (eq (car sub-key) 'epg-sub-key) (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) @@ -637,6 +672,62 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) (aset (cdr user-id) 2 signature-list)) +(defun epg-make-key-signature (validity pubkey-algorithm key-id creation-time + expiration-time user-id class + exportable-p) + "Return a key signature object." + (cons 'epg-key-signature + (vector validity pubkey-algorithm key-id creation-time expiration-time + user-id class exportable-p))) + +(defun epg-key-signature-validity (key-signature) + "Return the validity of KEY-SIGNATURE." + (unless (eq (car key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 0)) + +(defun epg-key-signature-pubkey-algorithm (key-signature) + "Return the public key algorithm of KEY-SIGNATURE." + (unless (eq (car key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 1)) + +(defun epg-key-signature-key-id (key-signature) + "Return the key-id of KEY-SIGNATURE." + (unless (eq (car key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 2)) + +(defun epg-key-signature-creation-time (key-signature) + "Return the creation time of KEY-SIGNATURE." + (unless (eq (car key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 3)) + +(defun epg-key-signature-expiration-time (key-signature) + "Return the expiration time of KEY-SIGNATURE." + (unless (eq (car key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 4)) + +(defun epg-key-signature-user-id (key-signature) + "Return the user-id of KEY-SIGNATURE." + (unless (eq (car key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 5)) + +(defun epg-key-signature-class (key-signature) + "Return the class of KEY-SIGNATURE." + (unless (eq (car key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 6)) + +(defun epg-key-signature-exportable-p (key-signature) + "Return t if KEY-SIGNATURE is exportable." + (unless (eq (car key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 7)) + (defun epg-context-result-for (context name) "Return the result of CONTEXT associated with NAME." (cdr (assq name (epg-context-result context)))) @@ -801,12 +892,12 @@ This function is for internal use only." (setq epg-pending-status-list status-list) (while (and (eq (process-status (epg-context-process context)) 'run) epg-pending-status-list) - (accept-process-output (epg-context-process context) 0 1)))) + (accept-process-output (epg-context-process context) 1)))) (defun epg-wait-for-completion (context) "Wait until the `epg-gpg-program' process completes." (while (eq (process-status (epg-context-process context)) 'run) - (accept-process-output (epg-context-process context) 0 1))) + (accept-process-output (epg-context-process context) 1))) (defun epg-reset (context) "Reset the CONTEXT." @@ -955,7 +1046,7 @@ This function is for internal use only." (epg-context-result-for epg-context 'verify)))) (defun epg-status-ERRSIG (process string) - (let ((signatures (car (epg-context-result-for epg-context 'verify)))) + (let ((signatures (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)) @@ -1062,19 +1153,19 @@ This function is for internal use only." (defun epg-status-NODATA (process string) (epg-context-set-result-for epg-context 'error - (cons (cons 'no-data (string-to-number string)) + (cons (list 'no-data (cons 'reason (string-to-number string))) (epg-context-result-for epg-context 'error)))) (defun epg-status-UNEXPECTED (process string) (epg-context-set-result-for epg-context 'error - (cons (cons 'unexpected (string-to-number string)) + (cons (list 'unexpected (cons 'reason (string-to-number string))) (epg-context-result-for epg-context 'error)))) (defun epg-status-KEYEXPIRED (process string) (epg-context-set-result-for epg-context 'error - (cons (cons 'key-expired string) + (cons (list 'key-expired (cons 'expiration-time string)) (epg-context-result-for epg-context 'error)))) (defun epg-status-KEYREVOKED (process string) @@ -1094,8 +1185,10 @@ This function is for internal use only." (epg-context-set-result-for epg-context 'error (cons (list 'invalid-recipient - (string-to-number (match-string 1 string)) - (match-string 2 string)) + (cons 'reason + (string-to-number (match-string 1 string))) + (cons 'requested-recipient + (match-string 2 string))) (epg-context-result-for epg-context 'error))))) (defun epg-status-NO_RECP (process string) @@ -1108,7 +1201,8 @@ This function is for internal use only." (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))) + (cons (list 'delete-problem + (cons 'reason (string-to-number (match-string 1 string)))) (epg-context-result-for epg-context 'error))))) (defun epg-status-SIG_CREATED (process string) @@ -1140,12 +1234,54 @@ This function is for internal use only." (cons '(key-not-created) (epg-context-result-for epg-context 'error)))) +(defun epg-status-IMPORTED (process string) + (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) + (let* ((key-id (match-string 1 string)) + (user-id (match-string 2 string)) + (entry (assoc key-id epg-user-id-alist))) + (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 'import + (cons (list (cons 'key-id key-id) + (cons 'user-id user-id)) + (epg-context-result-for epg-context 'import)))))) + +(defun epg-status-IMPORT_OK (process string) + (let ((result (epg-context-result-for epg-context 'import))) + (if (and result + (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)) + (setcar result + (append (list (cons 'reason + (string-to-number + (match-string 1 string)))) + (if (match-beginning 2) + (list (cons 'fingerprint + (match-string 3 string)))) + (car result)))))) + +(defun epg-status-IMPORT_PROBLEM (process string) + (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string) + (epg-context-set-result-for + epg-context 'error + (cons (cons 'import-problem + (append (list (cons 'reason + (string-to-number + (match-string 1 string)))) + (if (match-beginning 2) + (list (cons 'fingerprint + (match-string 3 string)))))) + (epg-context-result-for epg-context 'error))))) + (defun epg-passphrase-callback-function (context key-id handback) - (read-passwd - (if (eq key-id 'SYM) - "Passphrase for symmetric encryption: " + (if (eq key-id 'SYM) + (read-passwd "Passphrase for symmetric encryption: " + (eq (epg-context-operation context) 'encrypt)) + (read-passwd (if (eq key-id 'PIN) - "Passphrase for PIN: " + "Passphrase for PIN: " (let ((entry (assoc key-id epg-user-id-alist))) (if entry (format "Passphrase for %s %s: " key-id (cdr entry)) @@ -1179,11 +1315,11 @@ This function is for internal use only." (let ((args (append (list "--with-colons" "--no-greeting" "--batch" "--with-fingerprint" "--with-fingerprint" - (if (or (eq mode t) (eq mode 'secret)) + (if (memq mode '(t secret)) "--list-secret-keys" - (if mode - "--list-sigs" - "--list-keys"))) + (if (memq mode '(nil public)) + "--list-keys" + "--list-sigs"))) (unless (eq (epg-context-protocol context) 'CMS) '("--fixed-list-mode")) (if name (list name)))) @@ -1221,37 +1357,18 @@ This function is for internal use only." (aref line 5) (aref line 6))) -(defun epg-list-keys-postprocess-one-key (key) - (let (key-id user-id-string entry) - (epg-key-set-sub-key-list - key - (nreverse (epg-key-sub-key-list key))) - (epg-key-set-user-id-list - key - (nreverse (epg-key-user-id-list key))) - (setq key-id - (epg-sub-key-id (car (epg-key-sub-key-list key))) - user-id-string - (epg-user-id-string (car (epg-key-user-id-list key))) - entry (assoc key-id epg-user-id-alist)) - (if entry - (setcdr entry user-id-string) - (setq epg-user-id-alist (cons (cons key-id user-id-string) - epg-user-id-alist))))) - +;;;###autoload (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 nil or 'public, 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) + keys cert pointer pointer-1) (while lines (cond ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs")) - (if (car keys) - (epg-list-keys-postprocess-one-key (car keys))) (setq cert (member (aref (car lines) 0) '("crt" "crs")) keys (cons (epg-make-key (if (aref (car lines) 8) @@ -1282,11 +1399,41 @@ signatures should be included." (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)))) + (aref (car lines) 9))) + ((equal (aref (car lines) 0) "sig") + (epg-user-id-set-signature-list + (car (epg-key-user-id-list (car keys))) + (cons + (epg-make-key-signature + (if (aref (car lines) 1) + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist))) + (string-to-number (aref (car lines) 3)) + (aref (car lines) 4) + (aref (car lines) 5) + (aref (car lines) 6) + (aref (car lines) 9) + (string-to-number (aref (car lines) 10) 16) + (eq (aref (aref (car lines) 10) 2) ?x)) + (epg-user-id-signature-list + (car (epg-key-user-id-list (car keys)))))))) (setq lines (cdr lines))) - (if (car keys) - (epg-list-keys-postprocess-one-key (car keys))) - (nreverse keys))) + (setq keys (nreverse keys) + pointer keys) + (while pointer + (epg-key-set-sub-key-list + (car pointer) + (nreverse (epg-key-sub-key-list (car pointer)))) + (setq pointer-1 (epg-key-set-user-id-list + (car pointer) + (nreverse (epg-key-user-id-list (car pointer))))) + (while pointer-1 + (epg-user-id-set-signature-list + (car pointer-1) + (nreverse (epg-user-id-signature-list (car pointer-1)))) + (setq pointer-1 (cdr pointer-1))) + (setq pointer (cdr pointer))) + keys)) (if (fboundp 'make-temp-file) (defalias 'epg-make-temp-file 'make-temp-file) @@ -1366,6 +1513,7 @@ If you are unsure, use synchronous version of this function `epg-decrypt-file' or `epg-decrypt-string' instead." (unless (epg-data-file cipher) (error "Not a file")) + (epg-context-set-operation context 'decrypt) (epg-context-set-result context nil) (epg-start context (list "--decrypt" (epg-data-file cipher))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. @@ -1427,6 +1575,7 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporaly output file. If you are unsure, use synchronous version of this function `epg-verify-file' or `epg-verify-string' instead." + (epg-context-set-operation context 'verify) (epg-context-set-result context nil) (if signed-text ;; Detached signature. @@ -1524,11 +1673,12 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporaly output file. If you are unsure, use synchronous version of this function `epg-sign-file' or `epg-sign-string' instead." + (epg-context-set-operation context 'sign) (epg-context-set-result context nil) (epg-start context - (append (list (if (or (eq mode t) (eq mode 'detached)) + (append (list (if (memq mode '(t detached)) "--detach-sign" - (if (or (null mode) (eq mode 'normal)) + (if (memq mode '(nil normal)) "--sign" "--clearsign"))) (apply #'nconc @@ -1609,6 +1759,7 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporaly output file. If you are unsure, use synchronous version of this function `epg-encrypt-file' or `epg-encrypt-string' instead." + (epg-context-set-operation context 'encrypt) (epg-context-set-result context nil) (epg-start context (append (if always-trust '("--always-trust")) @@ -1704,6 +1855,7 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporaly output file. If you are unsure, use synchronous version of this function `epg-export-keys-to-file' or `epg-export-keys-to-string' instead." + (epg-context-set-operation context 'export-keys) (epg-context-set-result context nil) (epg-start context (cons "--export" (mapcar @@ -1747,8 +1899,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporaly output file. 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-operation context 'import-keys) (epg-context-set-result context nil) - (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start context (list "--import" (epg-data-file keys))) (when (epg-data-string keys) (if (eq (process-status (epg-context-process context)) 'run) @@ -1764,8 +1916,7 @@ If you are unsure, use synchronous version of this function (epg-wait-for-completion context) (if (epg-context-result-for context 'error) (error "Import keys failed: %S" - (epg-context-result-for context 'error))) - (epg-read-output context)) + (epg-context-result-for context 'error)))) (epg-reset context))) ;;;###autoload @@ -1779,6 +1930,36 @@ If you are unsure, use synchronous version of this function (epg-import-keys-1 context (epg-make-data-from-string keys))) ;;;###autoload +(defun epg-start-receive-keys (context key-id-list) + "Initiate a receive key operation. +KEY-ID-LIST is a list of key IDs. + +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-generate-key-from-file' or `epg-generate-key-from-string' instead." + (epg-context-set-operation context 'receive-keys) + (epg-context-set-result context nil) + (epg-start context (cons "--recv-keys" key-id-list))) + +;;;###autoload +(defun epg-receive-keys (context keys) + "Add keys from server. +KEYS is a list of key IDs" + (unwind-protect + (progn + (epg-start-receive-keys context keys) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Receive keys failed: %S" + (epg-context-result-for context 'error)))) + (epg-reset context))) + +;;;###autoload +(defalias 'epg-import-keys-from-server 'epg-receive-keys) + +;;;###autoload (defun epg-start-delete-keys (context keys &optional allow-secret) "Initiate an delete keys operation. @@ -1787,6 +1968,7 @@ If you use this function, you will need to wait for the completion of `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-operation context 'delete-keys) (epg-context-set-result context nil) (epg-start context (cons (if allow-secret "--delete-secret-key" @@ -1818,6 +2000,7 @@ If you use this function, you will need to wait for the completion of `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-operation context 'sign-keys) (epg-context-set-result context nil) (epg-start context (cons (if local "--lsign-key" @@ -1850,6 +2033,7 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporaly output file. If you are unsure, use synchronous version of this function `epg-generate-key-from-file' or `epg-generate-key-from-string' instead." + (epg-context-set-operation context 'generate-key) (epg-context-set-result context nil) (if (epg-data-file parameters) (epg-start context (list "--batch" "--genkey"