Importing EasyPG.
authorueno <ueno>
Tue, 11 Apr 2006 11:20:27 +0000 (11:20 +0000)
committerueno <ueno>
Tue, 11 Apr 2006 11:20:27 +0000 (11:20 +0000)
epg.el [new file with mode: 0644]

diff --git a/epg.el b/epg.el
new file mode 100644 (file)
index 0000000..027c13d
--- /dev/null
+++ b/epg.el
@@ -0,0 +1,601 @@
+(defgroup epg ()
+  "EasyPG, yet another GnuPG interface.")
+
+(defcustom epg-gpg-program "gpg"
+  "The `gpg' executable."
+  :group 'epg
+  :type 'string)
+
+(defvar epg-user-id nil
+  "GnuPG ID of your default identity.")
+
+(defvar epg-user-id-alist nil
+  "An alist mapping from key ID to user ID.")
+
+(defvar epg-read-point nil)
+(defvar epg-pending-status-list nil)
+(defvar epg-key-id nil)
+(defvar epg-context nil)
+(defvar epg-debug nil)
+
+(defvar epg-colons-pub-spec
+  '((trust "[^:]")
+    (length "[0-9]+" 0 string-to-number)
+    (algorithm "[0-9]+" 0 string-to-number)
+    (key-id "[^:]+")
+    (creation-date "[0-9]+")
+    (expiration-date "[0-9]+")
+    nil
+    (ownertrust "[^:]")
+    nil
+    nil
+    (capability "[escaESCA]*"))
+  "The schema of keylisting output whose type is \"pub\".
+This is used by `epg-list-keys'.")
+
+(defvar epg-colons-sec-spec
+  '((trust "[^:]")
+    (length "[0-9]+" 0 string-to-number)
+    (algorithm "[0-9]+" 0 string-to-number)
+    (key-id "[^:]+")
+    (creation-date "[0-9]+")
+    (expiration-date "[0-9]+")
+    nil
+    (ownertrust "[^:]"))
+"The schema of keylisting output whose type is \"sec\".
+This is used by `epg-list-keys'.")
+
+(defvar epg-colons-uid-spec
+  '((trust "[^:]")
+    nil
+    nil
+    nil
+    (creation-date "[0-9]+")
+    (expiration-date "[0-9]+")
+    (hash "[^:]+")
+    nil
+    (user-id "[^:]+"))
+  "The schema of keylisting output whose type is \"uid\".
+This is used by `epg-list-keys'.")
+    
+(defun epg-make-context (&optional protocol armor textmode include-certs
+                                  process output-file result)
+  "Return a context object."
+  (vector protocol armor textmode include-certs
+         (list #'epg-passphrase-callback)
+         (list #'epg-progress-callback)
+         nil process output-file result))
+
+(defun epg-context-protocol (context)
+  "Return the protocol used within the context."
+  (aref context 0))
+
+(defun epg-context-armor (context)
+  "Return t if the output shouled be ASCII armored in the CONTEXT context."
+  (aref context 1))
+
+(defun epg-context-textmode (context)
+  "Return t if canonical text mode should be used in the CONTEXT context."
+  (aref context 2))
+
+(defun epg-context-include-certs (context)
+  "Return how many certificates should be included in an S/MIME signed
+message."
+  (aref context 3))
+
+(defun epg-context-passphrase-callback (context)
+  "Return the function used to query passphrase."
+  (aref context 4))
+
+(defun epg-context-progress-callback (context)
+  "Return the function which handles progress update."
+  (aref context 5))
+
+(defun epg-context-signers (context)
+  "Return the list of key-id for singning."
+  (aref context 6))
+
+(defun epg-context-process (context)
+  "Return the process object of `epg-gpg-program'.
+This function is for internal use only."
+  (aref context 7))
+
+(defun epg-context-output-file (context)
+  "Return the output file of `epg-gpg-program'.
+This function is for internal use only."
+  (aref context 8))
+
+(defun epg-context-result (context name)
+  "Return the result of the previous cryptographic operation."
+  (cdr (assq name (aref context 9))))
+
+(defun epg-context-set-protocol (context protocol)
+  "Set the protocol used within the context."
+  (aset context 0 protocol))
+
+(defun epg-context-set-armor (context armor)
+  "Specify if the output shouled be ASCII armored in the CONTEXT context."
+  (aset context 1 armor))
+
+(defun epg-context-set-textmode (context textmode)
+  "Specify if canonical text mode should be used in the CONTEXT context."
+  (aset context 2 textmode))
+
+(defun epg-context-set-include-certs (context include-certs)
+ "Set how many certificates should be included in an S/MIME signed message."
+  (aset context 3 include-certs))
+
+(defun epg-context-set-passphrase-callback (context passphrase-callback
+                                                   &optional handback)
+  "Set the function used to query passphrase."
+  (aset context 4 (cons passphrase-callback handback)))
+
+(defun epg-context-set-progress-callback (context progress-callback
+                                                 &optional handback)
+  "Set the function which handles progress update."
+  (aset context 5 (cons progress-callback handback)))
+
+(defun epg-context-set-signers (context signers)
+ "Set the list of key-id for singning."
+  (aset context 6 signers))
+
+(defun epg-context-set-process (context process)
+  "Set the process object of `epg-gpg-program'.
+This function is for internal use only."
+  (aset context 7 process))
+
+(defun epg-context-set-output-file (context output-file)
+  "Set the output file of `epg-gpg-program'.
+This function is for internal use only."
+  (aset context 8 output-file))
+
+(defun epg-context-set-result (context name result)
+  "Set the result of the previous cryptographic operation."
+  (let ((entry (assq name (aref context 9))))
+    (if entry
+       (setcdr entry result)
+      (aset context 9 (cons (cons name result) (aref context 9))))))
+
+(defun epg-make-signature (status key-id user-id)
+  "Return a signature object."
+  (vector status key-id user-id nil))
+
+(defun epg-signature-status (signature)
+  "Return the status code of SIGNATURE."
+  (aref signature 0))
+
+(defun epg-signature-key-id (signature)
+  "Return the key-id of SIGNATURE."
+  (aref signature 1))
+
+(defun epg-signature-user-id (signature)
+  "Return the user-id of SIGNATURE."
+  (aref signature 2))
+  
+(defun epg-signature-validity (signature)
+  "Return the validity of SIGNATURE."
+  (aref signature 3))
+
+(defun epg-signature-set-status (signature status)
+ "Set the status code of SIGNATURE."
+  (aset signature 0 status))
+
+(defun epg-signature-set-key-id (signature key-id)
+ "Set the key-id of SIGNATURE."
+  (aset signature 1 key-id))
+
+(defun epg-signature-set-user-id (signature user-id)
+ "Set the user-id of SIGNATURE."
+  (aset signature 2 user-id))
+  
+(defun epg-signature-set-validity (signature validity)
+ "Set the validity of SIGNATURE."
+  (aset signature 3 validity))
+
+(defun epg-start (context args)
+  "Start `epg-gpg-program' in a subprocess with given ARGS."
+  (let* ((args (append (list "--no-tty"
+                            "--status-fd" "1"
+                            "--command-fd" "0"
+                            "--yes") ; overwrite
+                      (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)
+        process-connection-type
+        (orig-mode (default-file-modes))
+        (buffer (generate-new-buffer " *epg*"))
+        process)
+    (with-current-buffer buffer
+      (make-local-variable 'epg-read-point)
+      (setq epg-read-point (point-min))
+      (make-local-variable 'epg-pending-status-list)
+      (setq epg-pending-status-list nil)
+      (make-local-variable 'epg-key-id)
+      (setq epg-key-id nil)
+      (make-local-variable 'epg-context)
+      (setq epg-context context))
+    (unwind-protect
+       (progn
+         (set-default-file-modes 448)
+         (setq process
+               (apply #'start-process "epg" buffer epg-gpg-program args)))
+      (set-default-file-modes orig-mode))
+    (set-process-filter process #'epg-process-filter)
+    (epg-context-set-process context process)))
+
+(defun epg-process-filter (process input)
+  (if epg-debug
+      (save-excursion
+       (set-buffer (get-buffer-create  " *epg-debug*"))
+       (goto-char (point-max))
+       (insert input)))
+  (if (buffer-live-p (process-buffer process))
+      (save-excursion
+       (set-buffer (process-buffer process))
+       (goto-char (point-max))
+       (insert input)
+       (goto-char epg-read-point)
+       (beginning-of-line)
+       (while (looking-at ".*\n")      ;the input line is finished
+         (save-excursion
+           (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
+               (let* ((status (match-string 1))
+                      (string (match-string 2))
+                      (symbol (intern-soft (concat "epg-status-" status))))
+                 (if (member status epg-pending-status-list)
+                     (setq epg-pending-status-list nil))
+                 (if (and symbol
+                          (fboundp symbol))
+                     (funcall symbol process string)))))
+         (forward-line))
+       (setq epg-read-point (point)))))
+
+(defun epg-read-output (context)
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (if (file-exists-p (epg-context-output-file context))
+       (let ((coding-system-for-read (if (epg-context-output-file context)
+                                         'raw-text
+                                     'binary)))
+         (insert-file-contents (epg-context-output-file context))
+         (buffer-string)))))
+
+(defun epg-wait-for-status (context status-list)
+  (with-current-buffer (process-buffer (epg-context-process context))
+    (setq epg-pending-status-list status-list)
+    (while (and (eq (process-status (epg-context-process context)) 'run)
+               epg-pending-status-list)
+      (accept-process-output (epg-context-process context) 1))))
+
+(defun epg-wait-for-completion (context)
+  (process-send-eof (epg-context-process context))
+  (while (eq (process-status (epg-context-process context)) 'run)
+    ;; We can't use accept-process-output instead of sit-for here
+    ;; because it may cause an interrupt during the sentinel execution.
+    (sit-for 0.1)))
+
+(defun epg-reset (context)
+  (if (and (epg-context-process context)
+          (buffer-live-p (process-buffer (epg-context-process context))))
+      (kill-buffer (process-buffer (epg-context-process context))))
+  (epg-context-set-process context nil)
+  (if (file-exists-p (epg-context-output-file context))
+      (delete-file (epg-context-output-file context)))
+  (aset context 9 nil))
+
+(defun epg-status-USERID_HINT (process string)
+  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
+      (let* ((key-id (match-string 1 string))
+            (user-id (match-string 2 string))
+            (entry (assoc key-id epg-user-id-alist)))
+       (if entry
+           (setcdr entry user-id)
+         (setq epg-user-id-alist (cons (cons key-id user-id)
+                                       epg-user-id-alist))))))
+
+(defun epg-status-NEED_PASSPHRASE (process string)
+  (if (string-match "\\`\\([^ ]+\\)" string)
+      (setq epg-key-id (match-string 1 string))))
+
+(defun epg-status-NEED_PASSPHRASE_SYM (process string)
+  (setq epg-key-id 'SYM))
+
+(defun epg-status-NEED_PASSPHRASE_PIN (process string)
+  (setq epg-key-id 'PIN))
+
+(defun epg-status-GET_HIDDEN (process string)
+  (let ((passphrase (funcall
+                    (car (epg-context-passphrase-callback epg-context))
+                    epg-key-id
+                    (cdr (epg-context-passphrase-callback epg-context)))))
+    (unwind-protect
+       (if passphrase
+           (process-send-string process (concat passphrase "\n")))
+      (fillarray passphrase 0))))
+
+(defun epg-status-GOODSIG (process string)
+  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
+      (epg-context-set-result
+       epg-context
+       'verify
+       (cons (epg-make-signature 'good
+                                (match-string 1 string)
+                                (match-string 2 string))
+            (epg-context-result epg-context 'verify)))))
+
+(defun epg-status-EXPSIG (process string)
+  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
+      (epg-context-set-result
+       epg-context
+       'verify
+       (cons (epg-make-signature 'expired
+                                (match-string 1 string)
+                                (match-string 2 string))
+            (epg-context-result epg-context 'verify)))))
+
+(defun epg-status-EXPKEYSIG (process string)
+  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
+      (epg-context-set-result
+       epg-context
+       'verify
+       (cons (epg-make-signature 'expired-key
+                                (match-string 1 string)
+                                (match-string 2 string))
+            (epg-context-result epg-context 'verify)))))
+
+(defun epg-status-REVKEYSIG (process string)
+  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
+      (epg-context-set-result
+       epg-context
+       'verify
+       (cons (epg-make-signature 'revoked-key
+                                (match-string 1 string)
+                                (match-string 2 string))
+            (epg-context-result epg-context 'verify)))))
+
+(defun epg-status-BADSIG (process string)
+  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
+      (epg-context-set-result
+       epg-context
+       'verify
+       (cons (epg-make-signature 'bad
+                                (match-string 1 string)
+                                (match-string 2 string))
+            (epg-context-result epg-context 'verify)))))
+
+(defun epg-status-TRUST_UNDEFINED (process string)
+  (let ((signature (car (epg-context-result epg-context 'verify))))
+    (if (and signature
+            (eq (epg-signature-status signature) 'good))
+       (epg-signature-set-validity signature 'unknown))))
+
+(defun epg-status-TRUST_NEVER (process string)
+  (let ((signature (car (epg-context-result epg-context 'verify))))
+    (if (and signature
+            (eq (epg-signature-status signature) 'good))
+       (epg-signature-set-validity signature 'never))))
+
+(defun epg-status-TRUST_MARGINAL (process string)
+  (let ((signature (car (epg-context-result epg-context 'verify))))
+    (if (and signature
+            (eq (epg-signature-status signature) 'marginal))
+       (epg-signature-set-validity signature 'marginal))))
+
+(defun epg-status-TRUST_FULLY (process string)
+  (let ((signature (car (epg-context-result epg-context 'verify))))
+    (if (and signature
+            (eq (epg-signature-status signature) 'good))
+       (epg-signature-set-validity signature 'full))))
+
+(defun epg-status-TRUST_ULTIMATE (process string)
+  (let ((signature (car (epg-context-result epg-context 'verify))))
+    (if (and signature
+            (eq (epg-signature-status signature) 'good))
+       (epg-signature-set-validity signature 'full))))
+
+(defun epg-status-DECRYPTION_FAILED (process string)
+  (epg-context-set-result epg-context 'decrypt 'failed))
+
+(defun epg-status-PROGRESS (process string)
+  (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
+                   string)
+      (funcall (car (epg-context-progress-callback epg-context))
+              (match-string 1 string)
+              (match-string 2 string)
+              (string-to-number (match-string 3 string))
+              (string-to-number (match-string 4 string)))))
+
+(defun epg-passphrase-callback (key-id handback)
+  (read-passwd
+   (if (eq key-id 'SYM)
+       "GnuPG passphrase for symmetric encryption: "
+     (if (eq key-id 'PIN)
+        "GnuPG passphrase for PIN: "
+       (format "GnuPG passphrase for %s: "
+              (let ((entry (assoc key-id epg-user-id-alist)))
+                (if entry
+                    (cdr entry)
+                  key-id)))))))
+
+(defun epg-progress-callback (what char current total handback)
+  (message "%s: %d%%/%d%%" what current total))
+
+(defun epg-list-keys (name &optional secret)
+  "List keys associated with STRING."
+  (let ((args (list "--with-colons" "--no-greeting" "--batch"
+                   "--fixed-list-mode"
+                   (if secret "--list-secret-keys" "--list-keys")
+                   name))
+       keys type symbol pointer)
+    (with-temp-buffer
+      (apply #'call-process epg-gpg-program nil (list t nil) nil args)
+      (goto-char (point-min))
+      (while (looking-at "\\([a-z][a-z][a-z]\\):\\(.*\\)")
+       (setq type (match-string 1)
+             symbol (intern-soft (format "epg-colons-%s-spec" type)))
+       (if (member type '("pub" "sec"))
+           (setq keys (cons nil keys)))
+       (if (and symbol
+                (boundp symbol))
+           (setcar keys (cons (cons (intern type)
+                                    (epg-parse-colons
+                                     (symbol-value symbol)
+                                     (match-string 2)))
+                              (car keys))))
+       (forward-line)))
+    (setq pointer keys)
+    (while pointer
+      (setcar pointer (nreverse (car pointer)))
+      (setq pointer (cdr pointer)))
+    (nreverse keys)))
+
+(defun epg-parse-colons (alist string)
+  (let ((index 0)
+       result)
+    (while (and alist
+               (or (null (car alist))
+                   (eq index
+                       (string-match
+                        (concat "\\(" (nth 1 (car alist)) "\\)?:")
+                        string index))))
+      (if (car alist)
+         (progn
+           (setq index (match-end 0))
+           (if (match-beginning 1)
+               (setq result
+                     (cons (cons (car (car alist))
+                                 (funcall (or (nth 3 (car alist)) #'identity)
+                                          (match-string
+                                           (1+ (or (nth 2 (car alist)) 0))
+                                           string)))
+                           result))))
+       (setq index (1+ index)))
+      (setq alist (cdr alist)))
+    (nreverse result)))
+
+;;;###autoload
+(defun epg-decrypt-start (context input-file)
+  "Initiate a decrypt operation."
+  (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
+  (epg-start context
+            (list "--decrypt" input-file))
+  (epg-wait-for-status context '("BEGIN_DECRYPTION")))
+
+;;;###autoload
+(defun epg-decrypt-string (context string)
+  "Decrypt STRING."
+  (let ((input-file (epg-make-temp-file "epg-input"))
+       (coding-system-for-write 'binary))
+    (unwind-protect
+       (progn
+         (write-region string nil input-file)
+         (epg-decrypt-start context input-file)
+         (epg-wait-for-completion context)
+         (unless (epg-context-result context 'decrypt)
+           (epg-read-output context)))
+      (epg-reset context)
+      (if (file-exists-p input-file)
+         (delete-file input-file)))))
+
+;;;###autoload
+(defun epg-verify-start (context signature &optional string)
+  "Initiate a verify operation."
+  (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
+  (if string
+      ;; Detached signature.
+      (progn
+       (epg-start context
+                  (append (list "--verify")
+                          (list signature "-")))
+       (if (eq (process-status (epg-context-process context)) 'run)
+           (process-send-string (epg-context-process context) string)))
+    ;; Normal (or cleartext) signature.
+    (epg-start context
+              (list "--verify"))
+    (if (eq (process-status (epg-context-process context)) 'run)
+       (process-send-string (epg-context-process context) signature))))
+
+;;;###autoload
+(defun epg-verify-string (context signature &optional string)
+  "Verify SIGNATURE."
+  (let ((input-file (epg-make-temp-file "epg-input"))
+       (coding-system-for-write 'binary))
+    (unwind-protect
+       (progn
+         (if string
+             (write-region signature nil input-file))
+         (epg-verify-start context input-file string)
+         (epg-wait-for-completion context)
+         (epg-context-result context 'verify))
+      (epg-reset context)
+      (if (file-exists-p input-file)
+         (delete-file input-file)))))
+
+;;;###autoload
+(defun epg-sign-start (context string &optional mode)
+  "Initiate a sign operation."
+  (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
+  (epg-start context
+            (append (list (if (null mode)
+                              "--sign"
+                            (if (or (eq mode t) (eq mode 'detached))
+                                "--detach-sign"
+                              "--clearsign")))
+                    (apply #'nconc
+                           (mapcar (lambda (signer)
+                                     (list "-u" signer))
+                                   (epg-context-signers context)))))
+  (epg-wait-for-status context '("BEGIN_SIGNING"))
+  (if (eq (process-status (epg-context-process context)) 'run)
+      (process-send-string (epg-context-process context) string)))
+
+;;;###autoload
+(defun epg-sign-string (context string &optional mode)
+  "Sign STRING."
+  (unwind-protect
+      (progn
+       (epg-sign-start context string mode)
+       (epg-wait-for-completion context)
+       (epg-read-output context))
+    (epg-reset context)))
+
+;;;###autoload
+(defun epg-encrypt-start (context string recipients
+                                 &optional always-trust sign)
+  "Initiate a encrypt operation."
+  (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
+  (epg-start context
+            (append (if always-trust '("--always-trust"))
+                    (if recipients '("--encrypt") '("--symmetric"))
+                    (if sign
+                        (cons "--sign"
+                              (apply #'nconc
+                                     (mapcar (lambda (signer)
+                                               (list "-u" signer))
+                                             (epg-context-signers context)))))
+                    (apply #'nconc
+                           (mapcar (lambda (recipient)
+                                     (list "-r" recipient))
+                                   recipients))))
+  (if sign
+      (epg-wait-for-status context '("BEGIN_SIGNING")))
+  (if (eq (process-status (epg-context-process context)) 'run)
+      (process-send-string (epg-context-process context) string)))
+
+;;;###autoload
+(defun epg-encrypt-string (context string recipients
+                                  &optional always-trust sign)
+  "Encrypt STRING."
+  (unwind-protect
+      (progn
+       (epg-encrypt-start context string recipients always-trust sign)
+       (epg-wait-for-completion context)
+       (epg-read-output context))
+    (epg-reset context)))
+
+(provide 'epg)
+
+;;; epg.el ends here