(eval-when-compile (require 'epg))

(defvar epg-pgp50i-pgpv-program "pgpv")

(defconst epg-pgp50i-message-alist
  '(("Message is encrypted." .
     "MESSAGE_IS_ENCRYPTED")
    ("Need a pass phrase to decrypt private key:" .
     "NEED_PASSPHRASE_TO_DECRYPT_KEY")
    ("Enter pass phrase: " .
     "ENTER_PASSPHRASE")
    ("Pass phrase is good." .
     "GOOD_PASSPHRASE")
    ("Cannot decrypt message.  It can only be decrypted by:" .
     "CANNOT_DECRYPT")
    ("Good signature made .* by key:" .
     "GOOD_SIGNATURE")
    ("BAD signature made .* by key:" .
     "BAD_SIGNATURE")
    ("Error .* checking signature:  " .
     "ERROR_SIGNATURE")
    ("Signature by unknown keyid: " .
     "UNKNOWN_SIGNATURE")))

(defun epg-pgp50i--start (context program args)
  (let ((args (append '("--headers" "--language=us")
		      (if (epg-context-armor context) '("--armor"))
		      (if (epg-context-textmode context) '("--textmode"))
		      (if (epg-context-output-file context)
			  (list "-o" (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"
			  program
			  (mapconcat #'identity args " ")))))
    (with-current-buffer buffer
      (make-local-variable 'epg-read-point)
      (setq epg-read-point (point-min))
      (make-local-variable 'epg-process-filter-running)
      (setq epg-process-filter-running nil)
      (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 program args)))
      (set-default-file-modes orig-mode))
    (set-process-filter process #'epg-pgp50i--process-filter)
    (set-process-sentinel process #'ignore)
    (epg-context-set-process context process)))

(defun epg-pgp50i--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)
	(unless epg-process-filter-running
	  (unwind-protect
	      (progn
		(setq epg-process-filter-running t)
		(goto-char epg-read-point)
		(while (not (eobp))
		  (if (looking-at
		       "^\\(PRI\\|INF\\|QRY\\|STA\\|WRN\\|ERR\\):  \\(.*\\)")
		      (let ((message (match-string 2))
			    (pointer epg-pgp50i-message-alist)
			    status symbol)
			(while pointer
			  (if (string-match (car (car pointer)) message)
			      (setq status (cdr (car pointer))
				    pointer nil))
			  (setq pointer (cdr pointer)))
			(when status
			  (unless (looking-at ".*\n")
			    (end-of-line)
			    (insert "\n"))
			  (if (member status epg-pending-status-list)
			      (setq epg-pending-status-list nil))
			  (setq symbol (intern-soft (concat
						     "epg-pgp50i--status-"
						     status)))
			  (if (and symbol
				   (fboundp symbol))
			      (funcall symbol epg-context message)))))
		  (forward-line)
		  (setq epg-read-point (point))))
	    (setq epg-process-filter-running nil))))))

(defun epg-pgp50i--read-line (context)
  (if (eq (process-status (epg-context-process context)) 'run)
      (save-excursion
	(set-buffer (process-buffer (epg-context-process context)))
	(forward-line)
	(goto-char epg-read-point)
	(if (looking-at ".*\n")
	    (buffer-substring (point) (progn (end-of-line) (point)))))))

(defun epg-pgp50i--status-ENTER_PASSPHRASE (context message)
  (epg--status-GET_HIDDEN context "passphrase."))

(defun epg-pgp50i--read-key (context)
  (let ((line (epg-pgp50i--read-line context))
	key-id user-id-list)
    (when (and line
	       (string-match "[ 0-9]+ bits, Key ID \\([0-9A-F]+\\)" line))
      (setq key-id (match-string 1 line))
      (while (and (setq line (epg-pgp50i--read-line context))
		  (string-match "\"\\([^\"]+\\)\"" line))
	(setq user-id-list (cons (match-string 1 line) user-id-list)))
      (cons key-id user-id-list))))

(defun epg-pgp50i--status-NEED_PASSPHRASE_TO_DECRYPT_KEY (context message)
  (let* ((key (epg-pgp50i--read-key context))
	 (entry (assoc (car key) epg-user-id-alist)))
    (if entry
	(setcdr entry (car (cdr key)))
      (setq epg-user-id-alist (cons (cons (car key) (car (cdr key)))
				    epg-user-id-alist)))
    (setq epg-key-id (car key))))

(defun epg-pgp50i--status-CANNOT_DECRYPT (context message)
  (epg-context-set-result-for
   context 'error
   (cons (cons 'decryption-failed
	       (epg-pgp50i--read-key context))
	 (epg-context-result-for context 'error))))

(defun epg-pgp50i--parse-time (string)
  (if (string-match "\\`\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \
\\([0-9][0-9]\\):\\([0-9][0-9]\\) GMT\\'" string)
      (encode-time 0
		   (string-to-number (match-string 5 string))
		   (string-to-number (match-string 4 string))
		   (string-to-number (match-string 3 string))
		   (string-to-number (match-string 2 string))
		   (string-to-number (match-string 1 string))
		   0)))

(defun epg-pgp50i--status-GOOD_SIGNATURE (context message)
  (if (string-match "Good signature made \\(.*\\) by key:" message)
      (let ((time (epg-pgp50i--parse-time (match-string 1 message)))
	    (key (epg-pgp50i--read-key context)))
	(epg--status-*SIG context 'good (concat (car key) " " (car (cdr key))))
	(epg-signature-set-creation-time
	 (car (epg-context-result-for context 'verify))
	 time))))

(defun epg-pgp50i--status-BAD_SIGNATURE (context message)
  (if (string-match "BAD signature made \\(.*\\) by key:" message)
      (let ((time (epg-pgp50i--parse-time (match-string 1 message)))
	    (key (epg-pgp50i--read-key context)))
	(epg--status-*SIG context 'good (concat (car key) " " (car (cdr key))))
	(epg-signature-set-creation-time
	 (car (epg-context-result-for context 'verify))
	 time))))

(defadvice epg-start-decrypt
  (around epg-pgp50i activate)
  (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
      ad-do-it
    (let ((context (ad-get-arg 0))
	  (cipher (ad-get-arg 1)))
      (unless (epg-data-file cipher)
	(error "Not a file"))
      (epg-context-set-operation context 'decrypt)
      (epg-context-set-result context nil)
      (epg-pgp50i--start context epg-pgp50i-pgpv-program
			 (list  "--batchmode=0" "--force"
				(epg-data-file cipher))))))

(defadvice epg-start-verify
  (around epg-pgp50i activate)
  (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
      ad-do-it
    (let ((context (ad-get-arg 0))
	  (signature (ad-get-arg 1))
	  (signed-text (ad-get-arg 2)))
      (epg-context-set-operation context 'verify)
      (epg-context-set-result context nil)
      (if signed-text
	  ;; Detached signature.
	  (if (epg-data-file signed-text)
	      (epg-pgp50i--start context
				 epg-pgp50i-pgpv-program
				 (list  "--batchmode=1" "--force"
					(epg-data-file signature)
					(epg-data-file signed-text)))
	    (epg-pgp50i--start context
			       epg-pgp50i-pgpv-program
			       (list  "--batchmode=1" "--force"
				      (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)))
	    (if (eq (process-status (epg-context-process context)) 'run)
		(process-send-eof (epg-context-process context))))
	;; Normal (or cleartext) signature.
	(if (epg-data-file signature)
	    (epg-pgp50i--start context
			       epg-pgp50i-pgpv-program
			       (list "--batchmode=1" "--force"
				     (epg-data-file signature)))
	  (epg-pgp50i--start context
			     epg-pgp50i-pgpv-program
			     (list "--batchmode=1" "--force"))
	  (if (eq (process-status (epg-context-process context)) 'run)
	      (process-send-string (epg-context-process context)
				   (epg-data-string signature)))
	  (if (eq (process-status (epg-context-process context)) 'run)
	      (process-send-eof (epg-context-process context))))))))

(defadvice epg-start-sign
  (around epg-pgp50i activate)
  (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
      ad-do-it
    (error "Not implemented yet")))

(defadvice epg-start-encrypt
  (around epg-pgp50i activate)
  (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
      ad-do-it
    (error "Not implemented yet")))

(provide 'epg-pgp50i)

;;; epg-pgp50i.el ends here