;;;
;;;  cmail-crypt.el --- cmail with mailcrypt 3.4 or later
;;;
;;; Copyright (C) 1997 Toshihiko Ueki
;;;
;;; Author: Toshihiko Ueki <toshi@he.kobelcosys.co.jp>
;;; Created:       1997/04/20
;;; Last modified: 2000/06/14
;;; Version: $Revision: 1.3 $

;;; This file is not part of mailcrypt.
;;;
;;; 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 This program.  If not, write to the Free Software
;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; Commentary:
;;; 
;;;
;;;
;;; Code:

;;; @ require modules
;;;

(require 'cmail)
(require 'mailcrypt)
(load "mc-pgp")

;;; @ version definition
;;;

(defconst cmail-crypt-version "$Revision: 1.3 $" "*cmail-crypt version")

;;; @ variables
;;;

(defvar cmail-crypt-automatic-decrypt/verify t
  "*If non-nil then decrypt message and verify signature automatically.")

(if (string= mc-version "3.4")
    nil
  (defvar cmail-crypt-default-version "5.0"
    "*Default PGP program version")
  (defvar cmail-crypt-altpgp-version "5.0"
    "*PGP version to use instead of GnuPG. Must specify \"2.6\" or \"5.0\"."))

;;; @ working variables
;;;

(defvar cmail-crypt-current-page-number 0 "Current page number holder for working")

(defvar cmail-crypt-perform-verify nil)
(defvar cmail-crypt-perform-decrypt nil)

(defvar cmail-crypt-after-decrypt/verify-hook nil)

(defvar cmail-crypt-26io-code-defined-p nil)

(if (not (string= mc-version "3.4"))
    (defvar cmail-crypt-temporary-version nil))

;;; @ working constants
;;;

(defconst mc-pgp-trademark-string "^Pretty Good Privacy(tm)"
  "*Text for trademark string of PGP.")
(defconst mc-gpg-trademark-string "^GNU Privacy Guard"
  "*Text for trademark string of GPG.")
(defconst mc-pgp-sig-begin-line "^-----BEGIN PGP \\(SIGNATURE\\|MESSAGE\\)-----"
  "*Text for start of PGP signature.")
(defconst mc-pgp-signature-begin-line (concat mc-pgp-sig-begin-line "\r?$")
  "*Text for start of PGP signature.")
(defconst mc-pgp-verify-error "ERROR: Temporary process error occurred.\n"
  "*Text for temporary error. Maybe pgp process error occurred.")
(defconst mc-pgp-exsig-re "^File has signature."
  "*Text for result of unverified signature.")
(defconst mc-pgp-gsig-re "^Good signature made.*by key"
  "*Regular expression matching a PGP signature validation message")
(defconst mc-pgp-bsig-re "^BAD signature made.*by key"
  "*Regular expression matching an error from PGP")
(defconst mc-pgp-ukid-re "^Signature by unknown keyid: 0x.*\n"
  "*Regular expression matching an unknown PGP keyid")
(defconst cmail-crypt-pgp-verified-header "X-PGP-Verify: "
  "*Header field for PGP.")
(defconst cmail-crypt-gpg-verified-header "X-GnuPG-"
  "*Header field for GnuPG.")

;;; @ PGP program I/O code definition
;;;

(defun cmail-crypt-26io-code-definition ()
  "*Define I/O code for PGP 2.6."
  (if cmail-crypt-26io-code-defined-p
      nil
    (setq cmail-crypt-26io-code-defined-p t)
    (if (or (boundp 'MULE) (boundp 'NEMACS))
	(define-program-coding-system nil ".*pgp.*" (cons *autoconv* *junet*))
      (or (featurep 'xemacs)
	  (modify-coding-system-alist 'process mc-pgp-path '(iso-2022-7bit . iso-2022-7bit))))))

;;; @ PGP version select
;;;

(if (string= mc-version "3.4")
    nil
  (defun cmail-crypt-change-default-version ()
    "*Toggle using pgp version."
    (interactive)
    (cond
     ((string= cmail-crypt-default-version "5.0")
      (setq cmail-crypt-default-version "2.6"))
     ((string= cmail-crypt-default-version "2.6")
      (setq cmail-crypt-default-version "GPG"))
     (t
      (setq cmail-crypt-default-version "5.0")))
    (cmail-crypt-set-pgp-default-version))

  (defun cmail-crypt-change-pgp-version-temporarily (&optional ver)
    "*Change using pgp version temporarily."
    (interactive)
    (if ver
	(setq cmail-crypt-temporary-version ver)
      (cond
       ((string= cmail-crypt-temporary-version "5.0")
	(setq cmail-crypt-temporary-version "2.6"))
       ((string= cmail-crypt-temporary-version "2.6")
	(setq cmail-crypt-temporary-version "GPG"))
       (t
	(setq cmail-crypt-temporary-version "5.0"))))
    (cmail-crypt-set-pgp-version))

  (defun cmail-crypt-set-pgp-default-version ()
    "*Set pgp version to default."
    (interactive)
    (setq cmail-crypt-temporary-version cmail-crypt-default-version)
    (cmail-crypt-set-pgp-version))

  (defun cmail-crypt-set-pgp-version ()
    "*Set pgp version."
    (cond
     ((string= cmail-crypt-temporary-version "GPG")
      (mc-setversion "gpg"))
     ((string= cmail-crypt-temporary-version "5.0")
      (mc-setversion "5.0"))
     (t
      (mc-setversion "2.6")
      (cmail-crypt-26io-code-definition))))

  (defun cmail-crypt-toggle-mc-write-mode-menu-bar ()
    (cond
     ((string= cmail-crypt-temporary-version "5.0")
      (easy-menu-define mc-write-mode-menu (if mc-xemacs-p nil (list mc-write-mode-map))
	"Mailcrypt write mode menu."
	'("Mailcrypt"
	  ["Encrypt Message" mc-encrypt t]
	  ["Sign Message" mc-sign t]
	  ["Insert Public Key" mc-insert-public-key t]
	  ["Fetch Key" mc-pgp-fetch-key t]
	  ["Encrypt for Remailer(s)" mc-remailer-encrypt-for-chain t]
	  ["Insert Pseudonym" mc-remailer-insert-pseudonym t]
	  ["Insert Response Block" mc-remailer-insert-response-block t]
	  ["Forget Passphrase(s)" mc-deactivate-passwd t]
	  ["Change PGP version -> 2.6" cmail-crypt-change-pgp-version-temporarily t])))
     ((string= cmail-crypt-temporary-version "2.6")
      (easy-menu-define mc-write-mode-menu (if mc-xemacs-p nil (list mc-write-mode-map))
	"Mailcrypt write mode menu."
	'("Mailcrypt"
	  ["Encrypt Message" mc-encrypt t]
	  ["Sign Message" mc-sign t]
	  ["Insert Public Key" mc-insert-public-key t]
	  ["Fetch Key" mc-pgp-fetch-key t]
	  ["Encrypt for Remailer(s)" mc-remailer-encrypt-for-chain t]
	  ["Insert Pseudonym" mc-remailer-insert-pseudonym t]
	  ["Insert Response Block" mc-remailer-insert-response-block t]
	  ["Forget Passphrase(s)" mc-deactivate-passwd t]
	  ["Change PGP version -> GPG" cmail-crypt-change-pgp-version-temporarily t])))
     (t
      (easy-menu-define mc-write-mode-menu (if mc-xemacs-p nil (list mc-write-mode-map))
	"Mailcrypt write mode menu."
	'("Mailcrypt"
	  ["Encrypt Message" mc-encrypt t]
	  ["Sign Message" mc-sign t]
	  ["Insert Public Key" mc-insert-public-key t]
	  ["Fetch Key" mc-pgp-fetch-key t]
	  ["Encrypt for Remailer(s)" mc-remailer-encrypt-for-chain t]
	  ["Insert Pseudonym" mc-remailer-insert-pseudonym t]
	  ["Insert Response Block" mc-remailer-insert-response-block t]
	  ["Forget Passphrase(s)" mc-deactivate-passwd t]
	  ["Change PGP version -> 5.0" cmail-crypt-change-pgp-version-temporarily t]))))))

;;; @ PGP decoder
;;;

(defun cmail-crypt-toggle-automatic-decrypt/verify ()
  "*Toggle automatic decrypt/verify feature."
  (interactive)
  (if (setq cmail-crypt-automatic-decrypt/verify
            (not cmail-crypt-automatic-decrypt/verify))
      (progn
	(setq cmail-crypt-perform-verify t)
	(setq cmail-crypt-perform-decrypt t))
    (setq cmail-crypt-perform-verify nil)
    (setq cmail-crypt-perform-decrypt nil))
  (if (not (string= mc-version "3.4"))
      (setq cmail-crypt-temporary-version cmail-crypt-default-version))
  (cmail-show-contents (cmail-get-page-number-from-summary)))

(defun cmail-crypt-decrypt/verify ()
  "*Decrypt the contents and/or verify the signature in this message."
  (or (cmail-crypt-check-mime-message)
      (if cmail-crypt-perform-verify (cmail-crypt-verify))
      (if cmail-crypt-perform-decrypt (cmail-crypt-decrypt))
  (run-hooks 'cmail-crypt-after-decrypt/verify-hook)))

(defun cmail-crypt-check-mime-message ()
  "*Check if this message is mime enclosed pgp message."
  (save-excursion
    (set-buffer *cmail-mail-buffer)
    (save-restriction
      (re-search-forward "\n\n" nil t)
      (narrow-to-region (point-min) (point))
      (beginning-of-buffer)
      (and (cmail-get-field-values "MIME-Version")
	   (re-search-forward
	     "^[Cc]ontent-[Tt]ype:[ \t]+multipart/.*pgp.*" nil t)))))

(defun cmail-crypt-check-decrypt/verify (beg end func)
  "*Check if this message has signature or encrypted message."
  (save-excursion
    (if (cmail-crypt-check-decrypt/verify-search-forward beg)
	(if (cmail-crypt-check-decrypt/verify-search-forward end)
	    (let ((buffer-read-only nil)
		  (gpgver (concat mc-pgp-sig-begin-line "\nVersion: GnuPG"))
		  tmpver cmail-crypt-temporary-version)
	      (beginning-of-buffer)
	      (if (null (string= mc-version "3.4"))
		  (progn
		    (if (null (re-search-forward gpgver nil t))
			(if (string= cmail-crypt-default-version "GPG")
			    (setq tmpver cmail-crypt-altpgp-version)
			  (setq tmpver cmail-crypt-default-version))
		      (setq tmpver "GPG")
		      (beginning-of-buffer))
		    (save-excursion
		      (cmail-crypt-change-pgp-version-temporarily tmpver))))
	      (flet ((error (&rest args) (apply 'message args)))
		(funcall func))
	      (set-buffer-modified-p nil)
	      (cmail-go-summary))))))

(defun cmail-crypt-check-decrypt/verify-search-forward (s)
  "*Helper function for cmail-crypt-check-decrypt/verify
and cmail-crypt-after-verify."
  (let (b e)
    (setq b (if (string-match "^\\^" s) "" "^"))
    (setq e (if (string-match "\r?\\$$" s) "" "\r?$"))
    (re-search-forward (concat b s e) nil t)))

(defun cmail-crypt-check-mail-buffer ()
  "*Check if \"*cmail-mail-buffer\" has the contents of this page."
  (let ((cmail-crypt-perform-verify nil) (cmail-crypt-perform-decrypt nil))
    (set-buffer *cmail-summary-buffer)
    (if (not (get-buffer *cmail-mail-buffer))
	(let ((page (cmail-get-page-number-from-summary)))
	  (setq cmail-crypt-current-page-number page)
	  (cmail-show-contents page))
      (let ((page (cmail-get-page-number-from-summary)))
	(if (not (= cmail-crypt-current-page-number page))
	    (progn
	      (setq cmail-crypt-current-page-number page)
	      (cmail-show-contents page)))))))

(defun cmail-crypt-decrypt-message ()
  "*Decrypt the contents of this message."
  (interactive)
  (cmail-crypt-check-mail-buffer)
  (let ((cmail-crypt-perform-verify nil))
    (cmail-crypt-decrypt)))

(defun cmail-crypt-decrypt ()
  "*Search and decrypt the contents of this message."
  (save-excursion
    (set-buffer *cmail-mail-buffer)
    (let ((beg mc-pgp-msg-begin-line) (end mc-pgp-msg-end-line))
      (cmail-crypt-check-decrypt/verify beg end 'cmail-crypt-decrypt-func))))

(defun cmail-crypt-decrypt-func ()
  "*Decrypt the contents."
  (if (not (car (mc-decrypt-message)))
      (cmail-select-buffer *cmail-mail-buffer))
  (cmail-crypt-after-decrypt/verify nil))

(defun cmail-crypt-verify-signature ()
  "*Verify the signature in the current message."
  (interactive)
  (cmail-crypt-check-mail-buffer)
  (let ((cmail-crypt-perform-decrypt nil))
    (cmail-crypt-verify)))

(defun cmail-crypt-verify ()
  "*Search and verify the signature in the current message."
  (save-excursion
    (set-buffer *cmail-mail-buffer)
    (let ((beg mc-pgp-signed-begin-line) (end mc-pgp-signed-end-line))
      (cmail-crypt-check-decrypt/verify beg end 'cmail-crypt-verify-func))))

(defun cmail-crypt-verify-func ()
  "*Verify the signature."
  (mc-verify-signature)
  (cmail-crypt-after-decrypt/verify t))

(defun cmail-crypt-after-decrypt/verify (after-verify)
  "*Display verified message."
  (re-search-forward "\n\n")
  (backward-char 1)
  (save-excursion
    (if (string= cmail-crypt-temporary-version "GPG")
	nil
      (let ((region (cmail-crypt-get-message)))
	(if (null region)
	    nil
	  (insert-string cmail-crypt-pgp-verified-header)
	  (cmail-insert-buffer-substring mc-buffer-name (car region) (cdr region))
	  (insert-string "\n")))))
  (if after-verify (cmail-crypt-after-verify)))

(defun cmail-crypt-after-verify ()
  "*Display verified message."
  (let ((beg (point)) end)
    (if (cmail-crypt-check-decrypt/verify-search-forward mc-pgp-signed-begin-line)
	(progn
	  (replace-match "")
	  (if (string= cmail-crypt-temporary-version "GPG")
	      (progn
		(forward-char 1)
		(delete-region beg (point))
		(insert-string cmail-crypt-gpg-verified-header)
		(end-of-line)
		(insert-string "\n")))
    (setq beg (point)))
    (if (cmail-crypt-check-decrypt/verify-search-forward mc-pgp-signed-end-line)
	(setq end (match-end 0))
      (setq end (point-max)))
    (narrow-to-region beg end))
  (if (re-search-forward mc-pgp-signature-begin-line nil t)
      (delete-region (match-beginning 0) (point-max)))
  (delete-blank-lines)
  (goto-char beg)
  (widen)
  (delete-blank-lines)
  (while (re-search-forward "^- -" nil t)
    (replace-match "-"))))

(defun cmail-crypt-get-message ()
  "*Get verification result in \"mc-buffer-name\" buffer."
  (save-excursion
    (set-buffer mc-buffer-name)
    (let* ((pmax (point-max))
	   (match0 pmax)
	   (match1 pmax)
	   (match2 pmax)
	   start)
      (if (or (string= mc-version "3.4")
	      (string= cmail-crypt-default-version "2.6"))
	  (progn
	    (beginning-of-buffer)
	    (if (re-search-forward mc-pgp-trademark-string nil t)
		(beginning-of-line)
	      (beginning-of-buffer))
	    (save-excursion
	      (save-excursion
		(while (re-search-forward "\C-g" nil t)
		  (replace-match "")))
	      (save-excursion
		(if (re-search-forward mc-pgp-sigok-re nil t)
		    (setq match1 (match-beginning 0))))
	      (save-excursion
		(if (re-search-forward mc-pgp-error-re nil t)
		    (setq match2 (match-beginning 0))))
	      (if (and (= match0 match1) (= match0 match2))
		  (save-excursion
		    (if (re-search-forward mc-pgp-exsig-re nil t)
			(progn
			  (setq start (match-beginning 0))
			  (goto-char start)
			  (end-of-line)
			  (cons start (point)))
		      nil))
		(setq start (min match1 match2))
		(goto-char start)
		(end-of-line)
		(cons start (point)))))
	(goto-char (point-max))
	(if (re-search-backward mc-pgp-gsig-re nil t) 
	    (setq start (match-beginning 0))
	  (if (re-search-backward mc-pgp-bsig-re nil t) 
	      (setq start (match-beginning 0))
	    (if (re-search-backward mc-pgp-ukid-re nil t) 
		(setq start (match-beginning 0)))))
	(if (null start)
	    nil
	  (end-of-line)
	  (search-backward " by")
	  (cons start (point)))))))

(defun cmail-crypt-snarf-keys ()
  "*Adds keys from current message to public key ring"
  (interactive)
  (if (not (get-buffer *cmail-mail-buffer))
      (let ((page (cmail-get-page-number-from-summary)))
	(setq cmail-crypt-current-page-number page)
	(cmail-show-contents page)))
  (save-excursion
    (let ((page (cmail-get-page-number-from-summary)))
      (set-buffer *cmail-mail-buffer)
      (if (not (= cmail-crypt-current-page-number page))
	  (progn
	    (setq cmail-crypt-current-page-number page)
	    (cmail-show-contents page)))
      (mc-snarf-keys))))

(defun cmail-crypt-show-MailCrypt-buffer ()
  "*Show contents in \"mc-buffer-name\" buffer."
  (interactive)
  (if (get-buffer mc-buffer-name)
      (progn
	(pop-to-buffer mc-buffer-name)
	(set-buffer-modified-p nil)
	(cmail-go-summary))))

;;; @ set up
;;;

(autoload 'mc-install-write-mode "mailcrypt" nil t)
(autoload 'mc-install-read-mode "mailcrypt" nil t)
(autoload 'mc-verify-signature "mc-toplev" nil t)
(autoload 'mc-decrypt-message "mc-toplev" nil t)
(autoload 'mc-snarf-keys "mc-toplev" nil t)
(autoload 'mc-scheme-pgp50 "mc-pgp5" nil t)
(autoload 'mc-scheme-pgp "mc-pgp" nil t)

(add-hook 'mail-mode-hook 'mc-install-write-mode)
(add-hook 'cmail-summary-mode-hook 'mc-install-read-mode)
(add-hook 'cmail-show-contents-after-hook 'cmail-crypt-decrypt/verify)

(if (string= mc-version "3.4")
    (cmail-crypt-26io-code-definition)
  (define-key mc-write-mode-map "\C-c/c" 'cmail-crypt-change-pgp-version-temporarily)
  (cmail-crypt-set-pgp-default-version)
  (add-hook 'mail-mode-hook 'cmail-crypt-set-pgp-default-version)
  (add-hook 'mail-send-hook 'cmail-crypt-set-pgp-default-version)
  (add-hook 'menu-bar-update-hook 'cmail-crypt-toggle-mc-write-mode-menu-bar))
 
(if cmail-crypt-automatic-decrypt/verify
    (progn
      (setq cmail-crypt-perform-verify t)
      (setq cmail-crypt-perform-decrypt t)))

(setq mc-modes-alist
  '((cmail-summary-mode (decrypt . cmail-crypt-decrypt-message)
                        (verify . cmail-crypt-verify-signature)
                        (snarf . cmail-crypt-snarf-keys))
    (cmail-readmail-mode (decrypt . cmail-crypt-decrypt-message)
                         (verify . cmail-crypt-verify-signature)
                         (snarf . cmail-crypt-snarf-keys))
;;    (rmail-mode (decrypt . mc-rmail-decrypt-message)
;;                (verify . mc-rmail-verify-signature))
;;    (rmail-summary-mode (decrypt . mc-rmail-summary-decrypt-message)
;;                        (verify . mc-rmail-summary-verify-signature)
;;                        (snarf . mc-rmail-summary-snarf-keys))
;;    (vm-mode (decrypt . mc-vm-decrypt-message)
;;             (verify . mc-vm-verify-signature)
;;             (snarf . mc-vm-snarf-keys))
;;    (vm-virtual-mode (decrypt . mc-vm-decrypt-message)
;;                     (verify . mc-vm-verify-signature)
;;                     (snarf . mc-vm-snarf-keys))
;;    (vm-summary-mode (decrypt . mc-vm-decrypt-message)
;;                     (verify . mc-vm-verify-signature)
;;                     (snarf . mc-vm-snarf-keys))
;;    (mh-folder-mode (decrypt . mc-mh-decrypt-message)
;;                    (verify . mc-mh-verify-signature)
;;                    (snarf . mc-mh-snarf-keys))
    (gnus-summary-mode (decrypt . mc-gnus-decrypt-message)
                       (verify . mc-gnus-verify-signature)
                       (snarf . mc-gnus-snarf-keys))
    (gnus-article-mode (decrypt . mc-gnus-decrypt-message)
                       (verify . mc-gnus-verify-signature)
                       (snarf . mc-gnus-snarf-keys))
    (cmail-mail-mode (encrypt . mc-encrypt-message)
               (sign . mc-sign-message))
;;    (vm-mail-mode (encrypt . mc-encrypt-message)
;;                  (sign . mc-sign-message))
;;    (mh-letter-mode (encrypt . mc-encrypt-message)
;;                    (sign . mc-sign-message))
    (news-reply-mode (encrypt . mc-encrypt-message)
                     (sign . mc-sign-message))))

(let ((map cmail-summary-mode-map))
     (define-key map "\C-c/\C-t" 'cmail-crypt-toggle-automatic-decrypt/verify)
     (define-key map "\C-c/t"    'cmail-crypt-toggle-automatic-decrypt/verify)
     (define-key map "$"	 'cmail-crypt-show-MailCrypt-buffer)
     (if (not (string= mc-version "3.4"))
	 (define-key map "\C-c/c" 'cmail-crypt-change-default-version)))

;;; @ for cmail-mime
;;;

(if (not cmail-use-mime)
    (add-hook 'cmail-readmail-mode-hook 'mc-install-read-mode)
  (require 'cmail-mime)
  (if (featurep 'semi-setup)
      (add-hook 'mime-view-mode-hook 'mc-install-read-mode)
    (add-hook 'mime/viewer-mode-hook 'mc-install-read-mode)
    (if cmail-mime-decode
	(call-after-loaded 'tm-view (function (lambda () (require 'tm-pgp)))))))

;;; @ provide
;;;

(provide 'cmail-crypt)

;;; cmail-crypt.el ends here.