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

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

;; Copyright (C) 1999-2000, 2002-2014 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))

(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"))
    (with-file-modes 448
      (let ((coding-system-for-write 'binary)
            jka-compr-compression-info-list jam-zcat-filename-list)
        (write-region start end orig-file)))
    (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
ba318903	3	;; Copyright (C) 1999-2000, 2002-2014 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
e354ae76 GM	29	(require 'cl))
	30
	31	(require 'pgg)
23f87bed MB	32
23f87bed MB	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
3559aa8b SM	145	"+encrypttoself=off +verbose=1 +batchmode +language=us -fate "
bb4c0f16	146	(if (or recipients pgg-encrypt-for-me)
3559aa8b SM	147	(mapconcat 'shell-quote-argument
	148	(append recipients
	149	(if pgg-encrypt-for-me
66590684	150	(list pgg-pgp-user-id))) " "))
3559aa8b	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"))
d63d883a GM	205	(args "+verbose=1 +batchmode +language=us"))
	206	(with-file-modes 448
	207	(let ((coding-system-for-write 'binary)
	208	jka-compr-compression-info-list jam-zcat-filename-list)
	209	(write-region start end orig-file)))
23f87bed MB	210	(if (stringp signature)
	211	(progn
	212	(copy-file signature (setq signature (concat orig-file ".asc")))
3559aa8b SM	213	(setq args (concat args " " (shell-quote-argument signature)))))
3559aa8b SM	214	(setq args (concat args " " (shell-quote-argument orig-file)))
23f87bed MB	215	(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
	216	(delete-file orig-file)
	217	(if signature (delete-file signature))
	218	(pgg-process-when-success
	219	(goto-char (point-min))
	220	(let ((case-fold-search t))
	221	(while (re-search-forward "^warning: " nil t)
	222	(delete-region (match-beginning 0)
	223	(progn (beginning-of-line 2) (point)))))
	224	(goto-char (point-min))
	225	(when (re-search-forward "^\\.$" nil t)
	226	(delete-region (point-min)
	227	(progn (beginning-of-line 2)
	228	(point)))))))
	229
	230	(defun pgg-pgp-insert-key ()
	231	"Insert public key at point."
	232	(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	233	(args
3559aa8b SM	234	(concat "+verbose=1 +batchmode +language=us -kxaf "
3559aa8b SM	235	(shell-quote-argument pgg-pgp-user-id))))
23f87bed MB	236	(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
	237	(insert-buffer-substring pgg-output-buffer)))
	238
	239	(defun pgg-pgp-snarf-keys-region (start end)
	240	"Add all public keys in region between START and END to the keyring."
	241	(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
	242	(key-file (pgg-make-temp-file "pgg"))
	243	(args
3559aa8b SM	244	(concat "+verbose=1 +batchmode +language=us -kaf "
3559aa8b SM	245	(shell-quote-argument key-file))))
23f87bed MB	246	(let ((coding-system-for-write 'raw-text-dos))
	247	(write-region start end key-file))
	248	(pgg-pgp-process-region start end nil pgg-pgp-program args)
	249	(delete-file key-file)
	250	(pgg-process-when-success nil)))
	251
	252	(provide 'pgg-pgp)
	253
23f87bed	254	;;; pgg-pgp.el ends here