nconc -> append

[elisp/epg.git] / epg.el

diff --git a/epg.el b/epg.el
index 63d40b5..356ad57 100644 (file)
--- a/epg.el
+++ b/epg.el
@@ -1120,7 +1120,6 @@ This function is for internal use only."
                       args)))
       (set-default-file-modes orig-mode))
     (set-process-filter process #'epg--process-filter)
                       args)))
       (set-default-file-modes orig-mode))
     (set-process-filter process #'epg--process-filter)

-    (set-process-sentinel process #'ignore)

     (epg-context-set-process context process)))
 
 (defun epg--process-filter (process input)
     (epg-context-set-process context process)))
 
 (defun epg--process-filter (process input)

@@ -1148,17 +1147,14 @@ This function is for internal use only."
                             (string (match-string 2))
                             (symbol (intern-soft (concat "epg--status-"
                                                          status))))
                             (string (match-string 2))
                             (symbol (intern-soft (concat "epg--status-"
                                                          status))))

-                       (forward-line)
-                       (setq epg-read-point (point))

                        (if (member status epg-pending-status-list)
                            (setq epg-pending-status-list nil))
                        (if (and symbol
                                 (fboundp symbol))
                            (funcall symbol epg-context string))
                        (if (member status epg-pending-status-list)
                            (setq epg-pending-status-list nil))
                        (if (and symbol
                                 (fboundp symbol))
                            (funcall symbol epg-context string))

-                       (goto-char epg-read-point)
-                       (setq epg-last-status (cons status string)))
-                   (forward-line)
-                   (setq epg-read-point (point)))))
+                       (setq epg-last-status (cons status string))))
+                 (forward-line)
+                 (setq epg-read-point (point))))

            (setq epg-process-filter-running nil))))))
 
 (defun epg-read-output (context)
            (setq epg-process-filter-running nil))))))
 
 (defun epg-read-output (context)

@@ -1184,12 +1180,6 @@ This function is for internal use only."
   (while (eq (process-status (epg-context-process context)) 'run)
     (accept-process-output (epg-context-process context) 1)))
 
   (while (eq (process-status (epg-context-process context)) 'run)
     (accept-process-output (epg-context-process context) 1)))
 

-(defun epg-wait-for-plaintext (context length)
-  "Wait data from the `epg-gpg-program' process."
-  (while (and (eq (process-status (epg-context-process context)) 'run)
-             (< (- (point-max) epg-read-point) length))
-    (accept-process-output (epg-context-process context) 1)))
-

 (defun epg-reset (context)
   "Reset the CONTEXT."
   (if (and (epg-context-process context)
 (defun epg-reset (context)
   "Reset the CONTEXT."
   (if (and (epg-context-process context)

@@ -1209,7 +1199,9 @@ This function is for internal use only."
             (user-id (match-string 2 string))
             (entry (assoc key-id epg-user-id-alist)))
        (condition-case nil
             (user-id (match-string 2 string))
             (entry (assoc key-id epg-user-id-alist)))
        (condition-case nil

-           (setq user-id (epg--decode-coding-string user-id 'utf-8))
+           (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)

@@ -1333,7 +1325,9 @@ This function is for internal use only."
        (condition-case nil
            (if (eq (epg-context-protocol context) 'CMS)
                (setq user-id (epg-dn-from-string user-id))
        (condition-case nil
            (if (eq (epg-context-protocol context) 'CMS)
                (setq user-id (epg-dn-from-string user-id))

-             (setq user-id (epg--decode-coding-string user-id 'utf-8)))
+             (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)

@@ -1497,27 +1491,11 @@ This function is for internal use only."
               (if (consp (epg-context-progress-callback context))
                   (cdr (epg-context-progress-callback context))))))
 
               (if (consp (epg-context-progress-callback context))
                   (cdr (epg-context-progress-callback context))))))
 

-(defun epg--status-BEGIN_DECRYPTION (context string)
-  (epg-context-set-result-for context 'plaintext nil))
-

 (defun epg--status-DECRYPTION_FAILED (context string)
   (epg-context-set-result-for context 'decryption-failed t))
 
 (defun epg--status-DECRYPTION_OKAY (context string)
 (defun epg--status-DECRYPTION_FAILED (context string)
   (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)
-  (epg-context-set-result-for
-   context
-   'decrypted-plaintext
-   (epg-context-result-for context 'plaintext)))
-
-(defun epg--status-PLAINTEXT_LENGTH (context string)
-  (when (string-match "\\`\\([0-9]+\\)" string)
-    (let ((length (string-to-number (match-string 1 string))))
-      (epg-wait-for-plaintext context length)
-      (epg-context-set-result-for
-       context 'plaintext
-       (buffer-substring epg-read-point
-                        (setq epg-read-point (+ epg-read-point length)))))))
+  (epg-context-set-result-for context 'decryption-okay t))

 
 (defun epg--status-NODATA (context string)
   (epg-context-set-result-for
 
 (defun epg--status-NODATA (context string)
   (epg-context-set-result-for

@@ -1610,7 +1588,9 @@ This function is for internal use only."
             (user-id (match-string 2 string))
             (entry (assoc key-id epg-user-id-alist)))
        (condition-case nil
             (user-id (match-string 2 string))
             (entry (assoc key-id epg-user-id-alist)))
        (condition-case nil

-           (setq user-id (epg--decode-coding-string user-id 'utf-8))
+           (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)

@@ -1682,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-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)
        (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)

@@ -1735,7 +1719,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
 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
   (let ((lines (epg--list-keys-1 context name mode))
        keys cert pointer pointer-1 index string)
     (while lines

@@ -1757,23 +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")

+       ;; 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
                (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)))

-               (condition-case nil
-                   (if cert
-                       (epg-dn-from-string (aref (car lines) 9))
-                     (setq string (copy-sequence (aref (car lines) 9)))
-                     (while (string-match "\"" string index)
-                       (setq string (replace-match "\\\"" t t string)
-                             index (1+ (match-end 0))))
-                     (epg--decode-coding-string
-                      (car (read-from-string (concat "\"" string "\"")))
-                      'utf-8))
-                 (error (aref (car lines) 9))))
+               (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)))

@@ -1971,10 +1963,13 @@ If PLAIN is nil, it returns the result as a string."
     (unwind-protect
        (progn
          (write-region cipher nil input-file nil 'quiet)
     (unwind-protect
        (progn
          (write-region cipher nil input-file nil 'quiet)

+         (epg-context-set-output-file context
+                                      (epg--make-temp-file "epg-output"))

          (epg-start-decrypt context (epg-make-data-from-file input-file))
          (epg-wait-for-completion context)
          (epg--check-error-for-decrypt context)
          (epg-start-decrypt context (epg-make-data-from-file input-file))
          (epg-wait-for-completion context)
          (epg--check-error-for-decrypt context)

-         (epg-context-result-for context 'decrypted-plaintext))
+         (epg-read-output context))
+      (epg-delete-output-file context)

       (if (file-exists-p input-file)
          (delete-file input-file))
       (epg-reset context))))
       (if (file-exists-p input-file)
          (delete-file input-file))
       (epg-reset context))))

@@ -2028,7 +2023,9 @@ stored into the file after successful verification."
   (unwind-protect
       (progn
        (if plain
   (unwind-protect
       (progn
        (if plain

-           (epg-context-set-output-file context plain))
+           (epg-context-set-output-file context plain)
+         (epg-context-set-output-file context
+                                      (epg--make-temp-file "epg-output")))

        (if signed-text
            (epg-start-verify context
                              (epg-make-data-from-file signature)
        (if signed-text
            (epg-start-verify context
                              (epg-make-data-from-file signature)

@@ -2037,7 +2034,9 @@ stored into the file after successful verification."
                            (epg-make-data-from-file signature)))
        (epg-wait-for-completion context)
        (unless plain
                            (epg-make-data-from-file signature)))
        (epg-wait-for-completion context)
        (unless plain

-         (epg-context-result-for context 'plaintext)))
+         (epg-read-output context)))
+    (unless plain
+      (epg-delete-output-file context))

     (epg-reset context)))
 
 ;;;###autoload
     (epg-reset context)))
 
 ;;;###autoload

@@ -2053,6 +2052,8 @@ successful verification."
        input-file)
     (unwind-protect
        (progn
        input-file)
     (unwind-protect
        (progn

+         (epg-context-set-output-file context
+                                      (epg--make-temp-file "epg-output"))

          (if signed-text
              (progn
                (setq input-file (epg--make-temp-file "epg-signature"))
          (if signed-text
              (progn
                (setq input-file (epg--make-temp-file "epg-signature"))

@@ -2062,7 +2063,8 @@ successful verification."
                                  (epg-make-data-from-string signed-text)))
            (epg-start-verify context (epg-make-data-from-string signature)))
          (epg-wait-for-completion context)
                                  (epg-make-data-from-string signed-text)))
            (epg-start-verify context (epg-make-data-from-string signature)))
          (epg-wait-for-completion context)

-         (epg-context-result-for context 'plaintext))
+         (epg-read-output context))
+      (epg-delete-output-file context)

       (if (and input-file
               (file-exists-p input-file))
          (delete-file input-file))
       (if (and input-file
               (file-exists-p input-file))
          (delete-file input-file))

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