]> code.delx.au - gnu-emacs/blobdiff - lisp/epg.el
defun fix for cl declarations + interactive forms
[gnu-emacs] / lisp / epg.el
index 348ad970b14fed404d5212d38a9207d36e9f4de6..340fc76fb8c94efe5b35793fd811610760f0460d 100644 (file)
@@ -1,5 +1,5 @@
 ;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2000, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2013 Free Software Foundation, Inc.
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; Keywords: PGP, GnuPG
@@ -82,7 +82,7 @@
 (defconst epg-invalid-recipients-reason-alist
   '((0 . "No specific reason given")
     (1 . "Not Found")
-    (2 . "Ambigious specification")
+    (2 . "Ambiguous specification")
     (3 . "Wrong key usage")
     (4 . "Key revoked")
     (5 . "Key expired")
@@ -95,7 +95,7 @@
 (defconst epg-delete-problem-reason-alist
   '((1 . "No such key")
     (2 . "Must delete secret key first")
-    (3 . "Ambigious specification")))
+    (3 . "Ambiguous specification")))
 
 (defconst epg-import-ok-reason-alist
   '((0 . "Not actually changed")
@@ -356,7 +356,7 @@ query by itself and Emacs can intercept them."
 PROGRESS-CALLBACK is either a function, or a cons-cell whose
 car is a function and cdr is a callback data.
 
-The function gets five arguments: the context, the operation
+The function gets six arguments: the context, the operation
 description, the character to display a progress unit, the
 current amount done, the total amount to be done, and the
 callback data (if any)."
@@ -1069,6 +1069,59 @@ This function is for internal use only."
              (format " secret keys unchanged: %d\n"
                      (epg-import-result-secret-unchanged import-result)))))
 
+(defun epg-error-to-string (error)
+  (cond
+   ((eq (car error) 'exit)
+    "Exit")
+   ((eq (car error) 'quit)
+    "Cancelled")
+   ((eq (car error) 'no-data)
+    (let ((entry (assq (cdr error) epg-no-data-reason-alist)))
+      (if entry
+         (format "No data (%s)" (downcase (cdr entry)))
+       "No data")))
+   ((eq (car error) 'unexpected)
+    (let ((entry (assq (cdr error) epg-unexpected-reason-alist)))
+      (if entry
+         (format "Unexpected (%s)" (downcase (cdr entry)))
+       "Unexpected")))
+   ((eq (car error) 'bad-armor)
+    "Bad armor")
+   ((memq (car error) '(invalid-recipient invalid-signer))
+    (concat
+     (if (eq (car error) 'invalid-recipient)
+        "Unusable public key"
+       "Unusable secret key")
+     (let ((entry (assq 'requested (cdr error))))
+       (if entry
+          (format ": %s" (cdr entry))
+        ": <unknown>"))
+     (let ((entry (assq 'reason (cdr error))))
+       (if (and entry
+               (> (cdr entry) 0)       ;no specific reason given
+               (setq entry (assq (cdr entry)
+                                 epg-invalid-recipients-reason-alist)))
+          (format " (%s)" (downcase (cdr entry)))
+        ""))))
+   ((eq (car error) 'no-pubkey)
+    (format "No public key: %s" (cdr error)))
+   ((eq (car error) 'no-seckey)
+    (format "No secret key: %s" (cdr error)))
+   ((eq (car error) 'no-recipients)
+    "No recipients")
+   ((eq (car error) 'no-signers)
+    "No signers")
+   ((eq (car error) 'delete-problem)
+    (let ((entry (assq (cdr error) epg-delete-problem-reason-alist)))
+      (if entry
+         (format "Delete problem (%s)" (downcase (cdr entry)))
+       "Delete problem")))
+   ((eq (car error) 'key-not-created)
+    "Key not created")))
+
+(defun epg-errors-to-string (errors)
+  (mapconcat #'epg-error-to-string errors "; "))
+
 (defun epg--start (context args)
   "Start `epg-gpg-program' in a subprocess with given ARGS."
   (if (and (epg-context-process context)
@@ -1195,7 +1248,7 @@ This function is for internal use only."
     (if epg-pending-status-list
        (epg-context-set-result-for
         context 'error
-        (cons (list 'exit)
+        (cons '(exit)
               (epg-context-result-for context 'error))))))
 
 (defun epg-wait-for-completion (context)
@@ -1203,7 +1256,10 @@ This function is for internal use only."
   (while (eq (process-status (epg-context-process context)) 'run)
     (accept-process-output (epg-context-process context) 1))
   ;; This line is needed to run the process-filter right now.
-  (sleep-for 0.1))
+  (sleep-for 0.1)
+  (epg-context-set-result-for
+   context 'error
+   (nreverse (epg-context-result-for context 'error))))
 
 (defun epg-reset (context)
   "Reset the CONTEXT."
@@ -1399,11 +1455,22 @@ This function is for internal use only."
   (epg--status-*SIG context 'bad string))
 
 (defun epg--status-NO_PUBKEY (context string)
-  (let ((signature (car (epg-context-result-for context 'verify))))
-    (if (and signature
-            (eq (epg-signature-status signature) 'error)
-            (equal (epg-signature-key-id signature) string))
-       (epg-signature-set-status signature 'no-pubkey))))
+  (if (eq (epg-context-operation context) 'verify)
+      (let ((signature (car (epg-context-result-for context 'verify))))
+       (if (and signature
+                (eq (epg-signature-status signature) 'error)
+                (equal (epg-signature-key-id signature) string))
+           (epg-signature-set-status signature 'no-pubkey)))
+    (epg-context-set-result-for
+     context 'error
+     (cons (cons 'no-pubkey string)
+          (epg-context-result-for context 'error)))))
+
+(defun epg--status-NO_SECKEY (context string)
+  (epg-context-set-result-for
+   context 'error
+   (cons (cons 'no-seckey string)
+        (epg-context-result-for context 'error))))
 
 (defun epg--time-from-seconds (seconds)
   (let ((number-seconds (string-to-number (concat seconds ".0"))))
@@ -1564,13 +1631,13 @@ This function is for internal use only."
    context 'key
    (cons (list 'key-expired (cons 'expiration-time
                                  (epg--time-from-seconds string)))
-        (epg-context-result-for context 'error))))
+        (epg-context-result-for context 'key))))
 
 (defun epg--status-KEYREVOKED (context _string)
   (epg-context-set-result-for
    context 'key
    (cons '(key-revoked)
-        (epg-context-result-for context 'error))))
+        (epg-context-result-for context 'key))))
 
 (defun epg--status-BADARMOR (context _string)
   (epg-context-set-result-for
@@ -1585,7 +1652,18 @@ This function is for internal use only."
        (cons (list 'invalid-recipient
                   (cons 'reason
                         (string-to-number (match-string 1 string)))
-                  (cons 'requested-recipient
+                  (cons 'requested
+                        (match-string 2 string)))
+            (epg-context-result-for context 'error)))))
+
+(defun epg--status-INV_SGNR (context string)
+  (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
+      (epg-context-set-result-for
+       context 'error
+       (cons (list 'invalid-signer
+                  (cons 'reason
+                        (string-to-number (match-string 1 string)))
+                  (cons 'requested
                         (match-string 2 string)))
             (epg-context-result-for context 'error)))))
 
@@ -1595,6 +1673,12 @@ This function is for internal use only."
    (cons '(no-recipients)
         (epg-context-result-for context 'error))))
 
+(defun epg--status-NO_SGNR (context _string)
+  (epg-context-set-result-for
+   context 'error
+   (cons '(no-signers)
+        (epg-context-result-for context 'error))))
+
 (defun epg--status-DELETE_PROBLEM (context string)
   (if (string-match "\\`\\([0-9]+\\)" string)
       (epg-context-set-result-for
@@ -1695,6 +1779,7 @@ This function is for internal use only."
     (epg-context-set-result-for context 'import-status nil)))
 
 (defun epg-passphrase-callback-function (context key-id _handback)
+  (declare (obsolete epa-passphrase-callback-function "23.1"))
   (if (eq key-id 'SYM)
       (read-passwd "Passphrase for symmetric encryption: "
                   (eq (epg-context-operation context) 'encrypt))
@@ -1706,9 +1791,6 @@ This function is for internal use only."
             (format "Passphrase for %s %s: " key-id (cdr entry))
           (format "Passphrase for %s: " key-id)))))))
 
-(make-obsolete 'epg-passphrase-callback-function
-              'epa-passphrase-callback-function "23.1")
-
 (defun epg--list-keys-1 (context name mode)
   (let ((args (append (if epg-gpg-home-directory
                          (list "--homedir" epg-gpg-home-directory))
@@ -1867,7 +1949,8 @@ 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)
+      (let ((orig-modes (default-file-modes))
+           tempdir tempfile)
        (setq prefix (expand-file-name prefix
                                       (if (featurep 'xemacs)
                                           (temp-directory)
@@ -1875,6 +1958,7 @@ You can then use `write-region' to write new data into the file."
        (unwind-protect
            (let (file)
              ;; First, create a temporary directory.
+             (set-default-file-modes #o700)
              (while (condition-case ()
                         (progn
                           (setq tempdir (make-temp-name
@@ -1885,14 +1969,12 @@ You can then use `write-region' to write new data into the file."
                           (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
@@ -1902,6 +1984,7 @@ You can then use `write-region' to write new data into the file."
                       ;; let's try again.
                       (file-already-exists t)))
              file)
+         (set-default-file-modes orig-modes)
          ;; Cleanup the tempfile.
          (and tempfile
               (file-exists-p tempfile)
@@ -1947,7 +2030,7 @@ CIPHER must be a file data object.
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-decrypt-file' or `epg-decrypt-string' instead."
   (unless (epg-data-file cipher)
@@ -1960,17 +2043,13 @@ If you are unsure, use synchronous version of this function
     (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))))
+  (let ((errors (epg-context-result-for context 'error)))
+    (if (epg-context-result-for context 'decryption-failed)
+       (signal 'epg-error
+               (list "Decryption failed" (epg-errors-to-string errors))))
     (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)))))
+      (signal 'epg-error
+             (list "Can't decrypt" (epg-errors-to-string errors))))))
 
 (defun epg-decrypt-file (context cipher plain)
   "Decrypt a file CIPHER and store the result to a file PLAIN.
@@ -2017,7 +2096,7 @@ For a normal or a cleartext signature, SIGNED-TEXT should be nil.
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-verify-file' or `epg-verify-string' instead."
   (epg-context-set-operation context 'verify)
@@ -2115,7 +2194,7 @@ Otherwise, it makes a cleartext signature.
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-sign-file' or `epg-sign-string' instead."
   (epg-context-set-operation context 'sign)
@@ -2165,10 +2244,9 @@ Otherwise, it makes a cleartext signature."
        (epg-start-sign context (epg-make-data-from-file 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")))
+         (let ((errors (epg-context-result-for context 'error)))
+           (signal 'epg-error
+                   (list "Sign failed" (epg-errors-to-string errors)))))
        (unless signature
          (epg-read-output context)))
     (unless signature
@@ -2203,9 +2281,9 @@ Otherwise, it makes a cleartext signature."
          (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")))
+               (let ((errors (epg-context-result-for context 'error)))
+                 (signal 'epg-error
+                         (list "Sign failed" (epg-errors-to-string errors))))))
          (epg-read-output context))
       (epg-delete-output-file context)
       (if input-file
@@ -2220,7 +2298,7 @@ If RECIPIENTS is nil, it performs symmetric encryption.
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-encrypt-file' or `epg-encrypt-string' instead."
   (epg-context-set-operation context 'encrypt)
@@ -2276,15 +2354,14 @@ If RECIPIENTS is nil, it performs symmetric encryption."
        (epg-start-encrypt context (epg-make-data-from-file 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)))
+       (let ((errors (epg-context-result-for context 'error)))
+         (if (and sign
+                  (not (epg-context-result-for context 'sign)))
+             (signal 'epg-error
+                     (list "Sign failed" (epg-errors-to-string errors))))
+         (if errors
+             (signal 'epg-error
+                     (list "Encrypt failed" (epg-errors-to-string errors)))))
        (unless cipher
          (epg-read-output context)))
     (unless cipher
@@ -2317,15 +2394,14 @@ If RECIPIENTS is nil, it performs symmetric encryption."
                               (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)))
+         (let ((errors (epg-context-result-for context 'error)))
+           (if (and sign
+                    (not (epg-context-result-for context 'sign)))
+               (signal 'epg-error
+                       (list "Sign failed" (epg-errors-to-string errors))))
+           (if errors
+               (signal 'epg-error
+                       (list "Encrypt failed" (epg-errors-to-string errors)))))
          (epg-read-output context))
       (epg-delete-output-file context)
       (if input-file
@@ -2337,7 +2413,7 @@ If RECIPIENTS is nil, it performs symmetric encryption."
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
   (epg-context-set-operation context 'export-keys)
@@ -2359,9 +2435,11 @@ If you are unsure, use synchronous version of this function
                                       (epg--make-temp-file "epg-output")))
        (epg-start-export-keys context keys)
        (epg-wait-for-completion context)
-       (if (epg-context-result-for context 'error)
-           (error "Export keys failed: %S"
-                  (epg-context-result-for context 'error)))
+       (let ((errors (epg-context-result-for context 'error)))
+         (if errors
+             (signal 'epg-error
+                     (list "Export keys failed"
+                           (epg-errors-to-string errors)))))
        (unless file
          (epg-read-output context)))
     (unless file
@@ -2378,7 +2456,7 @@ KEYS is a data object.
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
   (epg-context-set-operation context 'import-keys)
@@ -2398,9 +2476,11 @@ If you are unsure, use synchronous version of this function
       (progn
        (epg-start-import-keys context keys)
        (epg-wait-for-completion context)
-       (if (epg-context-result-for context 'error)
-           (error "Import keys failed: %S"
-                  (epg-context-result-for context 'error))))
+       (let ((errors (epg-context-result-for context 'error)))
+         (if errors
+             (signal 'epg-error
+                     (list "Import keys failed"
+                           (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defun epg-import-keys-from-file (context keys)
@@ -2417,7 +2497,7 @@ KEY-ID-LIST is a list of key IDs.
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-receive-keys' instead."
   (epg-context-set-operation context 'receive-keys)
@@ -2431,9 +2511,11 @@ KEYS is a list of key IDs"
       (progn
        (epg-start-receive-keys context keys)
        (epg-wait-for-completion context)
-       (if (epg-context-result-for context 'error)
-           (error "Receive keys failed: %S"
-                  (epg-context-result-for context 'error))))
+       (let ((errors (epg-context-result-for context 'error)))
+         (if errors
+             (signal 'epg-error
+                     (list "Receive keys failed"
+                           (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defalias 'epg-import-keys-from-server 'epg-receive-keys)
@@ -2443,7 +2525,7 @@ KEYS is a list of key IDs"
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-delete-keys' instead."
   (epg-context-set-operation context 'delete-keys)
@@ -2463,13 +2545,11 @@ If you are unsure, use synchronous version of this function
       (progn
        (epg-start-delete-keys context keys allow-secret)
        (epg-wait-for-completion context)
-       (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")))))
+       (let ((errors (epg-context-result-for context 'error)))
+         (if errors
+             (signal 'epg-error
+                     (list "Delete keys failed"
+                           (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defun epg-start-sign-keys (context keys &optional local)
@@ -2477,9 +2557,10 @@ If you are unsure, use synchronous version of this function
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-sign-keys' instead."
+  (declare (obsolete nil "23.1"))
   (epg-context-set-operation context 'sign-keys)
   (epg-context-set-result context nil)
   (epg--start context (cons (if local
@@ -2490,19 +2571,20 @@ If you are unsure, use synchronous version of this function
                              (epg-sub-key-id
                               (car (epg-key-sub-key-list key))))
                            keys))))
-(make-obsolete 'epg-start-sign-keys "do not use." "23.1")
 
 (defun epg-sign-keys (context keys &optional local)
   "Sign KEYS from the key ring."
+  (declare (obsolete nil "23.1"))
   (unwind-protect
       (progn
        (epg-start-sign-keys context keys local)
        (epg-wait-for-completion context)
-       (if (epg-context-result-for context 'error)
-           (error "Sign keys failed: %S"
-                  (epg-context-result-for context 'error))))
+       (let ((errors (epg-context-result-for context 'error)))
+         (if errors
+             (signal 'epg-error
+                     (list "Sign keys failed"
+                           (epg-errors-to-string errors))))))
     (epg-reset context)))
-(make-obsolete 'epg-sign-keys "do not use." "23.1")
 
 (defun epg-start-generate-key (context parameters)
   "Initiate a key generation.
@@ -2510,7 +2592,7 @@ PARAMETERS specifies parameters for the key.
 
 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
-`epg-reset' to clear a temporaly output file.
+`epg-reset' to clear a temporary output file.
 If you are unsure, use synchronous version of this function
 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
   (epg-context-set-operation context 'generate-key)
@@ -2532,9 +2614,11 @@ PARAMETERS is a file which tells how to create the key."
       (progn
        (epg-start-generate-key context (epg-make-data-from-file parameters))
        (epg-wait-for-completion context)
-       (if (epg-context-result-for context 'error)
-           (error "Generate key failed: %S"
-                  (epg-context-result-for context 'error))))
+       (let ((errors (epg-context-result-for context 'error)))
+         (if errors
+             (signal 'epg-error
+                     (list "Generate key failed"
+                           (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defun epg-generate-key-from-string (context parameters)
@@ -2544,9 +2628,11 @@ PARAMETERS is a string which tells how to create the key."
       (progn
        (epg-start-generate-key context (epg-make-data-from-string parameters))
        (epg-wait-for-completion context)
-       (if (epg-context-result-for context 'error)
-           (error "Generate key failed: %S"
-                  (epg-context-result-for context 'error))))
+       (let ((errors (epg-context-result-for context 'error)))
+         (if errors
+             (signal 'epg-error
+                     (list "Generate key failed"
+                           (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defun epg--decode-percent-escape (string)