[bpt/emacs.git] / lisp / pgg-pgp.el

;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.

;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
;; Keywords: PGP, OpenPGP

;; This file is part of GNU Emacs.

;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs 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.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(eval-when-compile
  (require 'cl)				; for pgg macros
  (require 'pgg))

(defgroup pgg-pgp ()
  "PGP 2.* and 6.* interface."
  :group 'pgg)

(defcustom pgg-pgp-program "pgp"
  "PGP 2.* and 6.* executable."
  :group 'pgg-pgp
  :type 'string)

(defcustom pgg-pgp-shell-file-name "/bin/sh"
  "File name to load inferior shells from.
Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
  :group 'pgg-pgp
  :type 'string)

(defcustom pgg-pgp-shell-command-switch "-c"
  "Switch used to have the shell execute its command line argument."
  :group 'pgg-pgp
  :type 'string)

(defcustom pgg-pgp-extra-args nil
  "Extra arguments for every PGP invocation."
  :group 'pgg-pgp
  :type '(choice
	  (const :tag "None" nil)
	  (string :tag "Arguments")))

(defvar pgg-pgp-user-id nil
  "PGP ID of your default identity.")

(defun pgg-pgp-process-region (start end passphrase program args)
  (let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
	 (args
	  (concat args
		  pgg-pgp-extra-args
                  " 2>" (shell-quote-argument errors-file-name)))
	 (shell-file-name pgg-pgp-shell-file-name)
	 (shell-command-switch pgg-pgp-shell-command-switch)
	 (process-environment process-environment)
	 (output-buffer pgg-output-buffer)
	 (errors-buffer pgg-errors-buffer)
	 (process-connection-type nil)
	 process status exit-status)
    (with-current-buffer (get-buffer-create output-buffer)
      (buffer-disable-undo)
      (erase-buffer))
    (when passphrase
      (setenv "PGPPASSFD" "0"))
    (unwind-protect
	(progn
	  (let ((coding-system-for-read 'binary)
		(coding-system-for-write 'binary))
	    (setq process
		  (start-process-shell-command "*PGP*" output-buffer
                                               (concat program " " args))))
	  (set-process-sentinel process #'ignore)
	  (when passphrase
	    (process-send-string process (concat passphrase "\n")))
	  (process-send-region process start end)
	  (process-send-eof process)
	  (while (eq 'run (process-status process))
	    (accept-process-output process 5))
	  (setq status (process-status process)
		exit-status (process-exit-status process))
	  (delete-process process)
	  (with-current-buffer output-buffer
	    (pgg-convert-lbt-region (point-min)(point-max) 'LF)

	    (if (memq status '(stop signal))
		(error "%s exited abnormally: '%s'" program exit-status))
	    (if (= 127 exit-status)
		(error "%s could not be found" program))

	    (set-buffer (get-buffer-create errors-buffer))
	    (buffer-disable-undo)
	    (erase-buffer)
	    (insert-file-contents errors-file-name)))
      (if (and process (eq 'run (process-status process)))
	  (interrupt-process process))
      (condition-case nil
	  (delete-file errors-file-name)
	(file-error nil)))))

(defun pgg-pgp-lookup-key (string &optional type)
  "Search keys associated with STRING."
  (let ((args (list "+batchmode" "+language=en" "-kv" string)))
    (with-current-buffer (get-buffer-create pgg-output-buffer)
      (buffer-disable-undo)
      (erase-buffer)
      (apply #'call-process pgg-pgp-program nil t nil args)
      (goto-char (point-min))
      (cond
       ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
	(buffer-substring (point)(+ 8 (point))))
       ((re-search-forward "^Type" nil t);PGP 6.*
	(beginning-of-line 2)
	(substring
	 (nth 2 (split-string
		 (buffer-substring (point)(progn (end-of-line) (point)))))
	 2))))))

(defun pgg-pgp-encrypt-region (start end recipients &optional sign passphrase)
  "Encrypt the current region between START and END."
  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	 (passphrase (or passphrase
			 (when sign
			   (pgg-read-passphrase
			    (format "PGP passphrase for %s: "
				    pgg-pgp-user-id)
			    pgg-pgp-user-id))))
	 (args
	  (concat
	   "+encrypttoself=off +verbose=1 +batchmode +language=us -fate "
           (if (or recipients pgg-encrypt-for-me)
               (mapconcat 'shell-quote-argument
                          (append recipients
                                  (if pgg-encrypt-for-me
                                      (list pgg-pgp-user-id)))))
           (if sign (concat " -s -u " (shell-quote-argument pgg-pgp-user-id))))))
    (pgg-pgp-process-region start end nil pgg-pgp-program args)
    (pgg-process-when-success nil)))

(defun pgg-pgp-decrypt-region (start end &optional passphrase)
  "Decrypt the current region between START and END.

If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	 (key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt))
	 (passphrase
	  (or passphrase
	      (pgg-read-passphrase
	       (format "PGP passphrase for %s: " pgg-pgp-user-id) key)))
	 (args
	  "+verbose=1 +batchmode +language=us -f"))
    (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
    (pgg-process-when-success
      (if pgg-cache-passphrase
	  (pgg-add-passphrase-to-cache key passphrase)))))

(defun pgg-pgp-sign-region (start end &optional clearsign passphrase)
  "Make detached signature from text between START and END.

If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	 (passphrase
	  (or passphrase
	      (pgg-read-passphrase
	       (format "PGP passphrase for %s: " pgg-pgp-user-id)
	       (pgg-pgp-lookup-key pgg-pgp-user-id 'sign))))
	 (args
	  (concat (if clearsign "-fast" "-fbast")
		" +verbose=1 +language=us +batchmode"
		" -u " (shell-quote-argument pgg-pgp-user-id))))
    (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
    (pgg-process-when-success
      (goto-char (point-min))
      (when (re-search-forward "^-+BEGIN PGP" nil t);XXX
	(let ((packet
	       (cdr (assq 2 (pgg-parse-armor-region
			     (progn (beginning-of-line 2)
				    (point))
			     (point-max))))))
	  (if pgg-cache-passphrase
	      (pgg-add-passphrase-to-cache
	       (cdr (assq 'key-identifier packet))
	       passphrase)))))))

(defun pgg-pgp-verify-region (start end &optional signature)
  "Verify region between START and END as the detached signature SIGNATURE."
  (let* ((orig-file (pgg-make-temp-file "pgg"))
	 (args "+verbose=1 +batchmode +language=us")
	 (orig-mode (default-file-modes)))
    (unwind-protect
	(progn
	  (set-default-file-modes 448)
	  (let ((coding-system-for-write 'binary)
		jka-compr-compression-info-list jam-zcat-filename-list)
	    (write-region start end orig-file)))
      (set-default-file-modes orig-mode))
    (if (stringp signature)
	(progn
	  (copy-file signature (setq signature (concat orig-file ".asc")))
	  (setq args (concat args " " (shell-quote-argument signature)))))
    (setq args (concat args " " (shell-quote-argument orig-file)))
    (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
    (delete-file orig-file)
    (if signature (delete-file signature))
    (pgg-process-when-success
      (goto-char (point-min))
      (let ((case-fold-search t))
	(while (re-search-forward "^warning: " nil t)
	  (delete-region (match-beginning 0)
			 (progn (beginning-of-line 2) (point)))))
      (goto-char (point-min))
      (when (re-search-forward "^\\.$" nil t)
	(delete-region (point-min)
		       (progn (beginning-of-line 2)
			      (point)))))))

(defun pgg-pgp-insert-key ()
  "Insert public key at point."
  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	 (args
	  (concat "+verbose=1 +batchmode +language=us -kxaf "
                  (shell-quote-argument pgg-pgp-user-id))))
    (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
    (insert-buffer-substring pgg-output-buffer)))

(defun pgg-pgp-snarf-keys-region (start end)
  "Add all public keys in region between START and END to the keyring."
  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	 (key-file (pgg-make-temp-file "pgg"))
	 (args
	  (concat "+verbose=1 +batchmode +language=us -kaf "
                  (shell-quote-argument key-file))))
    (let ((coding-system-for-write 'raw-text-dos))
      (write-region start end key-file))
    (pgg-pgp-process-region start end nil pgg-pgp-program args)
    (delete-file key-file)
    (pgg-process-when-success nil)))

(provide 'pgg-pgp)

;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c
;;; pgg-pgp.el ends here
Commit	Line	Data
23f87bed MB	1	;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
23f87bed MB	2
e84b4b86	3	;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
409cc4a3	4	;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
23f87bed MB	5
	6	;; Author: Daiki Ueno <ueno@unixuser.org>
	7	;; Created: 1999/11/02
	8	;; Keywords: PGP, OpenPGP
	9
	10	;; This file is part of GNU Emacs.
	11
eb3fa2cf	12	;; GNU Emacs is free software: you can redistribute it and/or modify
23f87bed	13	;; it under the terms of the GNU General Public License as published by
eb3fa2cf GM	14	;; the Free Software Foundation, either version 3 of the License, or
eb3fa2cf GM	15	;; (at your option) any later version.
23f87bed MB	16
	17	;; GNU Emacs is distributed in the hope that it will be useful,
	18	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	19	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	20	;; GNU General Public License for more details.
	21
	22	;; You should have received a copy of the GNU General Public License
eb3fa2cf	23	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23f87bed MB	24
	25	;;; Code:
	26
	27	(eval-when-compile
	28	(require 'cl) ; for pgg macros
	29	(require 'pgg))
	30
	31	(defgroup pgg-pgp ()
5a210b89	32	"PGP 2.* and 6.* interface."
23f87bed MB	33	:group 'pgg)
	34
	35	(defcustom pgg-pgp-program "pgp"
	36	"PGP 2.* and 6.* executable."
	37	:group 'pgg-pgp
	38	:type 'string)
	39
	40	(defcustom pgg-pgp-shell-file-name "/bin/sh"
	41	"File name to load inferior shells from.
	42	Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
	43	:group 'pgg-pgp
	44	:type 'string)
	45
	46	(defcustom pgg-pgp-shell-command-switch "-c"
	47	"Switch used to have the shell execute its command line argument."
	48	:group 'pgg-pgp
	49	:type 'string)
	50
	51	(defcustom pgg-pgp-extra-args nil
	52	"Extra arguments for every PGP invocation."
	53	:group 'pgg-pgp
	54	:type '(choice
	55	(const :tag "None" nil)
	56	(string :tag "Arguments")))
	57
	58	(defvar pgg-pgp-user-id nil
	59	"PGP ID of your default identity.")
	60
	61	(defun pgg-pgp-process-region (start end passphrase program args)
	62	(let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
	63	(args
3559aa8b	64	(concat args
23f87bed	65	pgg-pgp-extra-args
3559aa8b	66	" 2>" (shell-quote-argument errors-file-name)))
23f87bed MB	67	(shell-file-name pgg-pgp-shell-file-name)
	68	(shell-command-switch pgg-pgp-shell-command-switch)
	69	(process-environment process-environment)
	70	(output-buffer pgg-output-buffer)
	71	(errors-buffer pgg-errors-buffer)
	72	(process-connection-type nil)
	73	process status exit-status)
	74	(with-current-buffer (get-buffer-create output-buffer)
	75	(buffer-disable-undo)
	76	(erase-buffer))
	77	(when passphrase
	78	(setenv "PGPPASSFD" "0"))
	79	(unwind-protect
	80	(progn
	81	(let ((coding-system-for-read 'binary)
	82	(coding-system-for-write 'binary))
	83	(setq process
3559aa8b SM	84	(start-process-shell-command "PGP" output-buffer
3559aa8b SM	85	(concat program " " args))))
23f87bed MB	86	(set-process-sentinel process #'ignore)
	87	(when passphrase
	88	(process-send-string process (concat passphrase "\n")))
	89	(process-send-region process start end)
	90	(process-send-eof process)
	91	(while (eq 'run (process-status process))
	92	(accept-process-output process 5))
	93	(setq status (process-status process)
	94	exit-status (process-exit-status process))
	95	(delete-process process)
	96	(with-current-buffer output-buffer
	97	(pgg-convert-lbt-region (point-min)(point-max) 'LF)
	98
	99	(if (memq status '(stop signal))
	100	(error "%s exited abnormally: '%s'" program exit-status))
	101	(if (= 127 exit-status)
	102	(error "%s could not be found" program))
	103
	104	(set-buffer (get-buffer-create errors-buffer))
	105	(buffer-disable-undo)
	106	(erase-buffer)
	107	(insert-file-contents errors-file-name)))
	108	(if (and process (eq 'run (process-status process)))
	109	(interrupt-process process))
	110	(condition-case nil
	111	(delete-file errors-file-name)
	112	(file-error nil)))))
	113
	114	(defun pgg-pgp-lookup-key (string &optional type)
	115	"Search keys associated with STRING."
	116	(let ((args (list "+batchmode" "+language=en" "-kv" string)))
	117	(with-current-buffer (get-buffer-create pgg-output-buffer)
	118	(buffer-disable-undo)
	119	(erase-buffer)
	120	(apply #'call-process pgg-pgp-program nil t nil args)
	121	(goto-char (point-min))
	122	(cond
	123	((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
	124	(buffer-substring (point)(+ 8 (point))))
	125	((re-search-forward "^Type" nil t);PGP 6.*
	126	(beginning-of-line 2)
	127	(substring
	128	(nth 2 (split-string
	129	(buffer-substring (point)(progn (end-of-line) (point)))))
	130	2))))))
	131
c6037c00	132	(defun pgg-pgp-encrypt-region (start end recipients &optional sign passphrase)
23f87bed MB	133	"Encrypt the current region between START and END."
23f87bed MB	134	(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
c6037c00	135	(passphrase (or passphrase
26c9afc3 MB	136	(when sign
	137	(pgg-read-passphrase
	138	(format "PGP passphrase for %s: "
	139	pgg-pgp-user-id)
	140	pgg-pgp-user-id))))
23f87bed	141	(args
3559aa8b SM	142	(concat
3559aa8b SM	143	"+encrypttoself=off +verbose=1 +batchmode +language=us -fate "
bb4c0f16	144	(if (or recipients pgg-encrypt-for-me)
3559aa8b SM	145	(mapconcat 'shell-quote-argument
	146	(append recipients
	147	(if pgg-encrypt-for-me
	148	(list pgg-pgp-user-id)))))
	149	(if sign (concat " -s -u " (shell-quote-argument pgg-pgp-user-id))))))
23f87bed MB	150	(pgg-pgp-process-region start end nil pgg-pgp-program args)
	151	(pgg-process-when-success nil)))
	152
c6037c00 EZ	153	(defun pgg-pgp-decrypt-region (start end &optional passphrase)
	154	"Decrypt the current region between START and END.
	155
	156	If optional PASSPHRASE is not specified, it will be obtained from the
	157	passphrase cache or user."
23f87bed	158	(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
710f2e1b	159	(key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt))
23f87bed	160	(passphrase
26c9afc3 MB	161	(or passphrase
	162	(pgg-read-passphrase
	163	(format "PGP passphrase for %s: " pgg-pgp-user-id) key)))
23f87bed	164	(args
3559aa8b	165	"+verbose=1 +batchmode +language=us -f"))
23f87bed	166	(pgg-pgp-process-region start end passphrase pgg-pgp-program args)
710f2e1b SJ	167	(pgg-process-when-success
710f2e1b SJ	168	(if pgg-cache-passphrase
c6037c00 EZ	169	(pgg-add-passphrase-to-cache key passphrase)))))
	170
	171	(defun pgg-pgp-sign-region (start end &optional clearsign passphrase)
	172	"Make detached signature from text between START and END.
23f87bed	173
c6037c00 EZ	174	If optional PASSPHRASE is not specified, it will be obtained from the
c6037c00 EZ	175	passphrase cache or user."
23f87bed MB	176	(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
23f87bed MB	177	(passphrase
26c9afc3 MB	178	(or passphrase
	179	(pgg-read-passphrase
	180	(format "PGP passphrase for %s: " pgg-pgp-user-id)
	181	(pgg-pgp-lookup-key pgg-pgp-user-id 'sign))))
23f87bed	182	(args
3559aa8b SM	183	(concat (if clearsign "-fast" "-fbast")
	184	" +verbose=1 +language=us +batchmode"
	185	" -u " (shell-quote-argument pgg-pgp-user-id))))
23f87bed MB	186	(pgg-pgp-process-region start end passphrase pgg-pgp-program args)
	187	(pgg-process-when-success
	188	(goto-char (point-min))
	189	(when (re-search-forward "^-+BEGIN PGP" nil t);XXX
	190	(let ((packet
	191	(cdr (assq 2 (pgg-parse-armor-region
	192	(progn (beginning-of-line 2)
	193	(point))
	194	(point-max))))))
	195	(if pgg-cache-passphrase
c6037c00	196	(pgg-add-passphrase-to-cache
23f87bed MB	197	(cdr (assq 'key-identifier packet))
	198	passphrase)))))))
	199
	200	(defun pgg-pgp-verify-region (start end &optional signature)
	201	"Verify region between START and END as the detached signature SIGNATURE."
	202	(let* ((orig-file (pgg-make-temp-file "pgg"))
3559aa8b	203	(args "+verbose=1 +batchmode +language=us")
23f87bed MB	204	(orig-mode (default-file-modes)))
	205	(unwind-protect
	206	(progn
	207	(set-default-file-modes 448)
	208	(let ((coding-system-for-write 'binary)
	209	jka-compr-compression-info-list jam-zcat-filename-list)
	210	(write-region start end orig-file)))
	211	(set-default-file-modes orig-mode))
	212	(if (stringp signature)
	213	(progn
	214	(copy-file signature (setq signature (concat orig-file ".asc")))
3559aa8b SM	215	(setq args (concat args " " (shell-quote-argument signature)))))
3559aa8b SM	216	(setq args (concat args " " (shell-quote-argument orig-file)))
23f87bed MB	217	(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
	218	(delete-file orig-file)
	219	(if signature (delete-file signature))
	220	(pgg-process-when-success
	221	(goto-char (point-min))
	222	(let ((case-fold-search t))
	223	(while (re-search-forward "^warning: " nil t)
	224	(delete-region (match-beginning 0)
	225	(progn (beginning-of-line 2) (point)))))
	226	(goto-char (point-min))
	227	(when (re-search-forward "^\\.$" nil t)
	228	(delete-region (point-min)
	229	(progn (beginning-of-line 2)
	230	(point)))))))
	231
	232	(defun pgg-pgp-insert-key ()
	233	"Insert public key at point."
	234	(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	235	(args
3559aa8b SM	236	(concat "+verbose=1 +batchmode +language=us -kxaf "
3559aa8b SM	237	(shell-quote-argument pgg-pgp-user-id))))
23f87bed MB	238	(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
	239	(insert-buffer-substring pgg-output-buffer)))
	240
	241	(defun pgg-pgp-snarf-keys-region (start end)
	242	"Add all public keys in region between START and END to the keyring."
	243	(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	244	(key-file (pgg-make-temp-file "pgg"))
	245	(args
3559aa8b SM	246	(concat "+verbose=1 +batchmode +language=us -kaf "
3559aa8b SM	247	(shell-quote-argument key-file))))
23f87bed MB	248	(let ((coding-system-for-write 'raw-text-dos))
	249	(write-region start end key-file))
	250	(pgg-pgp-process-region start end nil pgg-pgp-program args)
	251	(delete-file key-file)
	252	(pgg-process-when-success nil)))
	253
	254	(provide 'pgg-pgp)
	255
3559aa8b	256	;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c
23f87bed	257	;;; pgg-pgp.el ends here