;;; -*-Emacs-Lisp-*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File:         rat-pgp.el v 1.4
;;; Description:  PGP Public Key system front-end for GNU Emacs
;;; Author:       Richard Pieri, ratinox@ccs.neu.edu
;;;		  Some additional code Dan Rich, drich@lerc.nasa.gov
;;; Created:      Fri Dec 25 12:25:42 1992
;;; FTP:          The latest version of rat-pgp.el can be anonymously FTP'ed
;;;               from ftp.ccs.neu.edu:/pub/ratinox/emacs-lisp/rat-pgp.el
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Caveat: it is inherently insecure to use PGP or any other encryption
;;; system on a multi-user system. There are just too many ways for someone
;;; to spy on what you are doing. It is highly recommended that you keep
;;; your private keys (secring.pgp) on write-protected mountable floppies
;;; and you keep these disks in a secure place.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Known Bugs:
;;; + There is no checking to see if you have entered an invalid pass
;;;   phrase in pgp-decrypt-message. If you do, then everything will seem
;;;   to freeze as PGP awaits a valid pass phrase. Typing C-g will unlock
;;;   things, and you can check the *PGP-Log* buffer for any errors.
;;; + When decrypting, informational messages get copied into the message
;;;   buffer instead of remaining in the *PGP-Log* buffer.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; History:
;;; * Richard Pieri, Feb 25, 1993: rewrote the decryption code based on
;;;   suggestions and code written by Robert Anderson
;;;   <bs891@cleveland.Freenet.Edu>.
;;; * Richard Pieri, Jun 7, 1993: incorporated Dan Rich's code, made
;;;   clearing temporary files a bit more reasonable.
;;; * Richard Pieri, Jun 18, 1993: changed the name to "rat-pgp" to avoid
;;;   confusion with other PGP front-ends for GNU Emacs. Output from PGP
;;;   commands now is kept in the buffer *PGP-Log*, so you can see what
;;;   went right or wrong. Re-wrote the passphrase handling code. Made lots
;;;   of improvements.
;;; * Richard Pieri, June 22, 1993: fixed a bug in pgp-set-passphrase.
;;; * Richard Pieri, June 22, 1993: fixed all the problems created by the
;;;   last edit. Maybe that will teach me not to code when caffeine sober.
;;; * Richard Pieri, June 25, 1993: added pgp-validate-signature.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This 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. 

;; This software 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.

;; For a copy of the GNU General Public License write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Installation:
;;;
;;; Make sure that the PGP executable is in your PATH, then byte-compile
;;; this file, put it in your load-path. Add the command:
;;;  (autoload 'pgp-insinuate-keys "pgp" "Add PGP key bindings to a mode" nil)
;;; then update your approprate setup hooks (ie, mail-setup-hook) to call
;;; pgp-insinuate-keys.
;;;
;;; You will probably also want to configure config.txt to do things like
;;; automatically add keys to your keyrings and such.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar pgp-program "pgp"
  "PGP program. This should be in your PATH environment variable somewhere.")

(defvar pgp-path (getenv "PGPPATH")
  "This should match your PGPPATH environment variable.")

(defvar pgp-tmp (concat pgp-path "/pgptmp.pgp")
  "Scratch file used by pgp -f.")

(defvar pgp-asc (concat pgp-path "/pgptmp.asc")
  "Scratch ascii-armor file created by pgp.")

(defvar pgp-passphrase nil
  "PGP passphrase.")

(defvar pgp-always-clear-passphrase nil
  "If t, clear the pass phrase from memory every time PGP finishes using it.
This is the secure, but inconvenient option.
Anything else will cause the current pass to remain in memory. This is the
less secure, but more convenient option.")

(defconst pgp-flags nil
  "Flags to be used with all PGP commands.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun pgp-delete-files ()
  "Delete pgp-tmp and pgptmp.asc if they exist. Smart enough to check for
temporary files in whatever directory you are currently in."
  (if (file-exists-p pgp-tmp)
      (delete-file pgp-tmp))
  (if (file-exists-p pgp-asc)
      (delete-file pgp-asc))
  (if (file-exists-p "pgptemp.asc")
      (delete-file "pgptemp.asc"))
  (if (file-exists-p "pgptemp.pgp")
      (delete-file "pgptemp.pgp"))
  )

;;; This still needs a bit of work because it won't work as a filter.
;;; At least I haven't figured out how to make it works as a filter...
(defun pgp-insert-public-key-block ()
  "Insert your PGP Public Key Block at point."
  (interactive)
  (pgp-delete-files)
  (save-window-excursion
    ;; extract key into temp file
    (let ((this-buffer (current-buffer))
	  (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
      (set-buffer pgp-log-buffer)
      (message "PGP: inserting public-key block...")
      (shell-command (concat pgp-program " -kxa $USER " pgp-asc) t)
      (goto-char (point-max))
      ))
  (insert-file pgp-asc)
  (pgp-delete-files)
  (message "PGP: inserting public-key block... done.")
  )

(defun pgp-sign-message ()
  "Sign the message at point."
  (interactive)
  (pgp-delete-files)
  (save-window-excursion
    (save-excursion
      (pgp-set-passphrase pgp-passphrase)
      (let ((buffer-status buffer-read-only))
	(setq buffer-read-only nil)
	(goto-char (point-min))
	(search-forward mail-header-separator)
	(forward-char 1)
	(let ((start (point))
	      (end (point-max))
	      (this-buffer (current-buffer))
	      (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
	  (kill-region start end)
	  (set-buffer pgp-log-buffer)
	  (yank)
	  (message "PGP: signing message...")
	  (shell-command-on-region (point) (mark)
				   (concat pgp-program
					   " -fast +clearsig=on") t)
	  (search-backward "-----BEGIN PGP SIGNED MESSAGE-----")
	  (kill-region (point) (point-max))
	  (goto-char (point-max))
	  (set-buffer this-buffer)
	  (goto-char (point-max))
	  (yank)
	  (setq buffer-read-only buffer-status))
	)))
  (if pgp-always-clear-passphrase
      (pgp-clear-passphrase))
  (pgp-delete-files)
  (message "PGP: signing message... done.")
  )

(defun pgp-extract-public-key ()
  "Extract the public key from a message and put it into your public keyring."
  (interactive)
  (pgp-delete-files)
  (save-window-excursion
    (save-excursion
      (let ((buffer-status buffer-read-only))
	(setq buffer-read-only nil)
	(goto-char (point-min))
	(search-forward "-----BEGIN PGP PUBLIC KEY BLOCK-----")
	(beginning-of-line)
	(push-mark)
	(search-forward "-----END PGP PUBLIC KEY BLOCK-----")
	(forward-char 1)
	(let ((this-buffer (current-buffer))
	      (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
	  (copy-region-as-kill (point) (mark))
	  (set-buffer pgp-log-buffer)
	  (yank)
	  (write-region (point) (mark) pgp-tmp)
	  (message "PGP: extracting public-key block...")
	  (shell-command (concat pgp-program " -ka " pgp-tmp) t)
	  (goto-char (point-max))
	  (setq buffer-read-only buffer-status))
	)))
  (pgp-delete-files)
  (message "PGP: extracting public-key block... done.")
  )

(defun pgp-encrypt-message (userid)
  "Encrypt from mail-header-separator to (point-max), replacing clear text
with cyphertext and the Public Key message delimiters."
  (interactive "sRecipient's userid: ")
  (pgp-delete-files)
  (save-window-excursion
    (save-excursion
      (goto-char (point-min))
      (search-forward mail-header-separator)
      (forward-char 1)
      (let ((start (point))
	    (end (point-max))
	    (this-buffer (current-buffer))
	    (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
	(kill-region start end)
	(set-buffer pgp-log-buffer)
	(yank)
	(message "PGP: encrypting message...")
	(shell-command-on-region
	 (point) (mark) (concat pgp-program " -fea " userid) t)
	(search-backward "-----BEGIN PGP MESSAGE-----")
	(push-mark)
	(search-forward "-----END PGP MESSAGE-----")
	(forward-char 1)
	(kill-region (point) (mark))
	(goto-char (point-max))
	(set-buffer this-buffer)
	(yank)
	)))
  (pgp-delete-files)
  (message "PGP: encrypting message... done.")
  )

(defun pgp-sign-and-encrypt-message (userid)
  "Sign the message at point."
  (interactive "sRecipient's userid: ")
  (pgp-delete-files)
  (save-window-excursion
    (save-excursion
      (pgp-set-passphrase pgp-passphrase)
      (let ((buffer-status buffer-read-only))
	(setq buffer-read-only nil)
	(goto-char (point-min))
	(search-forward mail-header-separator)
	(forward-char 1)
	(let ((start (point))
	      (end (point-max))
	      (this-buffer (current-buffer))
	      (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
	  (kill-region start end)
	  (set-buffer pgp-log-buffer)
	  (yank)
	  (message "PGP: signing and encrypting message...")
	  (shell-command-on-region (point) (mark)
				   (concat pgp-program
					   " -safe " userid) t)
	  (search-backward "-----BEGIN PGP MESSAGE-----")
	  (kill-region (point) (point-max))
	  (goto-char (point-max))
	  (set-buffer this-buffer)
	  (yank)
	  (setq buffer-read-only buffer-status))
	)))
  (if pgp-always-clear-passphrase
      (pgp-clear-passphrase))
  (pgp-delete-files)
  (message "PGP: signing and encrypting message... done.")
  )

(defun pgp-validate-signature ()
  "Validate the signature on the current message. An error will occour if the
public key from the sender does not exist on your key ring."
  (interactive)
  (save-window-excursion
    (save-restriction
      (let ((buffer-status buffer-read-only))
	(setq buffer-read-only nil)
	(goto-char (point-min))
	(search-forward "-----BEGIN PGP SIGNED MESSAGE-----")
	(beginning-of-line)
	(push-mark)
	(search-forward "-----END PGP SIGNATURE-----")
	(forward-char 1)
	(let ((this-buffer (current-buffer))
	      (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
	  (copy-region-as-kill (point) (mark))
	  (set-buffer pgp-log-buffer)
	  (yank)
	  (message "PGP: validating signature...")
	  (shell-command-on-region (point) (mark)
				   (concat pgp-program " -f ") t)
	  (goto-char (point-max))
	  (or
	   (re-search-backward "WARNING: " 0 t)
	   (re-search-backward "^Good signature" 0 t))
	  (push-mark)
	  (beginning-of-line)
	  (next-line 1)
	  (if (search-forward "Signature made" (point-max) t)
	      (progn
		(beginning-of-line)
		(next-line 1)
		(copy-region-as-kill (point) (mark)))
	    (copy-region-as-kill (point) (mark)))
	  (delete-region (point) (point-max))
	  (goto-char (point-max))
	  (set-buffer this-buffer)
	  (exchange-point-and-mark)
	  (yank)
	  (setq buffer-read-only buffer-status))
	)))
  (message "PGP: validating signature... done.")
  )

(defun pgp-decrypt-message ()
  "Decrypt the PGP message between the BEGIN/END PGP MESSAGE delimiters,
replacing cyphertext with clear text in the current buffer.

Note that this function may be a security hole. If a pass phrase is in
memory when GNU Emacs crashes, it will appear in the core file. Anyone with
a half-decent grasp of hash tables will be able to extract your pass phrase
from the core file."
  (interactive)
  (pgp-delete-files)
  (save-window-excursion
    (save-excursion
      (pgp-set-passphrase pgp-passphrase)
      (let ((buffer-status buffer-read-only))
	(setq buffer-read-only nil)
	(goto-char (point-min))
	(search-forward "-----BEGIN PGP MESSAGE-----")
	(beginning-of-line)
	(push-mark)
	(search-forward "-----END PGP MESSAGE-----")
	(forward-char 1)
	(let ((this-buffer (current-buffer))
	      (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
	  (kill-region (point) (mark))
	  (set-buffer pgp-log-buffer)
	  (yank)
	  (message "PGP: decrypting message...")
	  (shell-command-on-region
	   (point) (mark) (concat pgp-program " -f") t)
	  (kill-region (point) (mark))
	  (goto-char (point-max))
	  (set-buffer this-buffer)
	  (yank)
	  (setq buffer-read-only buffer-status)
	  ))))
  (if (eq pgp-always-clear-passphrase t)
      (pgp-clear-passphrase))
  (pgp-delete-files)
  (message "PGP: decrypting message... done.")
  )

(defun pgp-insinuate-keys ()
  "Call from various mode setup hooks to bind PGP keys."
  (local-set-key "\C-cpc" 'pgp-clear-passphrase)
  (local-set-key "\C-cpd" 'pgp-decrypt-message)
  (local-set-key "\C-cpe" 'pgp-encrypt-message)
  (local-set-key "\C-cph" 'pgp-help)
  (local-set-key "\C-cpi" 'pgp-insert-public-key-block)
  (local-set-key "\C-cpp" 'pgp-set-passphrase)
  (local-set-key "\C-cps" 'pgp-sign-message)
  (local-set-key "\C-cpS" 'pgp-sign-and-encrypt-message)
  (local-set-key "\C-cpv" 'pgp-validate-signature)
  (local-set-key "\C-cpx" 'pgp-extract-public-key)
  )

(defun pgp-help ()
  "Describe the rat-pgp key bindings.

Key      Command Name                  Description
=======  ============================  ========================================
C-c p c  pgp-clear-passphrase          Clears the current PGP passphrase from
                                       memory (see security note below).
C-c p d  pgp-decrypt-message           Decrypts the PGP encrypted message in
                                       the current buffer. Asks for passphrase.
C-c p e  pgp-encrypt-message           Encrypts the message in the current
                                       buffer. Asks for recipient.
C-c p h  pgp-help                      What you are reading right now.
                                       
C-c p i  pgp-insert-public-key-block   Inserts your PGP Public Key Block at
                                       point.
C-c p p  pgp-set-passphrase            Sets your PGP passphrase (see security
                                       note below).
C-c p s  pgp-sign-message              Signs the message in the current buffer.
                                       Uses CLEARSIG, asks for passphrase.
C-c p v  pgp-validate-signature        Checks the validity of the signature on
                                       the message in the current buffer.
C-c p S  pgp-sign-and-encrypt-message  Signs and encrypts the message in the
                                       current buffer.
C-c p x  pgp-extract-public-key        Attempts to add the PGP Public Key Block
                                       in the current buffer to your keyring.

WARNING! Security Holes:
People can see your PGP passphrase if:

* You set pgp-passphrase via a setq.

* Emacs crashes and leaves a core file; anyone with even a partial
  understanding of hash tables can extract your pass phrase from the core.

* Plus all the other normal Unix and/or X-Windows security holes.
"
  (interactive)
  (describe-function 'pgp-help))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Passphrase support. Some of this is blatantly taken from ange-ftp.el
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun pgp-read-passphrase (prompt &optional default)
  "Read a password from the user. Echos a . for each character typed.
End with RET, LFD, or ESC. DEL or C-h rubs out.  ^U kills line.
Optional DEFAULT is password to start with."
  (let ((pass (if default default ""))
	(c 0)
	(echo-keystrokes 0)
	(cursor-in-echo-area t))
    (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
      (message "%s%s"
	       prompt
	       (make-string (length pass) ?.))
      (setq c (read-char))
      (if (= c ?\C-u)
	  (setq pass "")
	(if (and (/= c ?\b) (/= c ?\177))
	    (setq pass (concat pass (char-to-string c)))
	  (if (> (length pass) 0)
	      (setq pass (substring pass 0 -1))))))
    (pgp-repaint-minibuffer)
    (substring pass 0 -1)))

(defun pgp-repaint-minibuffer ()
  "Gross hack to set minibuf_message = 0, so that the contents of the
minibuffer will show."
  (if (eq (selected-window) (minibuffer-window))
      (if (fboundp 'allocate-event)
	  ;; lemacs
	  (let ((unread-command-event (character-to-event ?\C-m
							  (allocate-event)))
		(enable-recursive-minibuffers t))
	    (read-from-minibuffer "" nil pgp-tmp-keymap nil))
	;; v18 GNU Emacs
	(let ((unread-command-char ?\C-m)
	      (enable-recursive-minibuffers t))
	  (read-from-minibuffer "" nil pgp-tmp-keymap nil)))))

(defun stripstrlist (l str)
  "Strip from list-of-strings L any string which matches STR."
  (cond (l (cond ((string-match str (car l))
		  (stripstrlist (cdr l) str))
		 (t (cons (car l) (stripstrlist (cdr l) str)))))))

(defun pgp-set-passphrase (arg)
  "Set PGPPASS environment variable from argument."
  (interactive)
  (setq arg
	(pgp-read-passphrase "Enter pass phrase: " pgp-passphrase))
  (setq process-environment
	(cons (concat "PGPPASS=" arg)
	      (stripstrlist process-environment "^PGPPASS=")))
  (setq pgp-passphrase arg)
  )

(defun pgp-clear-passphrase ()
  "Clear PGPPASS environment variable."
  (interactive)
  (setq process-environment (stripstrlist process-environment "^PGPPASS="))
  (setq pgp-passphrase nil)
  )