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

;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*-
;; Copyright (C) 2006-2013 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 gpg-agent which
does the same job in a safer way.  See Info node `(epa) Caching
Passphrases' for more information.

Note that this option has no effect if you use GnuPG 2.0."
  :type 'boolean
  :group 'epa-file)

(defcustom epa-file-select-keys nil
  "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
     (cons #'epa-progress-callback-function
	   (format "Decrypting %s" file)))
    (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
     (cons #'epa-progress-callback-function
	   (format "Encrypting %s" file)))
    (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 recipients 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 recipients 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)

;;; epa-file.el ends here
Commit	Line	Data
74f50695	1	;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -- lexical-binding: t --
ab422c4d	2	;; Copyright (C) 2006-2013 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
ed42a877 DU	32	not recommended to use. Instead, consider using gpg-agent which
	33	does the same job in a safer way. See Info node `(epa) Caching
	34	Passphrases' for more information.
	35
	36	Note that this option has no effect if you use GnuPG 2.0."
c154c0be MO	37	:type 'boolean
	38	:group 'epa-file)
	39
a3dae87a	40	(defcustom epa-file-select-keys nil
33088bed DU	41	"Control whether or not to pop up the key selection dialog.
	42
	43	If t, always asks user to select recipients.
	44	If nil, query user only when `epa-file-encrypt-to' is not set.
	45	If neither t nor nil, doesn't ask user. In this case, symmetric
	46	encryption is used."
	47	:type '(choice (const :tag "Ask always" t)
	48	(const :tag "Ask when recipients are not set" nil)
	49	(const :tag "Don't ask" silent))
c154c0be MO	50	:group 'epa-file)
c154c0be MO	51
c154c0be MO	52	(defvar epa-file-passphrase-alist nil)
	53
	54	(eval-and-compile
	55	(if (fboundp 'encode-coding-string)
	56	(defalias 'epa-file--encode-coding-string 'encode-coding-string)
	57	(defalias 'epa-file--encode-coding-string 'identity)))
	58
	59	(eval-and-compile
	60	(if (fboundp 'decode-coding-string)
	61	(defalias 'epa-file--decode-coding-string 'decode-coding-string)
	62	(defalias 'epa-file--decode-coding-string 'identity)))
	63
c154c0be MO	64	(defun epa-file-passphrase-callback-function (context key-id file)
	65	(if (and epa-file-cache-passphrase-for-symmetric-encryption
	66	(eq key-id 'SYM))
	67	(progn
	68	(setq file (file-truename file))
	69	(let ((entry (assoc file epa-file-passphrase-alist))
	70	passphrase)
	71	(or (copy-sequence (cdr entry))
	72	(progn
	73	(unless entry
	74	(setq entry (list file)
	75	epa-file-passphrase-alist
	76	(cons entry
	77	epa-file-passphrase-alist)))
	78	(setq passphrase (epa-passphrase-callback-function context
446b12da DU	79	key-id
446b12da DU	80	file))
c154c0be MO	81	(setcdr entry (copy-sequence passphrase))
c154c0be MO	82	passphrase))))
446b12da	83	(epa-passphrase-callback-function context key-id file)))
c154c0be	84
6f8a4190	85	;;;###autoload
c154c0be	86	(defun epa-file-handler (operation &rest args)
dbc9f96d GM	87	(save-match-data
	88	(let ((op (get operation 'epa-file)))
	89	(if op
	90	(apply op args)
	91	(epa-file-run-real-handler operation args)))))
	92
c154c0be MO	93	(defun epa-file-run-real-handler (operation args)
	94	(let ((inhibit-file-name-handlers
	95	(cons 'epa-file-handler
	96	(and (eq inhibit-file-name-operation operation)
	97	inhibit-file-name-handlers)))
	98	(inhibit-file-name-operation operation))
	99	(apply operation args)))
	100
	101	(defun epa-file-decode-and-insert (string file visit beg end replace)
	102	(if (fboundp 'decode-coding-inserted-region)
	103	(save-restriction
	104	(narrow-to-region (point) (point))
68a0d892 DU	105	(insert (if enable-multibyte-characters
	106	(string-to-multibyte string)
	107	string))
c154c0be MO	108	(decode-coding-inserted-region
	109	(point-min) (point-max)
	110	(substring file 0 (string-match epa-file-name-regexp file))
68a0d892	111	visit beg end replace))
c154c0be MO	112	(insert (epa-file--decode-coding-string string (or coding-system-for-read
	113	'undecided)))))
	114
c0397930 DU	115	(defvar epa-file-error nil)
	116	(defun epa-file--find-file-not-found-function ()
	117	(let ((error epa-file-error))
	118	(save-window-excursion
	119	(kill-buffer))
	120	(signal 'file-error
	121	(cons "Opening input file" (cdr error)))))
	122
c154c0be MO	123	(defvar last-coding-system-used)
	124	(defun epa-file-insert-file-contents (file &optional visit beg end replace)
	125	(barf-if-buffer-read-only)
	126	(if (and visit (or beg end))
	127	(error "Attempt to visit less than an entire file"))
	128	(setq file (expand-file-name file))
	129	(let* ((local-copy
6ea97db8	130	(condition-case nil
c154c0be MO	131	(epa-file-run-real-handler #'file-local-copy (list file))
	132	(error)))
	133	(local-file (or local-copy file))
	134	(context (epg-make-context))
	135	string length entry)
2cb35a56 DU	136	(if visit
2cb35a56 DU	137	(setq buffer-file-name file))
c154c0be MO	138	(epg-context-set-passphrase-callback
	139	context
	140	(cons #'epa-file-passphrase-callback-function
	141	local-file))
9d5cb631 DU	142	(epg-context-set-progress-callback
	143	context
	144	(cons #'epa-progress-callback-function
	145	(format "Decrypting %s" file)))
c154c0be MO	146	(unwind-protect
	147	(progn
	148	(if replace
	149	(goto-char (point-min)))
	150	(condition-case error
	151	(setq string (epg-decrypt-file context local-file nil))
	152	(error
	153	(if (setq entry (assoc file epa-file-passphrase-alist))
	154	(setcdr entry nil))
192cfe77 DU	155	;; Hack to prevent find-file from opening empty buffer
	156	;; when decryption failed (bug#6568). See the place
	157	;; where `find-file-not-found-functions' are called in
	158	;; `find-file-noselect-1'.
4f195cf7	159	(when (file-exists-p local-file)
4f195cf7 DU	160	(make-local-variable 'epa-file-error)
	161	(setq epa-file-error error)
	162	(add-hook 'find-file-not-found-functions
	163	'epa-file--find-file-not-found-function
	164	nil t))
c154c0be MO	165	(signal 'file-error
	166	(cons "Opening input file" (cdr error)))))
	167	(make-local-variable 'epa-file-encrypt-to)
	168	(setq epa-file-encrypt-to
	169	(mapcar #'car (epg-context-result-for context 'encrypted-to)))
	170	(if (or beg end)
	171	(setq string (substring string (or beg 0) end)))
	172	(save-excursion
c5fe4acb DU	173	;; If visiting, bind off buffer-file-name so that
	174	;; file-locking will not ask whether we should
	175	;; really edit the buffer.
	176	(let ((buffer-file-name
	177	(if visit nil buffer-file-name)))
	178	(save-restriction
	179	(narrow-to-region (point) (point))
	180	(epa-file-decode-and-insert string file visit beg end replace)
	181	(setq length (- (point-max) (point-min))))
	182	(if replace
	183	(delete-region (point) (point-max))))
2cb35a56 DU	184	(if visit
2cb35a56 DU	185	(set-visited-file-modtime))))
c154c0be MO	186	(if (and local-copy
	187	(file-exists-p local-copy))
	188	(delete-file local-copy)))
	189	(list file length)))
	190	(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
	191
	192	(defun epa-file-write-region (start end file &optional append visit lockname
	193	mustbenew)
	194	(if append
5a0c3f56	195	(error "Can't append to the file"))
c154c0be MO	196	(setq file (expand-file-name file))
	197	(let* ((coding-system (or coding-system-for-write
	198	(if (fboundp 'select-safe-coding-system)
	199	;; This is needed since Emacs 22 has
	200	;; no-conversion setting for *.gpg in
	201	;; `auto-coding-alist'.
	202	(let ((buffer-file-name
	203	(file-name-sans-extension file)))
	204	(select-safe-coding-system
	205	(point-min) (point-max)))
	206	buffer-file-coding-system)))
	207	(context (epg-make-context))
	208	(coding-system-for-write 'binary)
	209	string entry
	210	(recipients
	211	(cond
	212	((listp epa-file-encrypt-to) epa-file-encrypt-to)
	213	((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))
	214	(epg-context-set-passphrase-callback
	215	context
	216	(cons #'epa-file-passphrase-callback-function
	217	file))
9d5cb631 DU	218	(epg-context-set-progress-callback
	219	context
	220	(cons #'epa-progress-callback-function
	221	(format "Encrypting %s" file)))
c154c0be MO	222	(epg-context-set-armor context epa-armor)
	223	(condition-case error
	224	(setq string
	225	(epg-encrypt-string
	226	context
	227	(if (stringp start)
	228	(epa-file--encode-coding-string start coding-system)
6843296d	229	(unless start
437eedba DU	230	(setq start (point-min)
437eedba DU	231	end (point-max)))
c154c0be MO	232	(epa-file--encode-coding-string (buffer-substring start end)
c154c0be MO	233	coding-system))
33088bed DU	234	(if (or (eq epa-file-select-keys t)
	235	(and (null epa-file-select-keys)
	236	(not (local-variable-p 'epa-file-encrypt-to
	237	(current-buffer)))))
c154c0be MO	238	(epa-select-keys
c154c0be MO	239	context
333f9019	240	"Select recipients for encryption.
c154c0be MO	241	If no one is selected, symmetric encryption will be performed. "
	242	recipients)
	243	(if epa-file-encrypt-to
	244	(epg-list-keys context recipients)))))
	245	(error
	246	(if (setq entry (assoc file epa-file-passphrase-alist))
	247	(setcdr entry nil))
	248	(signal 'file-error (cons "Opening output file" (cdr error)))))
	249	(epa-file-run-real-handler
	250	#'write-region
	251	(list string nil file append visit lockname mustbenew))
	252	(if (boundp 'last-coding-system-used)
	253	(setq last-coding-system-used coding-system))
	254	(if (eq visit t)
	255	(progn
	256	(setq buffer-file-name file)
	257	(set-visited-file-modtime))
	258	(if (stringp visit)
	259	(progn
	260	(set-visited-file-modtime)
	261	(setq buffer-file-name visit))))
	262	(if (or (eq visit t)
	263	(eq visit nil)
	264	(stringp visit))
	265	(message "Wrote %s" buffer-file-name))))
	266	(put 'write-region 'epa-file 'epa-file-write-region)
	267
c154c0be MO	268	(defun epa-file-select-keys ()
	269	"Select recipients for encryption."
	270	(interactive)
	271	(make-local-variable 'epa-file-encrypt-to)
	272	(setq epa-file-encrypt-to
fef7aa9e MO	273	(mapcar
	274	(lambda (key)
	275	(epg-sub-key-id (car (epg-key-sub-key-list key))))
c154c0be MO	276	(epa-select-keys
c154c0be MO	277	(epg-make-context)
333f9019	278	"Select recipients for encryption.
fef7aa9e	279	If no one is selected, symmetric encryption will be performed. "))))
c154c0be MO	280
	281	;;;###autoload
	282	(defun epa-file-enable ()
	283	(interactive)
	284	(if (memq epa-file-handler file-name-handler-alist)
	285	(message "`epa-file' already enabled")
	286	(setq file-name-handler-alist
	287	(cons epa-file-handler file-name-handler-alist))
bfeee9d1	288	(add-hook 'find-file-hook 'epa-file-find-file-hook)
c154c0be MO	289	(setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist))
	290	(message "`epa-file' enabled")))
	291
	292	;;;###autoload
	293	(defun epa-file-disable ()
	294	(interactive)
	295	(if (memq epa-file-handler file-name-handler-alist)
	296	(progn
	297	(setq file-name-handler-alist
	298	(delq epa-file-handler file-name-handler-alist))
bfeee9d1	299	(remove-hook 'find-file-hook 'epa-file-find-file-hook)
c154c0be MO	300	(setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
	301	auto-mode-alist))
	302	(message "`epa-file' disabled"))
	303	(message "`epa-file' already disabled")))
	304
	305	(provide 'epa-file)
	306
	307	;;; epa-file.el ends here