* epa.el (epa-protocol): defcustom -> defvar.

[epg/epg.git] / epg.el

diff --git a/epg.el b/epg.el
index c18ebee..7993b48 100644 (file)
--- a/epg.el
+++ b/epg.el
@@ -33,6 +33,7 @@
 (defvar epg-user-id-alist nil
   "An alist mapping from key ID to user ID.")
 
 (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)
 (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)
 
 
 (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)))
 (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))
 
     (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 CALLBACK."

   (unless (eq (car-safe context) 'epg-context)
     (signal 'wrong-type-argument (list 'epg-context-p context)))
   (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 CALLBACK."

   (unless (eq (car-safe context) 'epg-context)
     (signal 'wrong-type-argument (list 'epg-context-p context)))
   (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."
 
 (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))
 
                                       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)))
   "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
   (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-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
   "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."
 
 (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."
 
 (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 ")
     (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-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)
        ""))))
 
 (defun epg-verify-result-to-string (verify-result)


@@ -1040,18 +1061,24 @@ 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 (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)
                       (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)
                       (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*"))
         process-connection-type
         (orig-mode (default-file-modes))
         (buffer (generate-new-buffer " *epg*"))


@@ -1068,6 +1095,10 @@ 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)
       (setq epg-read-point (point-min))
       (make-local-variable 'epg-process-filter-running)
       (make-local-variable 'epg-read-point)
       (setq epg-read-point (point-min))
       (make-local-variable 'epg-process-filter-running)


@@ -1120,7 +1151,8 @@ This function is for internal use only."
                            (setq epg-pending-status-list nil))
                        (if (and symbol
                                 (fboundp symbol))
                            (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))))))
                  (forward-line)
                  (setq epg-read-point (point))))
            (setq epg-process-filter-running nil))))))


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


@@ -1209,9 +1246,10 @@ This function is for internal use only."
                  (if epg-passphrase-coding-system
                      (progn
                        (setq encoded-passphrase-with-new-line
                  (if epg-passphrase-coding-system
                      (progn
                        (setq encoded-passphrase-with-new-line

-                             (encode-coding-string
+                             (epg--encode-coding-string

                               passphrase-with-new-line
                               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
                        (epg--clear-string passphrase-with-new-line)
                        (setq passphrase-with-new-line nil))
                    (setq encoded-passphrase-with-new-line


@@ -1232,13 +1270,24 @@ This function is for internal use only."
        (if encoded-passphrase-with-new-line
            (epg--clear-string encoded-passphrase-with-new-line))))))
 
        (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 (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)
 (defun epg--status-GET_BOOL (context string)

-  (let ((entry (assoc string epg-prompt-alist))
-       inhibit-quit)
+  (let (inhibit-quit)

     (condition-case nil
     (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
       (quit
        (epg-context-set-result-for
        context 'error


@@ -1273,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


@@ -1354,9 +1406,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-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)))
       (epg-signature-set-version
        signature
        (string-to-number (match-string 4 string)))


@@ -1424,8 +1477,9 @@ This function is for internal use only."
               (epg-sig-notations signature))))))
 
 (defun epg--status-PROGRESS (context string)
               (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))
       (funcall (if (consp (epg-context-progress-callback context))
                   (car (epg-context-progress-callback context))
                 (epg-context-progress-callback context))


@@ -1438,21 +1492,21 @@ This function is for internal use only."
                   (cdr (epg-context-progress-callback context))))))
 
 (defun epg--status-DECRYPTION_FAILED (context string)
                   (cdr (epg-context-progress-callback context))))))
 
 (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
 
 (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
         (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)
         (epg-context-result-for context 'error))))
 
 (defun epg--status-KEYEXPIRED (context string)


@@ -1495,8 +1549,8 @@ This function is for internal use only."
   (if (string-match "\\`\\([0-9]+\\)" string)
       (epg-context-set-result-for
        context 'error
   (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)
             (epg-context-result-for context 'error)))))
 
 (defun epg--status-SIG_CREATED (context string)


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


@@ -1569,22 +1628,20 @@ This function is for internal use only."
 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
     (epg-context-set-result-for
      context 'import
 \\([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)
     (epg-context-set-result-for context 'import-status nil)))
 
 (defun epg-passphrase-callback-function (context key-id handback)


@@ -1605,18 +1662,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))
 (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)
                      (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)

+    (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)
     (with-temp-buffer
       (apply #'call-process
             (if (eq (epg-context-protocol context) 'CMS)


@@ -1648,7 +1712,8 @@ This function is for internal use only."
    (string-to-number (aref line 2))
    (aref line 4)
    (epg--time-from-seconds (aref line 5))
    (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)
 
 ;;;###autoload
 (defun epg-list-keys (context &optional name mode)


@@ -1656,9 +1721,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"))


@@ -1678,6 +1744,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


@@ -1686,9 +1765,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)))


@@ -1787,6 +1866,14 @@ You can then use `write-region' to write new data into the file."
   (defun epg--clear-string (string)
     (fillarray string 0)))
 
   (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))
+

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


@@ -1818,7 +1905,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))))
               (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.
 ;;;###autoload
 (defun epg-start-decrypt (context cipher)
   "Initiate a decrypt operation on CIPHER.


@@ -1838,6 +1925,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"))))
 
   (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.
 ;;;###autoload
 (defun epg-decrypt-file (context cipher plain)
   "Decrypt a file CIPHER and store the result to a file PLAIN.


@@ -1850,9 +1950,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)
                                       (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
        (unless plain
          (epg-read-output context)))
     (unless plain


@@ -1871,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 input-file))
          (epg-wait-for-completion context)
                                       (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)
          (epg-read-output context))
       (epg-delete-output-file context)
       (if (file-exists-p input-file)


@@ -2054,20 +2150,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."
 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
 
 ;;;###autoload
 (defun epg-start-encrypt (context plain recipients


@@ -2155,25 +2268,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."
                                   &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)
 
 ;;;###autoload
 (defun epg-start-export-keys (context keys)


@@ -2198,7 +2328,7 @@ If you are unsure, use synchronous version of this function
   "Extract public KEYS."
   (unwind-protect
       (progn
   "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")))
            (epg-context-set-output-file context file)
          (epg-context-set-output-file context
                                       (epg--make-temp-file "epg-output")))


@@ -2304,11 +2434,11 @@ If you are unsure, use synchronous version of this function
   (epg--start context (cons (if allow-secret
                               "--delete-secret-key"
                             "--delete-key")
   (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)
 
 ;;;###autoload
 (defun epg-delete-keys (context keys &optional allow-secret)


@@ -2317,9 +2447,13 @@ If you are unsure, use synchronous version of this function
       (progn
        (epg-start-delete-keys context keys allow-secret)
        (epg-wait-for-completion context)
       (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
     (epg-reset context)))
 
 ;;;###autoload


@@ -2404,27 +2538,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).