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

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

;; Copyright (C) 1999-2000, 2002-2012  Free Software Foundation, Inc.

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
;; Keywords: PGP, OpenPGP
;; Package: pgg
;; Obsolete-since: 24.1

;; 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)

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