[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 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 2, 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

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