[bpt/emacs.git] / lisp / epa-file.el

;;; epa-file.el --- the EasyPG Assistant, transparent file encryption
;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
;; Package: epa

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

(require 'epa)
(require 'epa-hook)

(defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
  "If non-nil, cache passphrase for symmetric encryption.

For security reasons, this option is turned off by default and
not recommended to use.  Instead, consider using public-key
encryption with gpg-agent which does the same job in a safer
way."
  :type 'boolean
  :group 'epa-file)

(defcustom epa-file-select-keys 'silent
  "Control whether or not to pop up the key selection dialog.

If t, always asks user to select recipients.
If nil, query user only when `epa-file-encrypt-to' is not set.
If neither t nor nil, doesn't ask user.  In this case, symmetric
encryption is used."
  :type '(choice (const :tag "Ask always" t)
		 (const :tag "Ask when recipients are not set" nil)
		 (const :tag "Don't ask" silent))
  :group 'epa-file)

(defvar epa-file-passphrase-alist nil)

(eval-and-compile
  (if (fboundp 'encode-coding-string)
      (defalias 'epa-file--encode-coding-string 'encode-coding-string)
    (defalias 'epa-file--encode-coding-string 'identity)))

(eval-and-compile
  (if (fboundp 'decode-coding-string)
      (defalias 'epa-file--decode-coding-string 'decode-coding-string)
    (defalias 'epa-file--decode-coding-string 'identity)))

(defun epa-file-passphrase-callback-function (context key-id file)
  (if (and epa-file-cache-passphrase-for-symmetric-encryption
	   (eq key-id 'SYM))
      (progn
	(setq file (file-truename file))
	(let ((entry (assoc file epa-file-passphrase-alist))
	      passphrase)
	  (or (copy-sequence (cdr entry))
	      (progn
		(unless entry
		  (setq entry (list file)
			epa-file-passphrase-alist
			(cons entry
			      epa-file-passphrase-alist)))
		(setq passphrase (epa-passphrase-callback-function context
								   key-id
								   file))
		(setcdr entry (copy-sequence passphrase))
		passphrase))))
    (epa-passphrase-callback-function context key-id file)))

;;;###autoload
(defun epa-file-handler (operation &rest args)
  (save-match-data
    (let ((op (get operation 'epa-file)))
      (if op
  	  (apply op args)
  	(epa-file-run-real-handler operation args)))))

(defun epa-file-run-real-handler (operation args)
  (let ((inhibit-file-name-handlers
	 (cons 'epa-file-handler
	       (and (eq inhibit-file-name-operation operation)
		    inhibit-file-name-handlers)))
	(inhibit-file-name-operation operation))
    (apply operation args)))

(defun epa-file-decode-and-insert (string file visit beg end replace)
  (if (fboundp 'decode-coding-inserted-region)
      (save-restriction
	(narrow-to-region (point) (point))
	(insert (if enable-multibyte-characters
		    (string-to-multibyte string)
		  string))
	  (decode-coding-inserted-region
	   (point-min) (point-max)
	   (substring file 0 (string-match epa-file-name-regexp file))
	 visit beg end replace))
    (insert (epa-file--decode-coding-string string (or coding-system-for-read
						       'undecided)))))

(defvar epa-file-error nil)
(defun epa-file--find-file-not-found-function ()
  (let ((error epa-file-error))
    (save-window-excursion
      (kill-buffer))
    (signal 'file-error
	    (cons "Opening input file" (cdr error)))))

(defvar last-coding-system-used)
(defun epa-file-insert-file-contents (file &optional visit beg end replace)
  (barf-if-buffer-read-only)
  (if (and visit (or beg end))
      (error "Attempt to visit less than an entire file"))
  (setq file (expand-file-name file))
  (let* ((local-copy
	  (condition-case nil
	      (epa-file-run-real-handler #'file-local-copy (list file))
	    (error)))
	 (local-file (or local-copy file))
	 (context (epg-make-context))
	 string length entry)
    (if visit
	(setq buffer-file-name file))
    (epg-context-set-passphrase-callback
     context
     (cons #'epa-file-passphrase-callback-function
	   local-file))
    (epg-context-set-progress-callback context
				       #'epa-progress-callback-function)
    (unwind-protect
	(progn
	  (if replace
	      (goto-char (point-min)))
	  (condition-case error
	      (setq string (epg-decrypt-file context local-file nil))
	    (error
	     (if (setq entry (assoc file epa-file-passphrase-alist))
		 (setcdr entry nil))
	     ;; Hack to prevent find-file from opening empty buffer
	     ;; when decryption failed (bug#6568).  See the place
	     ;; where `find-file-not-found-functions' are called in
	     ;; `find-file-noselect-1'.
	     (when (file-exists-p local-file)
	       (make-local-variable 'epa-file-error)
	       (setq epa-file-error error)
	       (add-hook 'find-file-not-found-functions
			 'epa-file--find-file-not-found-function
			 nil t))
	     (signal 'file-error
		     (cons "Opening input file" (cdr error)))))
	  (make-local-variable 'epa-file-encrypt-to)
	  (setq epa-file-encrypt-to
		(mapcar #'car (epg-context-result-for context 'encrypted-to)))
	  (if (or beg end)
	      (setq string (substring string (or beg 0) end)))
	  (save-excursion
	    ;; If visiting, bind off buffer-file-name so that
	    ;; file-locking will not ask whether we should
	    ;; really edit the buffer.
	    (let ((buffer-file-name
		   (if visit nil buffer-file-name)))
	      (save-restriction
		(narrow-to-region (point) (point))
		(epa-file-decode-and-insert string file visit beg end replace)
		(setq length (- (point-max) (point-min))))
	      (if replace
		  (delete-region (point) (point-max))))
	    (if visit
		(set-visited-file-modtime))))
      (if (and local-copy
	       (file-exists-p local-copy))
	  (delete-file local-copy)))
    (list file length)))
(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)

(defun epa-file-write-region (start end file &optional append visit lockname
				    mustbenew)
  (if append
      (error "Can't append to the file"))
  (setq file (expand-file-name file))
  (let* ((coding-system (or coding-system-for-write
			    (if (fboundp 'select-safe-coding-system)
				;; This is needed since Emacs 22 has
				;; no-conversion setting for *.gpg in
				;; `auto-coding-alist'.
			        (let ((buffer-file-name
				       (file-name-sans-extension file)))
				  (select-safe-coding-system
				   (point-min) (point-max)))
			      buffer-file-coding-system)))
	 (context (epg-make-context))
	 (coding-system-for-write 'binary)
	 string entry
	 (recipients
	  (cond
	   ((listp epa-file-encrypt-to) epa-file-encrypt-to)
	   ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))
    (epg-context-set-passphrase-callback
     context
     (cons #'epa-file-passphrase-callback-function
	   file))
    (epg-context-set-progress-callback context
				       #'epa-progress-callback-function)
    (epg-context-set-armor context epa-armor)
    (condition-case error
	(setq string
	      (epg-encrypt-string
	       context
	       (if (stringp start)
		   (epa-file--encode-coding-string start coding-system)
		 (unless start
		   (setq start (point-min)
			 end (point-max)))
		 (epa-file--encode-coding-string (buffer-substring start end)
						 coding-system))
	       (if (or (eq epa-file-select-keys t)
		       (and (null epa-file-select-keys)
			    (not (local-variable-p 'epa-file-encrypt-to
						   (current-buffer)))))
		   (epa-select-keys
		    context
		    "Select recipents for encryption.
If no one is selected, symmetric encryption will be performed.  "
		    recipients)
		 (if epa-file-encrypt-to
		     (epg-list-keys context recipients)))))
      (error
       (if (setq entry (assoc file epa-file-passphrase-alist))
	   (setcdr entry nil))
       (signal 'file-error (cons "Opening output file" (cdr error)))))
    (epa-file-run-real-handler
     #'write-region
     (list string nil file append visit lockname mustbenew))
    (if (boundp 'last-coding-system-used)
	(setq last-coding-system-used coding-system))
    (if (eq visit t)
	(progn
	  (setq buffer-file-name file)
	  (set-visited-file-modtime))
      (if (stringp visit)
	  (progn
	    (set-visited-file-modtime)
	    (setq buffer-file-name visit))))
    (if (or (eq visit t)
	    (eq visit nil)
	    (stringp visit))
	(message "Wrote %s" buffer-file-name))))
(put 'write-region 'epa-file 'epa-file-write-region)

(defun epa-file-select-keys ()
  "Select recipients for encryption."
  (interactive)
  (make-local-variable 'epa-file-encrypt-to)
  (setq epa-file-encrypt-to
	(mapcar
	 (lambda (key)
	   (epg-sub-key-id (car (epg-key-sub-key-list key))))
	(epa-select-keys
	 (epg-make-context)
	 "Select recipents for encryption.
If no one is selected, symmetric encryption will be performed.  "))))

;;;###autoload
(defun epa-file-enable ()
  (interactive)
  (if (memq epa-file-handler file-name-handler-alist)
      (message "`epa-file' already enabled")
    (setq file-name-handler-alist
	  (cons epa-file-handler file-name-handler-alist))
    (add-hook 'find-file-hook 'epa-file-find-file-hook)
    (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist))
    (message "`epa-file' enabled")))

;;;###autoload
(defun epa-file-disable ()
  (interactive)
  (if (memq epa-file-handler file-name-handler-alist)
      (progn
	(setq file-name-handler-alist
	      (delq epa-file-handler file-name-handler-alist))
	(remove-hook 'find-file-hook 'epa-file-find-file-hook)
	(setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
				    auto-mode-alist))
	(message "`epa-file' disabled"))
    (message "`epa-file' already disabled")))

(provide 'epa-file)

;; arch-tag: 5715152f-0eb1-4dbc-9008-07098775314d
;;; epa-file.el ends here
Commit	Line	Data
c154c0be	1	;;; epa-file.el --- the EasyPG Assistant, transparent file encryption
5df4f04c	2	;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
c154c0be MO	3
	4	;; Author: Daiki Ueno <ueno@unixuser.org>
	5	;; Keywords: PGP, GnuPG
bd78fa1d	6	;; Package: epa
c154c0be MO	7
	8	;; This file is part of GNU Emacs.
	9
eb3fa2cf	10	;; GNU Emacs is free software: you can redistribute it and/or modify
c154c0be	11	;; it under the terms of the GNU General Public License as published by
eb3fa2cf GM	12	;; the Free Software Foundation, either version 3 of the License, or
eb3fa2cf GM	13	;; (at your option) any later version.
c154c0be MO	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
eb3fa2cf	21	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
c154c0be MO	22
	23	;;; Code:
	24
	25	(require 'epa)
3fe68728	26	(require 'epa-hook)
c154c0be MO	27
c154c0be MO	28	(defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
b0f5fd2e DU	29	"If non-nil, cache passphrase for symmetric encryption.
	30
	31	For security reasons, this option is turned off by default and
0d19d151 DU	32	not recommended to use. Instead, consider using public-key
	33	encryption with gpg-agent which does the same job in a safer
	34	way."
c154c0be MO	35	:type 'boolean
	36	:group 'epa-file)
	37
33088bed DU	38	(defcustom epa-file-select-keys 'silent
	39	"Control whether or not to pop up the key selection dialog.
	40
	41	If t, always asks user to select recipients.
	42	If nil, query user only when `epa-file-encrypt-to' is not set.
	43	If neither t nor nil, doesn't ask user. In this case, symmetric
	44	encryption is used."
	45	:type '(choice (const :tag "Ask always" t)
	46	(const :tag "Ask when recipients are not set" nil)
	47	(const :tag "Don't ask" silent))
c154c0be MO	48	:group 'epa-file)
c154c0be MO	49
c154c0be MO	50	(defvar epa-file-passphrase-alist nil)
	51
	52	(eval-and-compile
	53	(if (fboundp 'encode-coding-string)
	54	(defalias 'epa-file--encode-coding-string 'encode-coding-string)
	55	(defalias 'epa-file--encode-coding-string 'identity)))
	56
	57	(eval-and-compile
	58	(if (fboundp 'decode-coding-string)
	59	(defalias 'epa-file--decode-coding-string 'decode-coding-string)
	60	(defalias 'epa-file--decode-coding-string 'identity)))
	61
c154c0be MO	62	(defun epa-file-passphrase-callback-function (context key-id file)
	63	(if (and epa-file-cache-passphrase-for-symmetric-encryption
	64	(eq key-id 'SYM))
	65	(progn
	66	(setq file (file-truename file))
	67	(let ((entry (assoc file epa-file-passphrase-alist))
	68	passphrase)
	69	(or (copy-sequence (cdr entry))
	70	(progn
	71	(unless entry
	72	(setq entry (list file)
	73	epa-file-passphrase-alist
	74	(cons entry
	75	epa-file-passphrase-alist)))
	76	(setq passphrase (epa-passphrase-callback-function context
446b12da DU	77	key-id
446b12da DU	78	file))
c154c0be MO	79	(setcdr entry (copy-sequence passphrase))
c154c0be MO	80	passphrase))))
446b12da	81	(epa-passphrase-callback-function context key-id file)))
c154c0be	82
6f8a4190	83	;;;###autoload
c154c0be	84	(defun epa-file-handler (operation &rest args)
dbc9f96d GM	85	(save-match-data
	86	(let ((op (get operation 'epa-file)))
	87	(if op
	88	(apply op args)
	89	(epa-file-run-real-handler operation args)))))
	90
c154c0be MO	91	(defun epa-file-run-real-handler (operation args)
	92	(let ((inhibit-file-name-handlers
	93	(cons 'epa-file-handler
	94	(and (eq inhibit-file-name-operation operation)
	95	inhibit-file-name-handlers)))
	96	(inhibit-file-name-operation operation))
	97	(apply operation args)))
	98
	99	(defun epa-file-decode-and-insert (string file visit beg end replace)
	100	(if (fboundp 'decode-coding-inserted-region)
	101	(save-restriction
	102	(narrow-to-region (point) (point))
68a0d892 DU	103	(insert (if enable-multibyte-characters
	104	(string-to-multibyte string)
	105	string))
c154c0be MO	106	(decode-coding-inserted-region
	107	(point-min) (point-max)
	108	(substring file 0 (string-match epa-file-name-regexp file))
68a0d892	109	visit beg end replace))
c154c0be MO	110	(insert (epa-file--decode-coding-string string (or coding-system-for-read
	111	'undecided)))))
	112
c0397930 DU	113	(defvar epa-file-error nil)
	114	(defun epa-file--find-file-not-found-function ()
	115	(let ((error epa-file-error))
	116	(save-window-excursion
	117	(kill-buffer))
	118	(signal 'file-error
	119	(cons "Opening input file" (cdr error)))))
	120
c154c0be MO	121	(defvar last-coding-system-used)
	122	(defun epa-file-insert-file-contents (file &optional visit beg end replace)
	123	(barf-if-buffer-read-only)
	124	(if (and visit (or beg end))
	125	(error "Attempt to visit less than an entire file"))
	126	(setq file (expand-file-name file))
	127	(let* ((local-copy
6ea97db8	128	(condition-case nil
c154c0be MO	129	(epa-file-run-real-handler #'file-local-copy (list file))
	130	(error)))
	131	(local-file (or local-copy file))
	132	(context (epg-make-context))
	133	string length entry)
2cb35a56 DU	134	(if visit
2cb35a56 DU	135	(setq buffer-file-name file))
c154c0be MO	136	(epg-context-set-passphrase-callback
	137	context
	138	(cons #'epa-file-passphrase-callback-function
	139	local-file))
	140	(epg-context-set-progress-callback context
	141	#'epa-progress-callback-function)
	142	(unwind-protect
	143	(progn
	144	(if replace
	145	(goto-char (point-min)))
	146	(condition-case error
	147	(setq string (epg-decrypt-file context local-file nil))
	148	(error
	149	(if (setq entry (assoc file epa-file-passphrase-alist))
	150	(setcdr entry nil))
192cfe77 DU	151	;; Hack to prevent find-file from opening empty buffer
	152	;; when decryption failed (bug#6568). See the place
	153	;; where `find-file-not-found-functions' are called in
	154	;; `find-file-noselect-1'.
4f195cf7	155	(when (file-exists-p local-file)
4f195cf7 DU	156	(make-local-variable 'epa-file-error)
	157	(setq epa-file-error error)
	158	(add-hook 'find-file-not-found-functions
	159	'epa-file--find-file-not-found-function
	160	nil t))
c154c0be MO	161	(signal 'file-error
	162	(cons "Opening input file" (cdr error)))))
	163	(make-local-variable 'epa-file-encrypt-to)
	164	(setq epa-file-encrypt-to
	165	(mapcar #'car (epg-context-result-for context 'encrypted-to)))
	166	(if (or beg end)
	167	(setq string (substring string (or beg 0) end)))
	168	(save-excursion
c5fe4acb DU	169	;; If visiting, bind off buffer-file-name so that
	170	;; file-locking will not ask whether we should
	171	;; really edit the buffer.
	172	(let ((buffer-file-name
	173	(if visit nil buffer-file-name)))
	174	(save-restriction
	175	(narrow-to-region (point) (point))
	176	(epa-file-decode-and-insert string file visit beg end replace)
	177	(setq length (- (point-max) (point-min))))
	178	(if replace
	179	(delete-region (point) (point-max))))
2cb35a56 DU	180	(if visit
2cb35a56 DU	181	(set-visited-file-modtime))))
c154c0be MO	182	(if (and local-copy
	183	(file-exists-p local-copy))
	184	(delete-file local-copy)))
	185	(list file length)))
	186	(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
	187
	188	(defun epa-file-write-region (start end file &optional append visit lockname
	189	mustbenew)
	190	(if append
5a0c3f56	191	(error "Can't append to the file"))
c154c0be MO	192	(setq file (expand-file-name file))
	193	(let* ((coding-system (or coding-system-for-write
	194	(if (fboundp 'select-safe-coding-system)
	195	;; This is needed since Emacs 22 has
	196	;; no-conversion setting for *.gpg in
	197	;; `auto-coding-alist'.
	198	(let ((buffer-file-name
	199	(file-name-sans-extension file)))
	200	(select-safe-coding-system
	201	(point-min) (point-max)))
	202	buffer-file-coding-system)))
	203	(context (epg-make-context))
	204	(coding-system-for-write 'binary)
	205	string entry
	206	(recipients
	207	(cond
	208	((listp epa-file-encrypt-to) epa-file-encrypt-to)
	209	((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))
	210	(epg-context-set-passphrase-callback
	211	context
	212	(cons #'epa-file-passphrase-callback-function
	213	file))
	214	(epg-context-set-progress-callback context
	215	#'epa-progress-callback-function)
	216	(epg-context-set-armor context epa-armor)
	217	(condition-case error
	218	(setq string
	219	(epg-encrypt-string
	220	context
	221	(if (stringp start)
	222	(epa-file--encode-coding-string start coding-system)
6843296d	223	(unless start
437eedba DU	224	(setq start (point-min)
437eedba DU	225	end (point-max)))
c154c0be MO	226	(epa-file--encode-coding-string (buffer-substring start end)
c154c0be MO	227	coding-system))
33088bed DU	228	(if (or (eq epa-file-select-keys t)
	229	(and (null epa-file-select-keys)
	230	(not (local-variable-p 'epa-file-encrypt-to
	231	(current-buffer)))))
c154c0be MO	232	(epa-select-keys
	233	context
	234	"Select recipents for encryption.
	235	If no one is selected, symmetric encryption will be performed. "
	236	recipients)
	237	(if epa-file-encrypt-to
	238	(epg-list-keys context recipients)))))
	239	(error
	240	(if (setq entry (assoc file epa-file-passphrase-alist))
	241	(setcdr entry nil))
	242	(signal 'file-error (cons "Opening output file" (cdr error)))))
	243	(epa-file-run-real-handler
	244	#'write-region
	245	(list string nil file append visit lockname mustbenew))
	246	(if (boundp 'last-coding-system-used)
	247	(setq last-coding-system-used coding-system))
	248	(if (eq visit t)
	249	(progn
	250	(setq buffer-file-name file)
	251	(set-visited-file-modtime))
	252	(if (stringp visit)
	253	(progn
	254	(set-visited-file-modtime)
	255	(setq buffer-file-name visit))))
	256	(if (or (eq visit t)
	257	(eq visit nil)
	258	(stringp visit))
	259	(message "Wrote %s" buffer-file-name))))
	260	(put 'write-region 'epa-file 'epa-file-write-region)
	261
c154c0be MO	262	(defun epa-file-select-keys ()
	263	"Select recipients for encryption."
	264	(interactive)
	265	(make-local-variable 'epa-file-encrypt-to)
	266	(setq epa-file-encrypt-to
fef7aa9e MO	267	(mapcar
	268	(lambda (key)
	269	(epg-sub-key-id (car (epg-key-sub-key-list key))))
c154c0be MO	270	(epa-select-keys
	271	(epg-make-context)
	272	"Select recipents for encryption.
fef7aa9e	273	If no one is selected, symmetric encryption will be performed. "))))
c154c0be MO	274
	275	;;;###autoload
	276	(defun epa-file-enable ()
	277	(interactive)
	278	(if (memq epa-file-handler file-name-handler-alist)
	279	(message "`epa-file' already enabled")
	280	(setq file-name-handler-alist
	281	(cons epa-file-handler file-name-handler-alist))
bfeee9d1	282	(add-hook 'find-file-hook 'epa-file-find-file-hook)
c154c0be MO	283	(setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist))
	284	(message "`epa-file' enabled")))
	285
	286	;;;###autoload
	287	(defun epa-file-disable ()
	288	(interactive)
	289	(if (memq epa-file-handler file-name-handler-alist)
	290	(progn
	291	(setq file-name-handler-alist
	292	(delq epa-file-handler file-name-handler-alist))
bfeee9d1	293	(remove-hook 'find-file-hook 'epa-file-find-file-hook)
c154c0be MO	294	(setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
	295	auto-mode-alist))
	296	(message "`epa-file' disabled"))
	297	(message "`epa-file' already disabled")))
	298
	299	(provide 'epa-file)
	300
37b77401	301	;; arch-tag: 5715152f-0eb1-4dbc-9008-07098775314d
c154c0be	302	;;; epa-file.el ends here