nconc -> append

[elisp/epg.git] / epg.el

diff --git a/epg.el b/epg.el
index 491ef30..356ad57 100644 (file)
--- a/epg.el
+++ b/epg.el
@@ -1095,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)

@@ -1196,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)

@@ -1315,12 +1322,12 @@ 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
-               (setq user-id (epg-dn-from-string user-id))
-             (error)))

        (condition-case nil
        (condition-case nil

-           (setq user-id (epg--decode-coding-string user-id 'utf-8))
+           (if (eq (epg-context-protocol context) 'CMS)
+               (setq user-id (epg-dn-from-string user-id))
+             (setq user-id (epg--decode-coding-string
+                            (epg--decode-percent-escape user-id)
+                            'utf-8)))

          (error))
        (if entry
            (setcdr entry user-id)
          (error))
        (if entry
            (setcdr entry user-id)

@@ -1580,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)

@@ -1650,19 +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-colons" "--no-greeting" "--batch"

                            "--with-fingerprint"
                            "--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)
        (coding-system-for-read 'binary)
        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)

@@ -1703,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 user-id-string)
+       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"))

@@ -1725,22 +1742,30 @@ 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")

-       (setq user-id-string (if cert
-                                (condition-case nil
-                                    (epg-dn-from-string (aref (car lines) 9))
-                                  (error (aref (car lines) 9)))
-                              (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))))

        (condition-case nil
        (condition-case nil

-           (setq user-id-string (epg--decode-coding-string user-id-string
-                                                           'utf-8))
-         (error))
+           (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
                (if (aref (car lines) 1)
                    (cdr (assq (string-to-char (aref (car lines) 1))
                               epg-key-validity-alist)))
        (epg-key-set-user-id-list
         (car keys)
         (cons (epg-make-user-id
                (if (aref (car lines) 1)
                    (cdr (assq (string-to-char (aref (car lines) 1))
                               epg-key-validity-alist)))

-               user-id-string)
+               (if cert
+                   (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)))
               (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)))

@@ -2511,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).