;;; epg.el --- the EasyPG Library
;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
;;   2005, 2006 Free Software Foundation, Inc.
;; Copyright (C) 2006 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG

;; This file is part of EasyPG.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Code:

(defgroup epg ()
  "The EasyPG Library")

(defcustom epg-gpg-program "gpg"
  "The `gpg' executable."
  :group 'epg
  :type 'string)

(defconst epg-version-number "0.0.0")

(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-debug-buffer nil)

;; from gnupg/include/cipher.h
(defconst epg-cipher-algorithm-alist
  '((0 . "NONE")
    (1 . "IDEA")
    (2 . "3DES")
    (3 . "CAST5")
    (4 . "BLOWFISH")
    (7 . "AES")
    (8 . "AES192")
    (9 . "AES256")
    (10 . "TWOFISH")
    (110 . "DUMMY")))

;; from gnupg/include/cipher.h
(defconst epg-pubkey-algorithm-alist
  '((1 . "RSA")
    (2 . "RSA_E")
    (3 . "RSA_S")
    (16 . "ELGAMAL_E")
    (17 . "DSA")
    (20 . "ELGAMAL")))

;; from gnupg/include/cipher.h
(defconst epg-digest-algorithm-alist
  '((1 . "MD5")
    (2 . "SHA1")
    (3 . "RMD160")
    (8 . "SHA256")
    (9 . "SHA384")
    (10 . "SHA512")))

;; from gnupg/include/cipher.h
(defconst epg-compress-algorithm-alist
  '((0 . "NONE")
    (1 . "ZIP")
    (2 . "ZLIB")
    (3 . "BZIP2")))

(defconst epg-invalid-recipients-alist
  '((0 . "No specific reason given")
    (1 . "Not Found")
    (2 . "Ambigious specification")
    (3 . "Wrong key usage")
    (4 . "Key revoked")
    (5 . "Key expired")
    (6 . "No CRL known")
    (7 . "CRL too old")
    (8 . "Policy mismatch")
    (9 . "Not a secret key")
    (10 . "Key not trusted")))

(defconst epg-delete-problem-alist
  '((1 . "No such key")
    (2 . "Must delete secret key first")
    (3 . "Ambigious specification")))

(defvar epg-key-validity-alist
  '((?o . unknown)
    (?i . invalid)
    (?d . disabled)
    (?r . revoked)
    (?e . expired)
    (?- . none)
    (?q . undefined)
    (?n . never)
    (?m . marginal)
    (?f . full)
    (?u . ultimate)))

(defvar epg-key-capablity-alist
  '((?e . encrypt)
    (?s . sign)
    (?c . certify)
    (?a . authentication)))

(defvar epg-prompt-alist nil)

(defun epg-make-data-from-file (file)
  "Make a data object from FILE."
  (vector file nil))

(defun epg-make-data-from-string (string)
  "Make a data object from STRING."
  (vector nil string))

(defun epg-data-file (data)
  "Return the file of DATA."
  (aref data 0))

(defun epg-data-string (data)
  "Return the string of DATA."
  (aref data 1))

(defun epg-make-context (&optional protocol armor textmode include-certs
				   cipher-algorithm digest-algorithm
				   compress-algorithm)
  "Return a context object."
  (vector protocol armor textmode include-certs
	  cipher-algorithm digest-algorithm compress-algorithm
	  #'epg-passphrase-callback-function
	  #'epg-progress-callback-function
	  nil nil nil nil))

(defun epg-context-protocol (context)
  "Return the protocol used within CONTEXT."
  (aref context 0))

(defun epg-context-armor (context)
  "Return t if the output shouled be ASCII armored in CONTEXT."
  (aref context 1))

(defun epg-context-textmode (context)
  "Return t if canonical text mode should be used in 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-cipher-algorithm (context)
  "Return the cipher algorithm in CONTEXT."
  (aref context 4))

(defun epg-context-digest-algorithm (context)
  "Return the digest algorithm in CONTEXT."
  (aref context 5))

(defun epg-context-compress-algorithm (context)
  "Return the compress algorithm in CONTEXT."
  (aref context 6))

(defun epg-context-passphrase-callback (context)
  "Return the function used to query passphrase."
  (aref context 7))

(defun epg-context-progress-callback (context)
  "Return the function which handles progress update."
  (aref context 8))

(defun epg-context-signers (context)
  "Return the list of key-id for singning."
  (aref context 9))

(defun epg-context-process (context)
  "Return the process object of `epg-gpg-program'.
This function is for internal use only."
  (aref context 10))

(defun epg-context-output-file (context)
  "Return the output file of `epg-gpg-program'.
This function is for internal use only."
  (aref context 11))

(defun epg-context-result (context)
  "Return the result of the previous cryptographic operation."
  (aref context 12))

(defun epg-context-set-protocol (context protocol)
  "Set the protocol used within CONTEXT."
  (aset context 0 protocol))

(defun epg-context-set-armor (context armor)
  "Specify if the output shouled be ASCII armored in CONTEXT."
  (aset context 1 armor))

(defun epg-context-set-textmode (context textmode)
  "Specify if canonical text mode should be used in 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-cipher-algorithm (context cipher-algorithm)
 "Set the cipher algorithm in CONTEXT."
  (aset context 4 cipher-algorithm))

(defun epg-context-set-digest-algorithm (context digest-algorithm)
 "Set the digest algorithm in CONTEXT."
  (aset context 5 digest-algorithm))

(defun epg-context-set-compress-algorithm (context compress-algorithm)
 "Set the compress algorithm in CONTEXT."
  (aset context 6 compress-algorithm))

(defun epg-context-set-passphrase-callback (context
						 passphrase-callback)
  "Set the function used to query passphrase."
  (aset context 7 passphrase-callback))

(defun epg-context-set-progress-callback (context progress-callback)
  "Set the function which handles progress update."
  (aset context 8 progress-callback))

(defun epg-context-set-signers (context signers)
 "Set the list of key-id for singning."
  (aset context 9 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 10 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 11 output-file))

(defun epg-context-set-result (context result)
  "Set the result of the previous cryptographic operation."
  (aset context 12 result))

(defun epg-make-signature (status key-id user-id)
  "Return a signature object."
  (vector status key-id user-id nil 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-fingerprint (signature)
  "Return the fingerprint of SIGNATURE."
  (aref signature 4))

(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-signature-set-fingerprint (signature fingerprint)
 "Set the fingerprint of SIGNATURE."
  (aset signature 4 fingerprint))

(defun epg-make-key (owner-trust)
  "Return a key object."
  (vector owner-trust nil nil))

(defun epg-key-owner-trust (key)
  "Return the owner trust of KEY."
  (aref key 0))

(defun epg-key-sub-key-list (key)
  "Return the sub key list of KEY."
  (aref key 1))

(defun epg-key-user-id-list (key)
  "Return the user ID list of KEY."
  (aref key 2))

(defun epg-key-set-sub-key-list (key sub-key-list)
  "Set the sub key list of KEY."
  (aset key 1 sub-key-list))

(defun epg-key-set-user-id-list (key user-id-list)
  "Set the user ID list of KEY."
  (aset key 2 user-id-list))

(defun epg-make-sub-key (validity capability secret algorithm length id
				  creation-time expiration-time)
  "Return a sub key object."
  (vector validity capability secret algorithm length id creation-time
	  expiration-time nil))

(defun epg-sub-key-validity (sub-key)
  "Return the validity of SUB-KEY."
  (aref sub-key 0))

(defun epg-sub-key-capability (sub-key)
  "Return the capability of SUB-KEY."
  (aref sub-key 1))

(defun epg-sub-key-secret (sub-key)
  "Return non-nil if SUB-KEY is a secret key."
  (aref sub-key 2))

(defun epg-sub-key-algorithm (sub-key)
  "Return the algorithm of SUB-KEY."
  (aref sub-key 3))

(defun epg-sub-key-length (sub-key)
  "Return the length of SUB-KEY."
  (aref sub-key 4))

(defun epg-sub-key-id (sub-key)
  "Return the ID of SUB-KEY."
  (aref sub-key 5))

(defun epg-sub-key-creation-time (sub-key)
  "Return the creation time of SUB-KEY."
  (aref sub-key 6))

(defun epg-sub-key-expiration-time (sub-key)
  "Return the expiration time of SUB-KEY."
  (aref sub-key 7))

(defun epg-sub-key-fingerprint (sub-key)
  "Return the fingerprint of SUB-KEY."
  (aref sub-key 8))

(defun epg-sub-key-set-fingerprint (sub-key fingerprint)
  "Set the fingerprint of SUB-KEY.
This function is for internal use only."
  (aset sub-key 8 fingerprint))

(defun epg-make-user-id (validity name)
  "Return a user ID object."
  (vector validity name nil))

(defun epg-user-id-validity (user-id)
  "Return the validity of USER-ID."
  (aref user-id 0))

(defun epg-user-id-name (user-id)
  "Return the name of USER-ID."
  (aref user-id 1))

(defun epg-user-id-signature-list (user-id)
  "Return the signature list of USER-ID."
  (aref user-id 2))

(defun epg-user-id-set-signature-list (user-id signature-list)
  "Set the signature list of USER-ID."
  (aset user-id 2 signature-list))

(defun epg-context-result-for (context name)
  (cdr (assq name (epg-context-result context))))

(defun epg-context-set-result-for (context name value)
  (let* ((result (epg-context-result context))
	 (entry (assq name result)))
    (if entry
	(setcdr entry value)
      (epg-context-set-result context (cons (cons name value) result)))))

(defun epg-signature-to-string (signature)
  (format "%s signature from %s %s%s"
	  (capitalize (symbol-name (epg-signature-status signature)))
	  (epg-signature-key-id signature)
	  (epg-signature-user-id signature)
	  (if (epg-signature-validity signature)
	      (format " (trust %s)"
		      (epg-signature-validity signature))
	    "")))

(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")
		       (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)
    (if epg-debug
	(save-excursion
	  (unless epg-debug-buffer
	    (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
	  (set-buffer epg-debug-buffer)
	  (goto-char (point-max))
	  (insert (format "%s %s\n" epg-gpg-program
			  (mapconcat #'identity args " ")))))
    (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
	(unless epg-debug-buffer
	  (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
	(set-buffer epg-debug-buffer)
	(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 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
    (if (fboundp 'set-buffer-multibyte)
	(set-buffer-multibyte nil))
    (if (file-exists-p (epg-context-output-file context))
	(let ((coding-system-for-read (if (epg-context-textmode 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)
  (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-flush (context)
  (if (eq (process-status (epg-context-process context)) 'run)
      (process-send-eof (epg-context-process context))))

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

(defun epg-delete-output-file (context)
  (if (and (epg-context-output-file context)
	   (file-exists-p (epg-context-output-file context)))
      (delete-file (epg-context-output-file context))))

(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)
  (if (and epg-key-id
	   (string-match "\\`passphrase\\." string))
    (let ((passphrase
	   (funcall
	    (if (consp (epg-context-passphrase-callback epg-context))
		(car (epg-context-passphrase-callback epg-context))
	      (epg-context-passphrase-callback epg-context))
	    epg-key-id
	    (if (consp (epg-context-passphrase-callback epg-context))
		(cdr (epg-context-passphrase-callback epg-context)))))
	  string)
      (if passphrase
	  (unwind-protect
	      (progn
		(setq string (concat passphrase "\n"))
		(fillarray passphrase 0)
		(setq passphrase nil)
		(process-send-string process string))
	    (if string
		(fillarray string 0)))))))

(defun epg-status-GET_BOOL (process string)
  (let ((entry (assoc string epg-prompt-alist)))
    (if (y-or-n-p (if entry (cdr entry) (concat string "? ")))
	(process-send-string process "y\n")
      (process-send-string process "n\n"))))

(defun epg-status-GET_LINE (process string)
  (let* ((entry (assoc string epg-prompt-alist))
	 (string (read-string (if entry (cdr entry) (concat string ": ")))))
    (process-send-string process (concat string "\n"))))

(defun epg-status-GOODSIG (process string)
  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
      (epg-context-set-result-for
       epg-context
       'verify
       (cons (epg-make-signature 'good
				 (match-string 1 string)
				 (match-string 2 string))
	     (epg-context-result-for epg-context 'verify)))))

(defun epg-status-EXPSIG (process string)
  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
      (epg-context-set-result-for
       epg-context
       'verify
       (cons (epg-make-signature 'expired
				 (match-string 1 string)
				 (match-string 2 string))
	     (epg-context-result-for epg-context 'verify)))))

(defun epg-status-EXPKEYSIG (process string)
  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
      (epg-context-set-result-for
       epg-context
       'verify
       (cons (epg-make-signature 'expired-key
				 (match-string 1 string)
				 (match-string 2 string))
	     (epg-context-result-for epg-context 'verify)))))

(defun epg-status-REVKEYSIG (process string)
  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
      (epg-context-set-result-for
       epg-context
       'verify
       (cons (epg-make-signature 'revoked-key
				 (match-string 1 string)
				 (match-string 2 string))
	     (epg-context-result-for epg-context 'verify)))))

(defun epg-status-BADSIG (process string)
  (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
      (epg-context-set-result-for
       epg-context
       'verify
       (cons (epg-make-signature 'bad
				 (match-string 1 string)
				 (match-string 2 string))
	     (epg-context-result-for epg-context 'verify)))))

(defun epg-status-VALIDSIG (process string)
  (let ((signature (car (epg-context-result-for epg-context 'verify))))
    (if (and signature
	     (eq (epg-signature-status signature) 'good)
	     (string-match "\\`\\([^ ]+\\) " string))
	(epg-signature-set-fingerprint signature (match-string 1 string)))))

(defun epg-status-TRUST_UNDEFINED (process string)
  (let ((signature (car (epg-context-result-for epg-context 'verify))))
    (if (and signature
	     (eq (epg-signature-status signature) 'good))
	(epg-signature-set-validity signature 'undefined))))

(defun epg-status-TRUST_NEVER (process string)
  (let ((signature (car (epg-context-result-for 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-for 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-for 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-for epg-context 'verify))))
    (if (and signature
	     (eq (epg-signature-status signature) 'good))
	(epg-signature-set-validity signature 'ultimate))))

(defun epg-status-PROGRESS (process string)
  (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
		    string)
      (funcall (if (consp (epg-context-progress-callback epg-context))
		   (car (epg-context-progress-callback epg-context))
		 (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))
	       (if (consp (epg-context-progress-callback epg-context))
		   (cdr (epg-context-progress-callback epg-context))))))

(defun epg-status-DECRYPTION_FAILED (process string)
  (epg-context-set-result-for
   epg-context 'error
   (cons 'decryption-failed
	 (epg-context-result-for epg-context 'error))))

(defun epg-status-NODATA (process string)
  (epg-context-set-result-for
   epg-context 'error
   (cons (cons 'no-data (string-to-number string))
	 (epg-context-result-for epg-context 'error))))

(defun epg-status-UNEXPECTED (process string)
  (epg-context-set-result-for
   epg-context 'error
   (cons (cons 'unexpected (string-to-number string))
	 (epg-context-result-for epg-context 'error))))

(defun epg-status-KEYEXPIRED (process string)
  (epg-context-set-result-for
   epg-context 'error
   (cons (cons 'key-expired string)
	 (epg-context-result-for epg-context 'error))))

(defun epg-status-KEYREVOKED (process string)
  (epg-context-set-result-for
   epg-context 'error
   (cons 'key-revoked
	 (epg-context-result-for epg-context 'error))))

(defun epg-status-BADARMOR (process string)
  (epg-context-set-result-for
   epg-context 'error
   (cons 'bad-armor
	 (epg-context-result-for epg-context 'error))))

(defun epg-status-INV_RECP (process string)
  (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
      (epg-context-set-result-for
       epg-context 'error
       (cons (list 'invalid-recipient
		   (string-to-number (match-string 1 string))
		   (match-string 2 string))
	     (epg-context-result-for epg-context 'error)))))

(defun epg-status-NO_RECP (process string)
  (epg-context-set-result-for
   epg-context 'error
   (cons 'no-recipients
	 (epg-context-result-for epg-context 'error))))

(defun epg-status-DELETE_PROBLEM (process string)
  (if (string-match "\\`\\([0-9]+\\)" string)
      (epg-context-set-result-for
       epg-context 'error
       (cons (cons 'delete-problem (string-to-number (match-string 1 string)))
	     (epg-context-result-for epg-context 'error)))))

(defun epg-status-SIG_CREATED (process string)
  (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
\\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
      (epg-context-set-result-for
       epg-context 'sign
       (cons (list (cons 'type (string-to-char (match-string 1 string)))
		   (cons 'pubkey-algorithm
			 (string-to-number (match-string 2 string)))
		   (cons 'digest-algorithm
			 (string-to-number (match-string 3 string)))
		   (cons 'class (string-to-number (match-string 4 string) 16))
		   (cons 'creation-time (match-string 5 string))
		   (cons 'fingerprint (substring string (match-end 0))))
	     (epg-context-result-for epg-context 'sign)))))

(defun epg-passphrase-callback-function (key-id handback)
  (read-passwd
   (if (eq key-id 'SYM)
       "Passphrase for symmetric encryption: "
     (if (eq key-id 'PIN)
	 "Passphrase for PIN: "
       (let ((entry (assoc key-id epg-user-id-alist)))
	 (if entry
	     (format "Passphrase for %s %s: " key-id (cdr entry))
	   (format "Passphrase for %s: " key-id)))))))

(defun epg-progress-callback-function (what char current total handback)
  (message "%s: %d%%/%d%%" what current total))

(defun epg-configuration ()
  "Return a list of internal configuration parameters of `epg-gpg-program'."
  (let (config type)
    (with-temp-buffer
      (apply #'call-process epg-gpg-program nil (list t nil) nil
	     '("--with-colons" "--list-config"))
      (goto-char (point-min))
      (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
	(setq type (intern (match-string 1))
	      config (cons (cons type
				 (if (memq type
					   '(pubkey cipher digest compress))
				     (mapcar #'string-to-number
					     (delete "" (split-string
							 (match-string 2)
							 ";")))
				   (match-string 2)))
			   config))))
    config))

(defun epg-list-keys-1 (name mode)
  (let ((args (append (list "--with-colons" "--no-greeting" "--batch"
			    "--fixed-list-mode" "--with-fingerprint"
			    "--with-fingerprint"
			    (if mode "--list-secret-keys" "--list-keys"))
		      (if name (list name))))
	keys string field index)
    (with-temp-buffer
      (apply #'call-process epg-gpg-program nil (list t nil) nil args)
      (goto-char (point-min))
      (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
	(setq keys (cons (make-vector 15 nil) keys)
	      string (match-string 0)
	      index 0
	      field 0)
	(while (eq index
		   (string-match "\\([^:]+\\)?:" string index))
	  (setq index (match-end 0))
	  (aset (car keys) field (match-string 1 string))
	  (setq field (1+ field))))
      (nreverse keys))))

(defun epg-make-sub-key-1 (line)
  (epg-make-sub-key
   (if (aref line 1)
       (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
   (delq nil
	 (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
		 (aref line 11)))
   (member (aref line 0) '("sec" "ssb"))
   (string-to-number (aref line 3))
   (string-to-number (aref line 2))
   (aref line 4)
   (aref line 5)
   (aref line 6)))

(defun epg-list-keys (&optional name mode)
  (let ((lines (epg-list-keys-1 name mode))
	keys)
    (while lines
      (cond
       ((member (aref (car lines) 0) '("pub" "sec"))
	(when (car keys)
	  (epg-key-set-sub-key-list
	   (car keys)
	   (nreverse (epg-key-sub-key-list (car keys))))
	  (epg-key-set-user-id-list
	   (car keys)
	   (nreverse (epg-key-user-id-list (car keys)))))
	(setq keys (cons (epg-make-key
			  (if (aref (car lines) 8)
			      (cdr (assq (string-to-char (aref (car lines) 8))
					 epg-key-validity-alist))))
			 keys))
	(epg-key-set-sub-key-list
	 (car keys)
	 (cons (epg-make-sub-key-1 (car lines))
	       (epg-key-sub-key-list (car keys)))))
       ((member (aref (car lines) 0) '("sub" "ssb"))
	(epg-key-set-sub-key-list
	 (car keys)
	 (cons (epg-make-sub-key-1 (car lines))
	       (epg-key-sub-key-list (car keys)))))
       ((equal (aref (car lines) 0) "uid")
	(epg-key-set-user-id-list
	 (car keys)
	 (cons (epg-make-user-id
		(if (aref (car lines) 1)
		    (cdr (assq (string-to-char (aref (car lines) 1))
			       epg-key-validity-alist)))
		(aref (car lines) 9))
	       (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)))
				     (aref (car lines) 9))))
      (setq lines (cdr lines)))
    (nreverse keys)))

(if (fboundp 'make-temp-file)
    (defalias 'epg-make-temp-file 'make-temp-file)
  ;; stolen from poe.el.
  (defun epg-make-temp-file (prefix)
    "Create a temporary file.
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)
      (unwind-protect
	  (let (file)
	    ;; First, create a temporary directory.
	    (while (condition-case ()
		       (progn
			 (setq tempdir (make-temp-name
					(concat
					 (file-name-directory prefix)
					 "DIR")))
			 ;; return nil or signal an error.
			 (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
			 (setq file (make-temp-name prefix))
			 ;; return nil or signal an error.
			 (add-name-to-file tempfile file))
		     ;; let's try again.
		     (file-already-exists t)))
	    file)
	;; Cleanup the tempfile.
	(and tempfile
	     (file-exists-p tempfile)
	     (delete-file tempfile))
	;; Cleanup the tempdir.
	(and tempdir
	     (file-directory-p tempdir)
	     (delete-directory tempdir))))))

;;;###autoload
(defun epg-start-decrypt (context cipher)
  "Initiate a decrypt operation on CIPHER.
CIPHER 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.
If you are unsure, use synchronous version of this function
`epg-decrypt-file' or `epg-decrypt-string' instead."
  (unless (epg-data-file cipher)
    (error "Not a file"))
  (epg-context-set-result context nil)
  (epg-start context (list "--decrypt" (epg-data-file cipher)))
  (epg-wait-for-status context '("BEGIN_DECRYPTION")))

;;;###autoload
(defun epg-decrypt-file (context cipher plain)
  "Decrypt a file CIPHER and store the result to a file PLAIN.
If PLAIN is nil, it returns the result as a string."
  (unwind-protect
      (progn
	(if plain
	    (epg-context-set-output-file context plain)
	  (epg-context-set-output-file 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)))
	(unless plain
	  (epg-read-output context)))
    (unless plain
      (epg-delete-output-file context))
    (epg-reset context)))

;;;###autoload
(defun epg-decrypt-string (context cipher)
  "Decrypt a string CIPHER and return the plain text."
  (let ((input-file (epg-make-temp-file "epg-input"))
	(coding-system-for-write 'binary))
    (unwind-protect
	(progn
	  (write-region cipher nil input-file)
	  (epg-context-set-output-file context
				       (epg-make-temp-file "epg-output"))
	  (epg-start-decrypt context (epg-make-data-from-file input-file))
	  (epg-flush context)
	  (epg-wait-for-completion context)
	  (if (epg-context-result-for context 'error)
	      (error "Decrypt failed: %S"
		     (epg-context-result-for context 'error)))
	  (epg-read-output context))
      (epg-delete-output-file context)
      (if (file-exists-p input-file)
	  (delete-file input-file))
      (epg-reset context))))

;;;###autoload
(defun epg-start-verify (context signature &optional signed-text)
  "Initiate a verify operation on SIGNATURE.
SIGNATURE and SIGNED-TEXT are a data object if they are specified.

For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
For a normal or a clear text 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.
If you are unsure, use synchronous version of this function
`epg-verify-file' or `epg-verify-string' instead."
  (epg-context-set-result context nil)
  (if signed-text
      ;; Detached signature.
      (if (epg-data-file signed-text)
	  (epg-start context (list "--verify" (epg-data-file signature)
				   (epg-data-file signed-text)))
	(epg-start context (list "--verify" (epg-data-file signature) "-"))
	(if (eq (process-status (epg-context-process context)) 'run)
	    (process-send-string (epg-context-process context)
				 (epg-data-string signed-text))))
    ;; Normal (or cleartext) signature.
    (if (epg-data-file signature)
	(epg-start context (list "--verify" (epg-data-file signature)))
      (epg-start context (list "--verify"))
      (if (eq (process-status (epg-context-process context)) 'run)
	  (process-send-string (epg-context-process context)
			       (epg-data-string signature))))))

;;;###autoload
(defun epg-verify-file (context signature &optional signed-text plain)
  "Verify a file SIGNATURE.
SIGNED-TEXT and PLAIN are also a file if they are specified.

For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
For a normal or a clear text signature, SIGNED-TEXT should be nil."
  (unwind-protect
      (progn
	(if plain
	    (epg-context-set-output-file context plain)
	  (epg-context-set-output-file context
				       (epg-make-temp-file "epg-output")))
	(if signed-text
	    (epg-start-verify context
			      (epg-make-data-from-file signature)
			      (epg-make-data-from-file signed-text))
	  (epg-start-verify context
			    (epg-make-data-from-file signature)))
	(epg-wait-for-completion context)
	(unless plain
	  (epg-read-output context)))
    (unless plain
      (epg-delete-output-file context))
    (epg-reset context)))

;;;###autoload
(defun epg-verify-string (context signature &optional signed-text)
  "Verify a string SIGNATURE.
SIGNED-TEXT is a string if it is specified.

For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
For a normal or a clear text signature, SIGNED-TEXT should be nil."
  (let ((coding-system-for-write 'binary)
	input-file)
    (unwind-protect
	(progn
	  (epg-context-set-output-file context
				       (epg-make-temp-file "epg-output"))
	  (if signed-text
	      (progn
		(setq input-file (epg-make-temp-file "epg-signature"))
		(write-region signature nil input-file)
		(epg-start-verify context
				  (epg-make-data-from-file input-file)
				  (epg-make-data-from-string signed-text)))
	    (epg-start-verify context (epg-make-data-from-string signature)))
	  (epg-flush context)
	  (epg-wait-for-completion context)
	  (epg-read-output context))
      (epg-delete-output-file context)
      (if (and input-file
	       (file-exists-p input-file))
	  (delete-file input-file))
      (epg-reset context))))

;;;###autoload
(defun epg-start-sign (context plain &optional mode)
  "Initiate a sign operation on PLAIN.
PLAIN is a data object.

If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
If MODE is t or 'detached, it makes a detached signature.
Otherwise, it makes a normal 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.
If you are unsure, use synchronous version of this function
`epg-sign-file' or `epg-sign-string' instead."
  (epg-context-set-result context nil)
  (epg-start context
	     (append (list (if (eq mode 'clearsign)
			       "--clearsign"
			     (if (or (eq mode t) (eq mode 'detached))
				 "--detach-sign"
			       "--sign")))
		     (apply #'nconc
			    (mapcar
			     (lambda (signer)
			       (list "-u"
				     (epg-sub-key-id
				      (car (epg-key-sub-key-list signer)))))
			     (epg-context-signers context)))
		     (if (epg-data-file plain)
			 (list (epg-data-file plain)))))
  (epg-wait-for-status context '("BEGIN_SIGNING"))
  (if (and (epg-data-string plain)
	   (eq (process-status (epg-context-process context)) 'run))
      (process-send-string (epg-context-process context)
			   (epg-data-string plain))))

;;;###autoload
(defun epg-sign-file (context plain signature &optional mode)
  "Sign a file PLAIN and store the result to a file SIGNATURE.
If SIGNATURE is nil, it returns the result as a string.
If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
If MODE is t or 'detached, it makes a detached signature.
Otherwise, it makes a normal signature."
  (unwind-protect
      (progn
	(if signature
	    (epg-context-set-output-file context signature)
	  (epg-context-set-output-file context
				       (epg-make-temp-file "epg-output")))
	(epg-start-sign context (epg-make-data-from-file plain) mode)
	(epg-wait-for-completion context)
	(if (epg-context-result-for context 'error)
	    (error "Sign failed: %S"
		   (epg-context-result-for context 'error)))
	(unless signature
	  (epg-read-output context)))
    (unless signature
      (epg-delete-output-file context))
    (epg-reset context)))

;;;###autoload
(defun epg-sign-string (context plain &optional mode)
  "Sign a string PLAIN and return the output as string.
If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
If MODE is t or 'detached, it makes a detached signature.
Otherwise, it makes a normal 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-flush context)
	(epg-wait-for-completion context)
	(if (epg-context-result-for context 'error)
	    (error "Sign failed: %S"
		   (epg-context-result-for context 'error)))
	(epg-read-output context))
    (epg-delete-output-file context)
    (epg-reset context)))

;;;###autoload
(defun epg-start-encrypt (context plain recipients
				  &optional sign always-trust)
  "Initiate an encrypt operation on PLAIN.
PLAIN is a data object.
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.
If you are unsure, use synchronous version of this function
`epg-encrypt-file' or `epg-encrypt-string' instead."
  (epg-context-set-result context nil)
  (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"
				     (epg-sub-key-id
				      (car (epg-key-sub-key-list recipient)))))
			     recipients))
		     (if (epg-data-file plain)
			 (list (epg-data-file plain)))))
  (if sign
      (epg-wait-for-status context '("BEGIN_SIGNING")))
  (epg-wait-for-status context '("BEGIN_ENCRYPTION"))
  (if (and (epg-data-string plain)
	   (eq (process-status (epg-context-process context)) 'run))
      (process-send-string (epg-context-process context)
			   (epg-data-string plain))))

;;;###autoload
(defun epg-encrypt-file (context plain recipients
				 cipher &optional sign always-trust)
  "Encrypt a file PLAIN and store the result to a file CIPHER.
If CIPHER is nil, it returns the result as a string.
If RECIPIENTS is nil, it performs symmetric encryption."
  (unwind-protect
      (progn
	(if cipher
	    (epg-context-set-output-file context cipher)
	  (epg-context-set-output-file context
				       (epg-make-temp-file "epg-output")))
	(epg-start-encrypt context (epg-make-data-from-file plain)
			   recipients sign always-trust)
	(epg-wait-for-completion context)
	(if (epg-context-result-for context 'error)
	    (error "Encrypt failed: %S"
		   (epg-context-result-for context 'error)))
	(unless cipher
	  (epg-read-output context)))
    (unless cipher
      (epg-delete-output-file context))
    (epg-reset context)))

;;;###autoload
(defun epg-encrypt-string (context plain recipients
				   &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-flush context)
	(epg-wait-for-completion context)
	(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)))

;;;###autoload
(defun epg-start-export-keys (context keys)
  "Initiate an export keys operation.

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.
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-result context nil)
  (epg-start context (cons "--export"
			   (mapcar
			    (lambda (key)
			      (epg-sub-key-id
			       (car (epg-key-sub-key-list key))))
			    keys))))

;;;###autoload
(defun epg-export-keys-to-file (context keys file)
  "Extract public KEYS."
  (unwind-protect
      (progn
	(if keys
	    (epg-context-set-output-file context file)
	  (epg-context-set-output-file context
				       (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"))
	(unless file
	  (epg-read-output context)))
    (unless file
      (epg-delete-output-file context))
    (epg-reset context)))

;;;###autoload
(defun epg-export-keys-to-string (context keys)
  "Extract public KEYS and return them as a string."
  (epg-export-keys-to-file context keys nil))

;;;###autoload
(defun epg-start-import-keys (context keys)
  "Initiate an import keys operation.
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.
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-result context nil)
  (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
  (epg-start context (list "--import" (epg-data-file keys)))
  (if (and (epg-data-string keys)
	   (eq (process-status (epg-context-process context)) 'run))
      (process-send-string (epg-context-process context)
			   (epg-data-string keys))))
  
(defun epg-import-keys-1 (context keys)
  (unwind-protect
      (progn
	(epg-start-import-keys context keys)
	(if (epg-data-file keys)
	    (epg-flush context))
	(epg-wait-for-completion context)
	(if (epg-context-result-for context 'error)
	    (error "Import keys failed"))
	(epg-read-output context))
    (epg-reset context)))

;;;###autoload
(defun epg-import-keys-from-file (context keys)
  "Add keys from a file KEYS."
  (epg-import-keys-1 context (epg-make-data-from-file keys)))

;;;###autoload
(defun epg-import-keys-from-string (context keys)
  "Add keys from a string KEYS."
  (epg-import-keys-1 context (epg-make-data-from-string keys)))

;;;###autoload
(defun epg-start-delete-keys (context keys &optional allow-secret)
  "Initiate an delete keys operation.

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.
If you are unsure, use synchronous version of this function
`epg-delete-keys' instead."
  (epg-context-set-result context nil)
  (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))))

;;;###autoload
(defun epg-delete-keys (context keys &optional allow-secret)
  "Delete KEYS from the key ring."
  (unwind-protect
      (progn
	(epg-start-delete-keys context keys)
	(epg-wait-for-completion context)
	(if (epg-context-result-for context 'error)
	    (error "Delete key failed")))
    (epg-reset context)))

(provide 'epg)

;;; epg.el ends here