X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=723c222d690029f5b9e70f6e5d9cc611932599cf;hb=HEAD;hp=b76082153f7ed50f321dff775acd4819ebf4fbc7;hpb=0400aa5df333ef752c2f22a6d166f141a6720b78;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index b760821..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 @@ -330,7 +330,7 @@ This function is for internal use only." (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." +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 (if handback @@ -340,7 +340,7 @@ If optional argument HANDBACK is specified, it is passed to 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." +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 (if handback @@ -1193,6 +1193,11 @@ 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)) @@ -1218,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)) @@ -1275,9 +1291,15 @@ This function is for internal use only." (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)) + (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) @@ -1491,6 +1513,15 @@ 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 'decryption-failed t)) @@ -1662,19 +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) @@ -1715,7 +1752,8 @@ 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 index string) (while lines @@ -1737,7 +1775,10 @@ 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") - (setq string (copy-sequence (aref (car lines) 9))) + ;; 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)))) @@ -1754,10 +1795,12 @@ signatures should be included." (cdr (assq (string-to-char (aref (car lines) 1)) epg-key-validity-alist))) (if cert - (epg-dn-from-string string) - string))) - (epg-key-user-id-list (car keys))))) - ((equal (aref (car lines) 0) "fpr") + (condition-case nil + (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))) (aref (car lines) 9))) ((equal (aref (car lines) 0) "sig") @@ -1795,72 +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))) - -(if (fboundp 'encode-coding-string) - (defalias 'epg--encode-coding-string 'encode-coding-string) - (defalias 'epg--encode-coding-string 'identity)) - -(if (fboundp 'decode-coding-string) - (defalias 'epg--decode-coding-string 'decode-coding-string) - (defalias 'epg--decode-coding-string 'identity)) + (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 @@ -2446,7 +2477,7 @@ If you are unsure, use synchronous version of this function ;;;###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 @@ -2554,7 +2585,7 @@ PARAMETERS is a string which tells how to create the key." \\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)" string index) (if (match-beginning 2) - (setq string (replace-match "\\2" t t string) + (setq string (replace-match "\\2" t nil string) index (1- (match-end 0))) (if (match-beginning 3) (setq string (replace-match (string (string-to-number