nconc -> append

[elisp/epg.git] / epg.el

diff --git a/epg.el b/epg.el
index 79a03c6..356ad57 100644 (file)
--- a/epg.el
+++ b/epg.el
@@ -1061,7 +1061,9 @@ This function is for internal use only."
   (let* ((args (append (list "--no-tty"
                             "--status-fd" "1"
                             "--yes")
   (let* ((args (append (list "--no-tty"
                             "--status-fd" "1"
                             "--yes")

-                      (if (string-match ":" (or (getenv "GPG_AGENT_INFO") ""))
+                      (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))
                           '("--use-agent"))
                       (if (and (not (eq (epg-context-protocol context) 'CMS))
                                (epg-context-progress-callback context))

@@ -1076,6 +1078,7 @@ This function is for internal use only."
                           (list "--output" (epg-context-output-file context)))
                       args))
         (coding-system-for-write 'binary)
                           (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*"))
         process-connection-type
         (orig-mode (default-file-modes))
         (buffer (generate-new-buffer " *epg*"))

@@ -1092,6 +1095,8 @@ This function is for internal use only."
                           epg-gpg-program)
                          (mapconcat #'identity args " ")))))
     (with-current-buffer buffer
                           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)
       (make-local-variable 'epg-last-status)
       (setq epg-last-status nil)
       (make-local-variable 'epg-read-point)

@@ -1193,6 +1198,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)))
       (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)
        (if entry
            (setcdr entry user-id)
          (setq epg-user-id-alist (cons (cons key-id user-id)

@@ -1265,11 +1275,10 @@ 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 entry (cdr entry) (concat string "? ")))))
 
 (defun epg--prompt-GET_BOOL-untrusted_key.override (context string)

-  (if (and (equal (car epg-last-status) "USERID_HINT")
-          (string-match "\\`\\([^ ]+\\) \\(.*\\)" (cdr epg-last-status)))
-      (y-or-n-p (format "Untrusted key %s %s.  Trust this key anyway? "
-                       (match-string 1 string)
-                       (match-string 2 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 (inhibit-quit)
 
 (defun epg--status-GET_BOOL (context string)
   (let (inhibit-quit)

@@ -1313,10 +1322,13 @@ This function is for internal use only."
         'verify
         (cons (epg-make-signature status key-id)
               (epg-context-result-for context 'verify)))
         '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))
                (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
        (if entry
            (setcdr entry user-id)
          (setq epg-user-id-alist

@@ -1575,6 +1587,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)))
       (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)
        (if entry
            (setcdr entry user-id)
          (setq epg-user-id-alist (cons (cons key-id user-id)

@@ -1645,18 +1662,23 @@ 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))
 (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-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-fingerprint")

                      (unless (eq (epg-context-protocol context) 'CMS)
                      (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)
        keys string field index)

+    (unless (listp name)
+      (setq name (list name)))
+    (while name
+      (setq args (append args (list list-keys-option (car name)))
+           name (cdr name)))

     (with-temp-buffer
       (apply #'call-process
             (if (eq (epg-context-protocol context) 'CMS)
     (with-temp-buffer
       (apply #'call-process
             (if (eq (epg-context-protocol context) 'CMS)

@@ -1697,9 +1719,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
 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))
   (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"))
     (while lines
       (cond
        ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))

@@ -1719,6 +1742,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")
         (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
        (epg-key-set-user-id-list
         (car keys)
         (cons (epg-make-user-id

@@ -1727,9 +1763,9 @@ signatures should be included."
                               epg-key-validity-alist)))
                (if cert
                    (condition-case nil
                               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)))
               (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)))

@@ -1832,6 +1868,10 @@ You can then use `write-region' to write new data into the file."
     (defalias 'epg--encode-coding-string 'encode-coding-string)
   (defalias 'epg--encode-coding-string 'identity))
 
     (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))
+

 (defun epg--args-from-sig-notations (notations)
   (apply #'nconc
         (mapcar
 (defun epg--args-from-sig-notations (notations)
   (apply #'nconc
         (mapcar

@@ -2496,27 +2536,42 @@ PARAMETERS is a string which tells how to create the key."
                   (epg-context-result-for context 'error))))
     (epg-reset context)))
 
                   (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))
 (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 "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
 
 (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)
                         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)
        (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).
 
 (defun epg-dn-from-string (string)
   "Parse STRING as LADPv3 Distinguished Names (RFC2253).