X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=a9efba44b62d9b5f0edb04b2a60999c2a319e08f;hb=f7892090a54f15ec9badb293c5bef1beff5089ea;hp=85bb3fa52c92ba4066f2a4192b53fa0a030f1d2d;hpb=c1babcf7986279159bdb80e02726adf8c96cae83;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index 85bb3fa..a9efba4 100644 --- a/epg.el +++ b/epg.el @@ -33,6 +33,7 @@ (defvar epg-user-id-alist nil "An alist mapping from key ID to user ID.") +(defvar epg-last-status nil) (defvar epg-read-point nil) (defvar epg-process-filter-running nil) (defvar epg-pending-status-list nil) @@ -158,6 +159,8 @@ (defvar epg-prompt-alist nil) +(put 'epg-error 'error-conditions '(epg-error error)) + (defun epg-make-data-from-file (file) "Make a data object from FILE." (cons 'epg-data (vector file nil))) @@ -168,13 +171,13 @@ (defun epg-data-file (data) "Return the file of DATA." - (unless (eq (car data) 'epg-data) + (unless (eq (car-safe 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." - (unless (eq (car data) 'epg-data) + (unless (eq (car-safe data) 'epg-data) (signal 'wrong-type-argument (list 'epg-data-p data))) (aref (cdr data) 1)) @@ -187,306 +190,338 @@ cipher-algorithm digest-algorithm compress-algorithm #'epg-passphrase-callback-function nil - nil nil nil nil nil))) + nil nil nil nil nil nil))) (defun epg-context-protocol (context) "Return the protocol used within CONTEXT." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) (aref (cdr context) 9)) +(defun epg-context-sig-notations (context) + "Return the list of notations for singning." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 10)) + (defun epg-context-process (context) "Return the process object of `epg-gpg-program'. This function is for internal use only." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 10)) + (aref (cdr context) 11)) (defun epg-context-output-file (context) "Return the output file of `epg-gpg-program'. This function is for internal use only." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 11)) + (aref (cdr context) 12)) (defun epg-context-result (context) "Return the result of the previous cryptographic operation." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 12)) + (aref (cdr context) 13)) (defun epg-context-operation (context) "Return the name of the current cryptographic operation." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 13)) + (aref (cdr context) 14)) (defun epg-context-set-protocol (context protocol) "Set the protocol used within CONTEXT." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) +(defun epg-context-set-passphrase-callback (context passphrase-callback + &optional handback) + "Set the function used to query passphrase. +If optional argument HANDBACK is specified, it is passed to CALLBACK." + (unless (eq (car-safe 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." - (unless (eq (car context) 'epg-context) + (aset (cdr context) 7 (if handback + (cons passphrase-callback handback) + passphrase-callback))) + +(defun epg-context-set-progress-callback (context progress-callback + &optional handback) + "Set the function which handles progress update. +If optional argument HANDBACK is specified, it is passed to CALLBACK." + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 8 progress-callback)) + (aset (cdr context) 8 (if handback + (cons progress-callback handback) + progress-callback))) (defun epg-context-set-signers (context signers) - "Set the list of key-id for singning." - (unless (eq (car context) 'epg-context) + "Set the list of key-id for singning." + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) (aset (cdr context) 9 signers)) +(defun epg-context-set-sig-notations (context notations) + "Set the list of notations for singning." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 10 notations)) + (defun epg-context-set-process (context process) "Set the process object of `epg-gpg-program'. This function is for internal use only." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 10 process)) + (aset (cdr context) 11 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." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 11 output-file)) + (aset (cdr context) 12 output-file)) (defun epg-context-set-result (context result) "Set the result of the previous cryptographic operation." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 12 result)) + (aset (cdr context) 13 result)) (defun epg-context-set-operation (context operation) "Set the name of the current cryptographic operation." - (unless (eq (car context) 'epg-context) + (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 13 operation)) + (aset (cdr context) 14 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))) + (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil + nil))) (defun epg-signature-status (signature) "Return the status code of SIGNATURE." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe 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." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aref (cdr signature) 1)) (defun epg-signature-validity (signature) "Return the validity of SIGNATURE." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe 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." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aref (cdr signature) 7)) (defun epg-signature-class (signature) "Return the class of SIGNATURE." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aref (cdr signature) 8)) (defun epg-signature-version (signature) "Return the version of SIGNATURE." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aref (cdr signature) 9)) +(defun epg-sig-notations (signature) + "Return the list of notations of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 10)) + (defun epg-signature-set-status (signature status) "Set the status code of SIGNATURE." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe 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." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aset (cdr signature) 1 key-id)) (defun epg-signature-set-validity (signature validity) "Set the validity of SIGNATURE." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe 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." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aset (cdr signature) 7 digest-algorithm)) (defun epg-signature-set-class (signature class) "Set the class of SIGNATURE." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aset (cdr signature) 8 class)) (defun epg-signature-set-version (signature version) "Set the version of SIGNATURE." - (unless (eq (car signature) 'epg-signature) + (unless (eq (car-safe signature) 'epg-signature) (signal 'wrong-type-argument (list 'epg-signature-p signature))) (aset (cdr signature) 9 version)) +(defun epg-signature-set-notations (signature notations) + "Set the list of notations of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 10 notations)) + (defun epg-make-new-signature (type pubkey-algorithm digest-algorithm class creation-time fingerprint) "Return a new signature object." @@ -495,37 +530,37 @@ This function is for internal use only." (defun epg-new-signature-type (new-signature) "Return the type of NEW-SIGNATURE." - (unless (eq (car new-signature) 'epg-new-signature) + (unless (eq (car-safe new-signature) 'epg-new-signature) (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) (aref (cdr new-signature) 0)) (defun epg-new-signature-pubkey-algorithm (new-signature) "Return the public key algorithm of NEW-SIGNATURE." - (unless (eq (car new-signature) 'epg-new-signature) + (unless (eq (car-safe new-signature) 'epg-new-signature) (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) (aref (cdr new-signature) 1)) (defun epg-new-signature-digest-algorithm (new-signature) "Return the digest algorithm of NEW-SIGNATURE." - (unless (eq (car new-signature) 'epg-new-signature) + (unless (eq (car-safe new-signature) 'epg-new-signature) (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) (aref (cdr new-signature) 2)) (defun epg-new-signature-class (new-signature) "Return the class of NEW-SIGNATURE." - (unless (eq (car new-signature) 'epg-new-signature) + (unless (eq (car-safe new-signature) 'epg-new-signature) (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) (aref (cdr new-signature) 3)) (defun epg-new-signature-creation-time (new-signature) "Return the creation time of NEW-SIGNATURE." - (unless (eq (car new-signature) 'epg-new-signature) + (unless (eq (car-safe new-signature) 'epg-new-signature) (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) (aref (cdr new-signature) 4)) (defun epg-new-signature-fingerprint (new-signature) "Return the fingerprint of NEW-SIGNATURE." - (unless (eq (car new-signature) 'epg-new-signature) + (unless (eq (car-safe new-signature) 'epg-new-signature) (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) (aref (cdr new-signature) 5)) @@ -535,31 +570,31 @@ This function is for internal use only." (defun epg-key-owner-trust (key) "Return the owner trust of KEY." - (unless (eq (car key) 'epg-key) + (unless (eq (car-safe 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." - (unless (eq (car key) 'epg-key) + (unless (eq (car-safe 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." - (unless (eq (car key) 'epg-key) + (unless (eq (car-safe 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." - (unless (eq (car key) 'epg-key) + (unless (eq (car-safe 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." - (unless (eq (car key) 'epg-key) + (unless (eq (car-safe key) 'epg-key) (signal 'wrong-type-argument (list 'epg-key-p key))) (aset (cdr key) 2 user-id-list)) @@ -572,62 +607,62 @@ This function is for internal use only." (defun epg-sub-key-validity (sub-key) "Return the validity of SUB-KEY." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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-p (sub-key) "Return non-nil if SUB-KEY is a secret key." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe 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." - (unless (eq (car sub-key) 'epg-sub-key) + (unless (eq (car-safe sub-key) 'epg-sub-key) (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) (aset (cdr sub-key) 8 fingerprint)) @@ -637,25 +672,25 @@ This function is for internal use only." (defun epg-user-id-validity (user-id) "Return the validity of USER-ID." - (unless (eq (car user-id) 'epg-user-id) + (unless (eq (car-safe 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-string (user-id) "Return the name of USER-ID." - (unless (eq (car user-id) 'epg-user-id) + (unless (eq (car-safe 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." - (unless (eq (car user-id) 'epg-user-id) + (unless (eq (car-safe 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." - (unless (eq (car user-id) 'epg-user-id) + (unless (eq (car-safe user-id) 'epg-user-id) (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) (aset (cdr user-id) 2 signature-list)) @@ -669,52 +704,237 @@ This function is for internal use only." (defun epg-key-signature-validity (key-signature) "Return the validity of KEY-SIGNATURE." - (unless (eq (car key-signature) 'epg-key-signature) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe 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) + (unless (eq (car-safe key-signature) 'epg-key-signature) (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) (aref (cdr key-signature) 7)) +(defun epg-make-sig-notation (name value &optional human-readable + critical) + "Return a notation object." + (cons 'epg-sig-notation (vector name value human-readable critical))) + +(defun epg-sig-notation-name (sig-notation) + "Return the name of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aref (cdr sig-notation) 0)) + +(defun epg-sig-notation-value (sig-notation) + "Return the value of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aref (cdr sig-notation) 1)) + +(defun epg-sig-notation-human-readable (sig-notation) + "Return the human-readable of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aref (cdr sig-notation) 2)) + +(defun epg-sig-notation-critical (sig-notation) + "Return the critical of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aref (cdr sig-notation) 3)) + +(defun epg-sig-notation-set-value (sig-notation value) + "Set the value of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aset (cdr sig-notation) 1 value)) + +(defun epg-make-import-status (fingerprint &optional reason new user-id + signature sub-key secret) + "Return a import status object." + (cons 'epg-import-status (vector fingerprint reason new user-id signature + sub-key secret))) + +(defun epg-import-status-fingerprint (import-status) + "Return the fingerprint of the key that was considered." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 0)) + +(defun epg-import-status-reason (import-status) + "Return the reason code for import failure." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 1)) + +(defun epg-import-status-new (import-status) + "Return t if the imported key was new." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 2)) + +(defun epg-import-status-user-id (import-status) + "Return t if the imported key contained new user IDs." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 3)) + +(defun epg-import-status-signature (import-status) + "Return t if the imported key contained new signatures." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 4)) + +(defun epg-import-status-sub-key (import-status) + "Return t if the imported key contained new sub keys." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 5)) + +(defun epg-import-status-secret (import-status) + "Return t if the imported key contained a secret key." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 6)) + +(defun epg-make-import-result (considered no-user-id imported imported-rsa + unchanged new-user-ids new-sub-keys + new-signatures new-revocations + secret-read secret-imported + secret-unchanged not-imported + imports) + "Return a import result object." + (cons 'epg-import-result (vector considered no-user-id imported imported-rsa + unchanged new-user-ids new-sub-keys + new-signatures new-revocations secret-read + secret-imported secret-unchanged + not-imported imports))) + +(defun epg-import-result-considered (import-result) + "Return the total number of considered keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 0)) + +(defun epg-import-result-no-user-id (import-result) + "Return the number of keys without user ID." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 1)) + +(defun epg-import-result-imported (import-result) + "Return the number of imported keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 2)) + +(defun epg-import-result-imported-rsa (import-result) + "Return the number of imported RSA keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 3)) + +(defun epg-import-result-unchanged (import-result) + "Return the number of unchanged keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 4)) + +(defun epg-import-result-new-user-ids (import-result) + "Return the number of new user IDs." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 5)) + +(defun epg-import-result-new-sub-keys (import-result) + "Return the number of new sub keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 6)) + +(defun epg-import-result-new-signatures (import-result) + "Return the number of new signatures." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 7)) + +(defun epg-import-result-new-revocations (import-result) + "Return the number of new revocations." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 8)) + +(defun epg-import-result-secret-read (import-result) + "Return the total number of secret keys read." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 9)) + +(defun epg-import-result-secret-imported (import-result) + "Return the number of imported secret keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 10)) + +(defun epg-import-result-secret-unchanged (import-result) + "Return the number of unchanged secret keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 11)) + +(defun epg-import-result-not-imported (import-result) + "Return the number of keys not imported." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 12)) + +(defun epg-import-result-imports (import-result) + "Return the list of `epg-import-status' objects." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 13)) + (defun epg-context-result-for (context name) "Return the result of CONTEXT associated with NAME." (cdr (assq name (epg-context-result context)))) @@ -729,8 +949,9 @@ This function is for internal use only." (defun epg-signature-to-string (signature) "Convert SIGNATURE to a human readable string." - (let ((user-id (cdr (assoc (epg-signature-key-id signature) - epg-user-id-alist)))) + (let* ((user-id (cdr (assoc (epg-signature-key-id signature) + epg-user-id-alist))) + (pubkey-algorithm (epg-signature-pubkey-algorithm signature))) (concat (cond ((eq (epg-signature-status signature) 'good) "Good signature from ") @@ -753,6 +974,15 @@ This function is for internal use only." "") (if (epg-signature-validity signature) (format " (trust %s)" (epg-signature-validity signature)) + "") + (if (epg-signature-creation-time signature) + (format-time-string " created at %Y-%m-%dT%T%z" + (epg-signature-creation-time signature)) + "") + (if pubkey-algorithm + (concat " using " + (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist)) + (format "(unknown algorithm %d)" pubkey-algorithm))) "")))) (defun epg-verify-result-to-string (verify-result) @@ -765,7 +995,7 @@ This function is for internal use only." (cond ((eq (epg-new-signature-type new-signature) 'detached) "Detached signature ") ((eq (epg-new-signature-type new-signature) 'clear) - "Clear text signature ") + "Cleartext signature ") (t "Signature ")) (cdr (assq (epg-new-signature-pubkey-algorithm new-signature) @@ -777,6 +1007,49 @@ This function is for internal use only." (format "%02X " (epg-new-signature-class new-signature)) (epg-new-signature-fingerprint new-signature))) +(defun epg-import-result-to-string (import-result) + "Convert IMPORT-RESULT to a human readable string." + (concat (format "Total number processed: %d\n" + (epg-import-result-considered import-result)) + (if (> (epg-import-result-not-imported import-result) 0) + (format " skipped new keys: %d\n" + (epg-import-result-not-imported import-result))) + (if (> (epg-import-result-no-user-id import-result) 0) + (format " w/o user IDs: %d\n" + (epg-import-result-no-user-id import-result))) + (if (> (epg-import-result-imported import-result) 0) + (concat (format " imported: %d" + (epg-import-result-imported import-result)) + (if (> (epg-import-result-imported-rsa import-result) 0) + (format " (RSA: %d)" + (epg-import-result-imported-rsa + import-result))) + "\n")) + (if (> (epg-import-result-unchanged import-result) 0) + (format " unchanged: %d\n" + (epg-import-result-unchanged import-result))) + (if (> (epg-import-result-new-user-ids import-result) 0) + (format " new user IDs: %d\n" + (epg-import-result-new-user-ids import-result))) + (if (> (epg-import-result-new-sub-keys import-result) 0) + (format " new subkeys: %d\n" + (epg-import-result-new-sub-keys import-result))) + (if (> (epg-import-result-new-signatures import-result) 0) + (format " new signatures: %d\n" + (epg-import-result-new-signatures import-result))) + (if (> (epg-import-result-new-revocations import-result) 0) + (format " new key revocations: %d\n" + (epg-import-result-new-revocations import-result))) + (if (> (epg-import-result-secret-read import-result) 0) + (format " secret keys read: %d\n" + (epg-import-result-secret-read import-result))) + (if (> (epg-import-result-secret-imported import-result) 0) + (format " secret keys imported: %d\n" + (epg-import-result-secret-imported import-result))) + (if (> (epg-import-result-secret-unchanged import-result) 0) + (format " secret keys unchanged: %d\n" + (epg-import-result-secret-unchanged import-result))))) + (defun epg--start (context args) "Start `epg-gpg-program' in a subprocess with given ARGS." (if (and (epg-context-process context) @@ -788,12 +1061,17 @@ This function is for internal use only." (let* ((args (append (list "--no-tty" "--status-fd" "1" "--yes") - (if (epg-context-progress-callback context) - (list "--enable-progress-filter")) + (if (and (not (eq (epg-context-protocol context) 'CMS)) + (string-match ":" (or (getenv "GPG_AGENT_INFO") + ""))) + '("--use-agent")) + (if (and (not (eq (epg-context-protocol context) 'CMS)) + (epg-context-progress-callback context)) + '("--enable-progress-filter")) (if epg-gpg-home-directory (list "--homedir" epg-gpg-home-directory)) (unless (eq (epg-context-protocol context) 'CMS) - (list "--command-fd" "0")) + '("--command-fd" "0")) (if (epg-context-armor context) '("--armor")) (if (epg-context-textmode context) '("--textmode")) (if (epg-context-output-file context) @@ -816,6 +1094,8 @@ This function is for internal use only." epg-gpg-program) (mapconcat #'identity args " "))))) (with-current-buffer buffer + (make-local-variable 'epg-last-status) + (setq epg-last-status nil) (make-local-variable 'epg-read-point) (setq epg-read-point (point-min)) (make-local-variable 'epg-process-filter-running) @@ -868,7 +1148,8 @@ This function is for internal use only." (setq epg-pending-status-list nil)) (if (and symbol (fboundp symbol)) - (funcall symbol epg-context string)))) + (funcall symbol epg-context string)) + (setq epg-last-status (cons status string)))) (forward-line) (setq epg-read-point (point)))) (setq epg-process-filter-running nil)))))) @@ -957,9 +1238,10 @@ This function is for internal use only." (if epg-passphrase-coding-system (progn (setq encoded-passphrase-with-new-line - (encode-coding-string + (epg--encode-coding-string passphrase-with-new-line - epg-passphrase-coding-system)) + (coding-system-change-eol-conversion + epg-passphrase-coding-system 'unix))) (epg--clear-string passphrase-with-new-line) (setq passphrase-with-new-line nil)) (setq encoded-passphrase-with-new-line @@ -980,13 +1262,24 @@ This function is for internal use only." (if encoded-passphrase-with-new-line (epg--clear-string encoded-passphrase-with-new-line)))))) +(defun epg--prompt-GET_BOOL (context string) + (let ((entry (assoc string epg-prompt-alist))) + (y-or-n-p (if entry (cdr entry) (concat string "? "))))) + +(defun epg--prompt-GET_BOOL-untrusted_key.override (context string) + (y-or-n-p (if (equal (car epg-last-status) "USERID_HINT") + (format "Untrusted key %s. Use anyway? " + (cdr epg-last-status)) + "Use untrusted key anyway? "))) + (defun epg--status-GET_BOOL (context string) - (let ((entry (assoc string epg-prompt-alist)) - inhibit-quit) + (let (inhibit-quit) (condition-case nil - (if (y-or-n-p (if entry (cdr entry) (concat string "? "))) - (process-send-string (epg-context-process context) "y\n") - (process-send-string (epg-context-process context) "n\n")) + (if (funcall (or (intern-soft (concat "epg--prompt-GET_BOOL-" string)) + #'epg--prompt-GET_BOOL) + context string) + (process-send-string (epg-context-process context) "y\n") + (process-send-string (epg-context-process context) "n\n")) (quit (epg-context-set-result-for context 'error @@ -1102,9 +1395,10 @@ This function is for internal use only." (epg-signature-set-creation-time signature (epg--time-from-seconds (match-string 2 string))) - (epg-signature-set-expiration-time - signature - (epg--time-from-seconds (match-string 3 string))) + (unless (equal (match-string 3 string) "0") + (epg-signature-set-expiration-time + signature + (epg--time-from-seconds (match-string 3 string)))) (epg-signature-set-version signature (string-to-number (match-string 4 string))) @@ -1148,9 +1442,33 @@ This function is for internal use only." (eq (epg-signature-status signature) 'good)) (epg-signature-set-validity signature 'ultimate)))) +(defun epg--status-NOTATION_NAME (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if signature + (epg-signature-set-notations + signature + (cons (epg-make-sig-notation string nil t nil) + (epg-sig-notations signature)))))) + +(defun epg--status-NOTATION_DATA (context string) + (let ((signature (car (epg-context-result-for context 'verify))) + notation) + (if (and signature + (setq notation (car (epg-sig-notations signature)))) + (epg-sig-notation-set-value notation string)))) + +(defun epg--status-POLICY_URL (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if signature + (epg-signature-set-notations + signature + (cons (epg-make-sig-notation nil string t nil) + (epg-sig-notations signature)))))) + (defun epg--status-PROGRESS (context string) - (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)" - string) + (if (and (epg-context-progress-callback context) + (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)" + string)) (funcall (if (consp (epg-context-progress-callback context)) (car (epg-context-progress-callback context)) (epg-context-progress-callback context)) @@ -1163,21 +1481,21 @@ This function is for internal use only." (cdr (epg-context-progress-callback context)))))) (defun epg--status-DECRYPTION_FAILED (context string) - (epg-context-set-result-for - context 'error - (cons '(decryption-failed) - (epg-context-result-for context 'error)))) + (epg-context-set-result-for context 'decryption-failed t)) + +(defun epg--status-DECRYPTION_OKAY (context string) + (epg-context-set-result-for context 'decryption-okay t)) (defun epg--status-NODATA (context string) (epg-context-set-result-for context 'error - (cons (list 'no-data (cons 'reason (string-to-number string))) + (cons (cons 'no-data (string-to-number string)) (epg-context-result-for context 'error)))) (defun epg--status-UNEXPECTED (context string) (epg-context-set-result-for context 'error - (cons (list 'unexpected (cons 'reason (string-to-number string))) + (cons (cons 'unexpected (string-to-number string)) (epg-context-result-for context 'error)))) (defun epg--status-KEYEXPIRED (context string) @@ -1220,8 +1538,8 @@ This function is for internal use only." (if (string-match "\\`\\([0-9]+\\)" string) (epg-context-set-result-for context 'error - (cons (list 'delete-problem - (cons 'reason (string-to-number (match-string 1 string)))) + (cons (cons 'delete-problem + (string-to-number (match-string 1 string))) (epg-context-result-for context 'error))))) (defun epg--status-SIG_CREATED (context string) @@ -1261,38 +1579,54 @@ This function is for internal use only." (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 - context 'import - (cons (list (cons 'key-id key-id) - (cons 'user-id user-id)) - (epg-context-result-for context 'import)))))) + epg-user-id-alist)))))) (defun epg--status-IMPORT_OK (context string) - (let ((result (epg-context-result-for 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)))))) + (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string) + (let ((reason (string-to-number (match-string 1 string)))) + (epg-context-set-result-for + context 'import-status + (cons (epg-make-import-status (if (match-beginning 2) + (match-string 3 string)) + nil + (/= (logand reason 1) 0) + (/= (logand reason 2) 0) + (/= (logand reason 4) 0) + (/= (logand reason 8) 0) + (/= (logand reason 16) 0)) + (epg-context-result-for context 'import-status)))))) (defun epg--status-IMPORT_PROBLEM (context string) (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string) (epg-context-set-result-for - 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 context 'error))))) + context 'import-status + (cons (epg-make-import-status + (if (match-beginning 2) + (match-string 3 string)) + (string-to-number (match-string 1 string))) + (epg-context-result-for context 'import-status))))) + +(defun epg--status-IMPORT_RES (context string) + (when (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \ +\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \ +\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string) + (epg-context-set-result-for + context 'import + (epg-make-import-result (string-to-number (match-string 1 string)) + (string-to-number (match-string 2 string)) + (string-to-number (match-string 3 string)) + (string-to-number (match-string 4 string)) + (string-to-number (match-string 5 string)) + (string-to-number (match-string 6 string)) + (string-to-number (match-string 7 string)) + (string-to-number (match-string 8 string)) + (string-to-number (match-string 9 string)) + (string-to-number (match-string 10 string)) + (string-to-number (match-string 11 string)) + (string-to-number (match-string 12 string)) + (string-to-number (match-string 13 string)) + (epg-context-result-for context 'import-status))) + (epg-context-set-result-for context 'import-status nil))) (defun epg-passphrase-callback-function (context key-id handback) (if (eq key-id 'SYM) @@ -1306,11 +1640,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 (context what char current total - handback) - (message "%s: %d%% (%d/%d)" what - (if (> total 0) (floor (* (/ current (float total)) 100)) 0) - current total)) +(make-obsolete 'epg-passphrase-callback-function + 'epa-passphrase-callback-function) (defun epg--list-keys-1 (context name mode) (let ((args (append (if epg-gpg-home-directory @@ -1358,7 +1689,8 @@ This function is for internal use only." (string-to-number (aref line 2)) (aref line 4) (epg--time-from-seconds (aref line 5)) - (epg--time-from-seconds (aref line 6)))) + (if (aref line 6) + (epg--time-from-seconds (aref line 6))))) ;;;###autoload (defun epg-list-keys (context &optional name mode) @@ -1497,6 +1829,30 @@ You can then use `write-region' to write new data into the file." (defun epg--clear-string (string) (fillarray string 0))) +(if (fboundp 'encode-coding-string) + (defalias 'epg--encode-coding-string 'encode-coding-string) + (defalias 'epg--encode-coding-string 'identity)) + +(defun epg--args-from-sig-notations (notations) + (apply #'nconc + (mapcar + (lambda (notation) + (if (and (epg-sig-notation-name notation) + (not (epg-sig-notation-human-readable notation))) + (error "Unreadable")) + (if (epg-sig-notation-name notation) + (list "--sig-notation" + (if (epg-sig-notation-critical notation) + (concat "!" (epg-sig-notation-name notation) + "=" (epg-sig-notation-value notation)) + (concat (epg-sig-notation-name notation) + "=" (epg-sig-notation-value notation)))) + (list "--sig-policy-url" + (if (epg-sig-notation-critical notation) + (concat "!" (epg-sig-notation-value notation)) + (epg-sig-notation-value notation))))) + notations))) + ;;;###autoload (defun epg-cancel (context) (if (buffer-live-p (process-buffer (epg-context-process context))) @@ -1508,7 +1864,7 @@ You can then use `write-region' to write new data into the file." (epg-context-result-for epg-context 'error))))) (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. @@ -1528,6 +1884,19 @@ If you are unsure, use synchronous version of this function (unless (eq (epg-context-protocol context) 'CMS) (epg-wait-for-status context '("BEGIN_DECRYPTION")))) +(defun epg--check-error-for-decrypt (context) + (if (epg-context-result-for context 'decryption-failed) + (signal 'epg-error (list "Decryption failed"))) + (if (epg-context-result-for context 'no-secret-key) + (signal 'epg-error + (list "No secret key" + (epg-context-result-for context 'no-secret-key)))) + (unless (epg-context-result-for context 'decryption-okay) + (let* ((error (epg-context-result-for context 'error))) + (if (assq 'no-data error) + (signal 'epg-error (list "No data"))) + (signal 'epg-error (list "Can't decrypt" error))))) + ;;;###autoload (defun epg-decrypt-file (context cipher plain) "Decrypt a file CIPHER and store the result to a file PLAIN. @@ -1540,9 +1909,7 @@ If PLAIN is nil, it returns the result as a string." (epg--make-temp-file "epg-output"))) (epg-start-decrypt context (epg-make-data-from-file cipher)) (epg-wait-for-completion context) - (if (epg-context-result-for context 'error) - (error "Decrypt failed: %S" - (epg-context-result-for context 'error))) + (epg--check-error-for-decrypt context) (unless plain (epg-read-output context))) (unless plain @@ -1561,9 +1928,7 @@ If PLAIN is nil, it returns the result as a string." (epg--make-temp-file "epg-output")) (epg-start-decrypt context (epg-make-data-from-file input-file)) (epg-wait-for-completion context) - (if (epg-context-result-for context 'error) - (error "Decrypt failed: %S" - (epg-context-result-for context 'error))) + (epg--check-error-for-decrypt context) (epg-read-output context)) (epg-delete-output-file context) (if (file-exists-p input-file) @@ -1576,7 +1941,7 @@ If PLAIN is nil, it returns the result as a string." SIGNATURE and SIGNED-TEXT are a data object if they are specified. For a detached signature, both SIGNATURE and SIGNED-TEXT should be set. -For a normal or a clear text signature, SIGNED-TEXT should be nil. +For a normal or a cleartext signature, SIGNED-TEXT should be nil. 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 @@ -1599,8 +1964,8 @@ If you are unsure, use synchronous version of this function (process-send-eof (epg-context-process context)))) ;; Normal (or cleartext) signature. (if (epg-data-file signature) - (epg--start context (list "--verify" "--" (epg-data-file signature))) - (epg--start context (list "--verify")) + (epg--start context (list "--" (epg-data-file signature))) + (epg--start context '("-")) (if (eq (process-status (epg-context-process context)) 'run) (process-send-string (epg-context-process context) (epg-data-string signature))) @@ -1612,8 +1977,10 @@ If you are unsure, use synchronous version of this function "Verify a file SIGNATURE. SIGNED-TEXT and PLAIN are also a file if they are specified. -For a detached signature, both SIGNATURE and SIGNED-TEXT should be string. -For a normal or a clear text signature, SIGNED-TEXT should be nil." +For a detached signature, both SIGNATURE and SIGNED-TEXT should be +string. For a normal or a cleartext signature, SIGNED-TEXT should be +nil. In the latter case, if PLAIN is specified, the plaintext is +stored into the file after successful verification." (unwind-protect (progn (if plain @@ -1627,9 +1994,6 @@ 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 @@ -1641,8 +2005,10 @@ For a normal or a clear text signature, SIGNED-TEXT should be nil." "Verify a string SIGNATURE. SIGNED-TEXT is a string if it is specified. -For a detached signature, both SIGNATURE and SIGNED-TEXT should be string. -For a normal or a clear text signature, SIGNED-TEXT should be nil." +For a detached signature, both SIGNATURE and SIGNED-TEXT should be +string. For a normal or a cleartext signature, SIGNED-TEXT should be +nil. In the latter case, this function returns the plaintext after +successful verification." (let ((coding-system-for-write 'binary) input-file) (unwind-protect @@ -1658,9 +2024,6 @@ For a normal or a clear text signature, SIGNED-TEXT should be nil." (epg-make-data-from-string signed-text))) (epg-start-verify context (epg-make-data-from-string signature))) (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 @@ -1675,7 +2038,7 @@ PLAIN is a data object. If optional 3rd argument MODE is t or 'detached, it makes a detached signature. If it is nil or 'normal, it makes a normal signature. -Otherwise, it makes a clear text signature. +Otherwise, it makes a cleartext signature. 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 @@ -1684,6 +2047,9 @@ 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) + (unless (memq mode '(t detached nil normal)) ;i.e. cleartext + (epg-context-set-armor context nil) + (epg-context-set-textmode context nil)) (epg--start context (append (list (if (memq mode '(t detached)) "--detach-sign" @@ -1697,6 +2063,8 @@ If you are unsure, use synchronous version of this function (epg-sub-key-id (car (epg-key-sub-key-list signer))))) (epg-context-signers context))) + (epg--args-from-sig-notations + (epg-context-sig-notations context)) (if (epg-data-file plain) (list "--" (epg-data-file plain))))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. @@ -1715,7 +2083,7 @@ If you are unsure, use synchronous version of this function If SIGNATURE is nil, it returns the result as a string. If optional 3rd argument MODE is t or 'detached, it makes a detached signature. If it is nil or 'normal, it makes a normal signature. -Otherwise, it makes a clear text signature." +Otherwise, it makes a cleartext signature." (unwind-protect (progn (if signature @@ -1740,21 +2108,38 @@ Otherwise, it makes a clear text signature." "Sign a string PLAIN and return the output as string. If optional 3rd argument MODE is t or 'detached, it makes a detached signature. If it is nil or 'normal, it makes a normal signature. -Otherwise, it makes a clear text signature." - (unwind-protect - (progn - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) - (epg-start-sign context (epg-make-data-from-string plain) mode) - (epg-wait-for-completion context) - (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))) +Otherwise, it makes a cleartext signature." + (let ((input-file + (unless (or (eq (epg-context-protocol context) 'CMS) + (condition-case nil + (progn + (epg-check-configuration (epg-configuration)) + t) + (error))) + (epg--make-temp-file "epg-input"))) + (coding-system-for-write 'binary)) + (unwind-protect + (progn + (epg-context-set-output-file context + (epg--make-temp-file "epg-output")) + (if input-file + (write-region plain nil input-file nil 'quiet)) + (epg-start-sign context + (if input-file + (epg-make-data-from-file input-file) + (epg-make-data-from-string plain)) + mode) + (epg-wait-for-completion context) + (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) + (if input-file + (delete-file input-file)) + (epg-reset context)))) ;;;###autoload (defun epg-start-encrypt (context plain recipients @@ -1773,16 +2158,19 @@ If you are unsure, use synchronous version of this function (epg--start context (append (if always-trust '("--always-trust")) (if recipients '("--encrypt") '("--symmetric")) + (if sign '("--sign")) + (if sign + (apply #'nconc + (mapcar + (lambda (signer) + (list "-u" + (epg-sub-key-id + (car (epg-key-sub-key-list + signer))))) + (epg-context-signers context)))) (if sign - (cons "--sign" - (apply #'nconc - (mapcar - (lambda (signer) - (list "-u" - (epg-sub-key-id - (car (epg-key-sub-key-list - signer))))) - (epg-context-signers context))))) + (epg--args-from-sig-notations + (epg-context-sig-notations context))) (apply #'nconc (mapcar (lambda (recipient) @@ -1839,25 +2227,42 @@ If RECIPIENTS is nil, it performs symmetric encryption." &optional sign always-trust) "Encrypt a string PLAIN. If RECIPIENTS is nil, it performs symmetric encryption." - (unwind-protect - (progn - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) - (epg-start-encrypt context (epg-make-data-from-string 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))) - (epg-read-output context)) - (epg-delete-output-file context) - (epg-reset context))) + (let ((input-file + (unless (or (not sign) + (eq (epg-context-protocol context) 'CMS) + (condition-case nil + (progn + (epg-check-configuration (epg-configuration)) + t) + (error))) + (epg--make-temp-file "epg-input"))) + (coding-system-for-write 'binary)) + (unwind-protect + (progn + (epg-context-set-output-file context + (epg--make-temp-file "epg-output")) + (if input-file + (write-region plain nil input-file nil 'quiet)) + (epg-start-encrypt context + (if input-file + (epg-make-data-from-file input-file) + (epg-make-data-from-string 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))) + (epg-read-output context)) + (epg-delete-output-file context) + (if input-file + (delete-file input-file)) + (epg-reset context)))) ;;;###autoload (defun epg-start-export-keys (context keys) @@ -1882,7 +2287,7 @@ If you are unsure, use synchronous version of this function "Extract public KEYS." (unwind-protect (progn - (if keys + (if file (epg-context-set-output-file context file) (epg-context-set-output-file context (epg--make-temp-file "epg-output"))) @@ -1988,11 +2393,11 @@ If you are unsure, use synchronous version of this function (epg--start context (cons (if allow-secret "--delete-secret-key" "--delete-key") - (mapcar - (lambda (key) - (epg-sub-key-id - (car (epg-key-sub-key-list key)))) - keys)))) + (mapcar + (lambda (key) + (epg-sub-key-id + (car (epg-key-sub-key-list key)))) + keys)))) ;;;###autoload (defun epg-delete-keys (context keys &optional allow-secret) @@ -2001,9 +2406,13 @@ If you are unsure, use synchronous version of this function (progn (epg-start-delete-keys context keys allow-secret) (epg-wait-for-completion context) - (if (epg-context-result-for context 'error) - (error "Delete keys failed: %S" - (epg-context-result-for context 'error)))) + (let ((entry (assq 'delete-problem + (epg-context-result-for context 'error)))) + (if entry + (if (setq entry (assq (cdr entry) + epg-delete-problem-reason-alist)) + (error "Delete keys failed: %s" (cdr entry)) + (error "Delete keys failed"))))) (epg-reset context))) ;;;###autoload @@ -2025,6 +2434,7 @@ If you are unsure, use synchronous version of this function (epg-sub-key-id (car (epg-key-sub-key-list key)))) keys)))) +(make-obsolete 'epg-start-sign-keys "Do not use.") ;;;###autoload (defun epg-sign-keys (context keys &optional local) @@ -2037,6 +2447,7 @@ If you are unsure, use synchronous version of this function (error "Sign keys failed: %S" (epg-context-result-for context 'error)))) (epg-reset context))) +(make-obsolete 'epg-sign-keys "Do not use.") ;;;###autoload (defun epg-start-generate-key (context parameters) @@ -2089,7 +2500,7 @@ PARAMETERS is a string which tells how to create the key." (defun epg--decode-hexstring (string) (let ((index 0)) (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index)) - (setq string (replace-match "\\x\\&" t nil string) + (setq string (replace-match "\\\\x\\&" t nil string) index (+ index 4))) (car (read-from-string (concat "\"" string "\""))))) @@ -2102,7 +2513,7 @@ PARAMETERS is a string which tells how to create the key." (setq string (replace-match "\\2" t nil string) index (1+ index)) (if (match-beginning 3) - (setq string (replace-match "\\x\\3" t nil string) + (setq string (replace-match "\\\\x\\3" t nil string) index (+ index 4)) (setq string (replace-match "\\\\\\\\\\4" t nil string) index (+ index 3)))))