X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=723c222d690029f5b9e70f6e5d9cc611932599cf;hb=HEAD;hp=4e16aab7a6e847e5de83651598a763fa78ccdc54;hpb=508812fedef46d9dfb81be908e11189cfbbf4e9b;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index 4e16aab..723c222 100644 --- a/epg.el +++ b/epg.el @@ -15,7 +15,7 @@ ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License @@ -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))) @@ -324,18 +327,25 @@ This function is for internal use only." (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." +(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 PASSPHRASE-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." + (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 PROGRESS-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." @@ -780,8 +790,8 @@ This function is for internal use only." sig-notation))) (aset (cdr sig-notation) 1 value)) -(defun epg-make-import-status (fingerprint reason new user-id signature sub-key - secret) +(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))) @@ -829,16 +839,17 @@ This function is for internal use only." (aref (cdr import-status) 6)) (defun epg-make-import-result (considered no-user-id imported imported-rsa - unchanged new-user-id new-sub-key - new-signature new-revocation + unchanged new-user-ids new-sub-keys + new-signatures new-revocations secret-read secret-imported - secret-unchanged not-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 nil))) + not-imported imports))) (defun epg-import-result-considered (import-result) "Return the total number of considered keys." @@ -938,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 ") @@ -962,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) @@ -986,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) @@ -997,18 +1061,24 @@ 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) (list "--output" (epg-context-output-file context))) args)) (coding-system-for-write 'binary) + (coding-system-for-read 'binary) process-connection-type (orig-mode (default-file-modes)) (buffer (generate-new-buffer " *epg*")) @@ -1025,6 +1095,10 @@ This function is for internal use only." epg-gpg-program) (mapconcat #'identity args " "))))) (with-current-buffer buffer + (if (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil)) + (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) @@ -1077,7 +1151,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)))))) @@ -1118,11 +1193,21 @@ This function is for internal use only." (file-exists-p (epg-context-output-file context))) (delete-file (epg-context-output-file context)))) +(eval-and-compile + (if (fboundp 'decode-coding-string) + (defalias 'epg--decode-coding-string 'decode-coding-string) + (defalias 'epg--decode-coding-string 'identity))) + (defun epg--status-USERID_HINT (context 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))) + (condition-case nil + (setq user-id (epg--decode-coding-string + (epg--decode-percent-escape user-id) + 'utf-8)) + (error)) (if entry (setcdr entry user-id) (setq epg-user-id-alist (cons (cons key-id user-id) @@ -1138,6 +1223,17 @@ This function is for internal use only." (defun epg--status-NEED_PASSPHRASE_PIN (context string) (setq epg-key-id 'PIN)) +(eval-and-compile + (if (fboundp 'clear-string) + (defalias 'epg--clear-string 'clear-string) + (defun epg--clear-string (string) + (fillarray string 0)))) + +(eval-and-compile + (if (fboundp 'encode-coding-string) + (defalias 'epg--encode-coding-string 'encode-coding-string) + (defalias 'epg--encode-coding-string 'identity))) + (defun epg--status-GET_HIDDEN (context string) (when (and epg-key-id (string-match "\\`passphrase\\." string)) @@ -1166,9 +1262,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 @@ -1189,13 +1286,30 @@ 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 (and (equal (car epg-last-status) "USERID_HINT") + (string-match "\\`\\([^ ]+\\) \\(.*\\)" + (cdr epg-last-status))) + (let* ((key-id (match-string 1 (cdr epg-last-status))) + (user-id (match-string 2 (cdr epg-last-status))) + (entry (assoc key-id epg-user-id-alist))) + (if entry + (setq user-id (cdr entry))) + (format "Untrusted key %s %s. Use anyway? " key-id user-id)) + "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 @@ -1230,10 +1344,13 @@ This function is for internal use only." 'verify (cons (epg-make-signature status key-id) (epg-context-result-for context 'verify))) - (if (eq (epg-context-protocol context) 'CMS) - (condition-case nil + (condition-case nil + (if (eq (epg-context-protocol context) 'CMS) (setq user-id (epg-dn-from-string user-id)) - (error))) + (setq user-id (epg--decode-coding-string + (epg--decode-percent-escape user-id) + 'utf-8))) + (error)) (if entry (setcdr entry user-id) (setq epg-user-id-alist @@ -1311,9 +1428,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))) @@ -1381,8 +1499,9 @@ This function is for internal use only." (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)) @@ -1394,22 +1513,31 @@ This function is for internal use only." (if (consp (epg-context-progress-callback context)) (cdr (epg-context-progress-callback context)))))) +(defun epg--status-ENC_TO (context string) + (if (string-match "\\`\\([0-9A-Za-z]+\\) \\([0-9]+\\) \\([0-9]+\\)" string) + (epg-context-set-result-for + context 'encrypted-to + (cons (list (match-string 1 string) + (string-to-number (match-string 2 string)) + (string-to-number (match-string 3 string))) + (epg-context-result-for context 'encrypted-to))))) + (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) @@ -1452,8 +1580,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) @@ -1490,6 +1618,11 @@ This function is for internal use only." (let* ((key-id (match-string 1 string)) (user-id (match-string 2 string)) (entry (assoc key-id epg-user-id-alist))) + (condition-case nil + (setq user-id (epg--decode-coding-string + (epg--decode-percent-escape user-id) + 'utf-8)) + (error)) (if entry (setcdr entry user-id) (setq epg-user-id-alist (cons (cons key-id user-id) @@ -1526,22 +1659,20 @@ This function is for internal use only." \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string) (epg-context-set-result-for context 'import - (cons (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-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) @@ -1562,18 +1693,25 @@ This function is for internal use only." (defun epg--list-keys-1 (context name mode) (let ((args (append (if epg-gpg-home-directory (list "--homedir" epg-gpg-home-directory)) - (list "--with-colons" "--no-greeting" "--batch" - "--with-fingerprint" - "--with-fingerprint" - (if (memq mode '(t secret)) - "--list-secret-keys" - (if (memq mode '(nil public)) - "--list-keys" - "--list-sigs"))) + '("--with-colons" "--no-greeting" "--batch" + "--with-fingerprint" "--with-fingerprint") (unless (eq (epg-context-protocol context) 'CMS) - '("--fixed-list-mode")) - (if name (list name)))) + '("--fixed-list-mode")))) + (list-keys-option (if (memq mode '(t secret)) + "--list-secret-keys" + (if (memq mode '(nil public)) + "--list-keys" + "--list-sigs"))) + (coding-system-for-read 'binary) keys string field index) + (if name + (progn + (unless (listp name) + (setq name (list name))) + (while name + (setq args (append args (list list-keys-option (car name))) + name (cdr name)))) + (setq args (append args (list list-keys-option)))) (with-temp-buffer (apply #'call-process (if (eq (epg-context-protocol context) 'CMS) @@ -1605,7 +1743,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) @@ -1613,9 +1752,10 @@ This function is for internal use only." 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." +signatures should be included. +NAME is either a string or a list of strings." (let ((lines (epg--list-keys-1 context name mode)) - keys cert pointer pointer-1) + keys cert pointer pointer-1 index string) (while lines (cond ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs")) @@ -1635,6 +1775,19 @@ signatures should be included." (cons (epg--make-sub-key-1 (car lines)) (epg-key-sub-key-list (car keys))))) ((equal (aref (car lines) 0) "uid") + ;; Decode the UID name as a backslash escaped UTF-8 string, + ;; generated by GnuPG/GpgSM. + (setq string (copy-sequence (aref (car lines) 9)) + index 0) + (while (string-match "\"" string index) + (setq string (replace-match "\\\"" t t string) + index (1+ (match-end 0)))) + (condition-case nil + (setq string (epg--decode-coding-string + (car (read-from-string (concat "\"" string "\""))) + 'utf-8)) + (error + (setq string (aref (car lines) 9)))) (epg-key-set-user-id-list (car keys) (cons (epg-make-user-id @@ -1643,9 +1796,9 @@ signatures should be included." epg-key-validity-alist))) (if cert (condition-case nil - (epg-dn-from-string (aref (car lines) 9)) - (error (aref (car lines) 9))) - (aref (car lines) 9))) + (epg-dn-from-string string) + (error string)) + string)) (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))) @@ -1685,64 +1838,60 @@ signatures should be included." (setq pointer (cdr pointer))) keys)) -(if (fboundp 'make-temp-file) - (defalias 'epg--make-temp-file 'make-temp-file) - (defvar temporary-file-directory) - ;; stolen from poe.el. - (defun epg--make-temp-file (prefix) - "Create a temporary file. +(eval-and-compile + (if (fboundp 'make-temp-file) + (defalias 'epg--make-temp-file 'make-temp-file) + (defvar temporary-file-directory) + ;; stolen from poe.el. + (defun epg--make-temp-file (prefix) + "Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), is guaranteed to point to a newly created empty file. You can then use `write-region' to write new data into the file." - (let (tempdir tempfile) - (setq prefix (expand-file-name prefix - (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory))) - (unwind-protect - (let (file) - ;; First, create a temporary directory. - (while (condition-case () - (progn - (setq tempdir (make-temp-name - (concat - (file-name-directory prefix) - "DIR"))) - ;; return nil or signal an error. - (make-directory tempdir)) - ;; let's try again. - (file-already-exists t))) - (set-file-modes tempdir 448) - ;; Second, create a temporary file in the tempdir. - ;; There *is* a race condition between `make-temp-name' - ;; and `write-region', but we don't care it since we are - ;; in a private directory now. - (setq tempfile (make-temp-name (concat tempdir "/EMU"))) - (write-region "" nil tempfile nil 'silent) - (set-file-modes tempfile 384) - ;; Finally, make a hard-link from the tempfile. - (while (condition-case () - (progn - (setq file (make-temp-name prefix)) - ;; return nil or signal an error. - (add-name-to-file tempfile file)) - ;; let's try again. - (file-already-exists t))) - file) - ;; Cleanup the tempfile. - (and tempfile - (file-exists-p tempfile) - (delete-file tempfile)) - ;; Cleanup the tempdir. - (and tempdir - (file-directory-p tempdir) - (delete-directory tempdir)))))) - -(if (fboundp 'clear-string) - (defalias 'epg--clear-string 'clear-string) - (defun epg--clear-string (string) - (fillarray string 0))) + (let (tempdir tempfile) + (setq prefix (expand-file-name prefix + (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory))) + (unwind-protect + (let (file) + ;; First, create a temporary directory. + (while (condition-case () + (progn + (setq tempdir (make-temp-name + (concat + (file-name-directory prefix) + "DIR"))) + ;; return nil or signal an error. + (make-directory tempdir)) + ;; let's try again. + (file-already-exists t))) + (set-file-modes tempdir 448) + ;; Second, create a temporary file in the tempdir. + ;; There *is* a race condition between `make-temp-name' + ;; and `write-region', but we don't care it since we are + ;; in a private directory now. + (setq tempfile (make-temp-name (concat tempdir "/EMU"))) + (write-region "" nil tempfile nil 'silent) + (set-file-modes tempfile 384) + ;; Finally, make a hard-link from the tempfile. + (while (condition-case () + (progn + (setq file (make-temp-name prefix)) + ;; return nil or signal an error. + (add-name-to-file tempfile file)) + ;; let's try again. + (file-already-exists t))) + file) + ;; Cleanup the tempfile. + (and tempfile + (file-exists-p tempfile) + (delete-file tempfile)) + ;; Cleanup the tempdir. + (and tempdir + (file-directory-p tempdir) + (delete-directory tempdir))))))) (defun epg--args-from-sig-notations (notations) (apply #'nconc @@ -1775,7 +1924,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. @@ -1795,6 +1944,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. @@ -1807,9 +1969,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 @@ -1828,9 +1988,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) @@ -2011,20 +2169,37 @@ Otherwise, it makes a cleartext signature." 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 cleartext 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))) + (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 @@ -2112,25 +2287,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) @@ -2155,7 +2347,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"))) @@ -2261,11 +2453,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) @@ -2274,14 +2466,18 @@ 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 (defun epg-start-sign-keys (context keys &optional local) - "Initiate an sign keys operation. + "Initiate a sign keys operation. 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 @@ -2361,27 +2557,42 @@ PARAMETERS is a string which tells how to create the key." (epg-context-result-for context 'error)))) (epg-reset context))) +(defun epg--decode-percent-escape (string) + (let ((index 0)) + (while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)" + string index) + (if (match-beginning 2) + (setq string (replace-match "%" t t string) + index (1- (match-end 0))) + (setq string (replace-match + (string (string-to-number (match-string 3 string) 16)) + t t string) + index (- (match-end 0) 2)))) + string)) + (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) - index (+ index 4))) - (car (read-from-string (concat "\"" string "\""))))) + (setq string (replace-match (string (string-to-number + (match-string 0 string) 16)) + t t string) + index (1- (match-end 0)))) + string)) (defun epg--decode-quotedstring (string) (let ((index 0)) (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\ -\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\|\\(.\\)\\)" +\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)" string index) (if (match-beginning 2) (setq string (replace-match "\\2" t nil string) - index (1+ index)) + index (1- (match-end 0))) (if (match-beginning 3) - (setq string (replace-match "\\x\\3" t nil string) - index (+ index 4)) - (setq string (replace-match "\\\\\\\\\\4" t nil string) - index (+ index 3))))) - (car (read-from-string (concat "\"" string "\""))))) + (setq string (replace-match (string (string-to-number + (match-string 0 string) 16)) + t t string) + index (- (match-end 0) 2))))) + string)) (defun epg-dn-from-string (string) "Parse STRING as LADPv3 Distinguished Names (RFC2253).