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

;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*-
;; Copyright (C) 2006-2014 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))
         (buf (current-buffer))
	 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)
	       (setq-local 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)))))
          (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
	  (setq-local 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)
  (setq-local 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 --
ba318903	2	;; Copyright (C) 2006-2014 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))
0962f376	135	(buf (current-buffer))
c154c0be	136	string length entry)
2cb35a56 DU	137	(if visit
2cb35a56 DU	138	(setq buffer-file-name file))
c154c0be MO	139	(epg-context-set-passphrase-callback
	140	context
	141	(cons #'epa-file-passphrase-callback-function
	142	local-file))
9d5cb631 DU	143	(epg-context-set-progress-callback
	144	context
	145	(cons #'epa-progress-callback-function
	146	(format "Decrypting %s" file)))
c154c0be MO	147	(unwind-protect
	148	(progn
	149	(if replace
	150	(goto-char (point-min)))
	151	(condition-case error
	152	(setq string (epg-decrypt-file context local-file nil))
	153	(error
	154	(if (setq entry (assoc file epa-file-passphrase-alist))
	155	(setcdr entry nil))
192cfe77 DU	156	;; Hack to prevent find-file from opening empty buffer
	157	;; when decryption failed (bug#6568). See the place
	158	;; where `find-file-not-found-functions' are called in
	159	;; `find-file-noselect-1'.
4f195cf7	160	(when (file-exists-p local-file)
0962f376	161	(setq-local epa-file-error error)
4f195cf7 DU	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
c154c0be MO	166	(cons "Opening input file" (cdr error)))))
0962f376 SM	167	(set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
	168	(setq-local epa-file-encrypt-to
	169	(mapcar #'car (epg-context-result-for
	170	context 'encrypted-to)))
c154c0be MO	171	(if (or beg end)
	172	(setq string (substring string (or beg 0) end)))
	173	(save-excursion
c5fe4acb DU	174	;; If visiting, bind off buffer-file-name so that
	175	;; file-locking will not ask whether we should
	176	;; really edit the buffer.
	177	(let ((buffer-file-name
	178	(if visit nil buffer-file-name)))
	179	(save-restriction
	180	(narrow-to-region (point) (point))
	181	(epa-file-decode-and-insert string file visit beg end replace)
	182	(setq length (- (point-max) (point-min))))
	183	(if replace
	184	(delete-region (point) (point-max))))
2cb35a56 DU	185	(if visit
2cb35a56 DU	186	(set-visited-file-modtime))))
c154c0be MO	187	(if (and local-copy
	188	(file-exists-p local-copy))
	189	(delete-file local-copy)))
	190	(list file length)))
	191	(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
	192
	193	(defun epa-file-write-region (start end file &optional append visit lockname
	194	mustbenew)
	195	(if append
5a0c3f56	196	(error "Can't append to the file"))
c154c0be MO	197	(setq file (expand-file-name file))
	198	(let* ((coding-system (or coding-system-for-write
	199	(if (fboundp 'select-safe-coding-system)
	200	;; This is needed since Emacs 22 has
	201	;; no-conversion setting for *.gpg in
	202	;; `auto-coding-alist'.
	203	(let ((buffer-file-name
	204	(file-name-sans-extension file)))
	205	(select-safe-coding-system
	206	(point-min) (point-max)))
	207	buffer-file-coding-system)))
	208	(context (epg-make-context))
	209	(coding-system-for-write 'binary)
	210	string entry
	211	(recipients
	212	(cond
	213	((listp epa-file-encrypt-to) epa-file-encrypt-to)
	214	((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))
	215	(epg-context-set-passphrase-callback
	216	context
	217	(cons #'epa-file-passphrase-callback-function
	218	file))
9d5cb631 DU	219	(epg-context-set-progress-callback
	220	context
	221	(cons #'epa-progress-callback-function
	222	(format "Encrypting %s" file)))
c154c0be MO	223	(epg-context-set-armor context epa-armor)
	224	(condition-case error
	225	(setq string
	226	(epg-encrypt-string
	227	context
	228	(if (stringp start)
	229	(epa-file--encode-coding-string start coding-system)
6843296d	230	(unless start
437eedba DU	231	(setq start (point-min)
437eedba DU	232	end (point-max)))
c154c0be MO	233	(epa-file--encode-coding-string (buffer-substring start end)
c154c0be MO	234	coding-system))
33088bed DU	235	(if (or (eq epa-file-select-keys t)
	236	(and (null epa-file-select-keys)
	237	(not (local-variable-p 'epa-file-encrypt-to
	238	(current-buffer)))))
c154c0be MO	239	(epa-select-keys
c154c0be MO	240	context
333f9019	241	"Select recipients for encryption.
c154c0be MO	242	If no one is selected, symmetric encryption will be performed. "
	243	recipients)
	244	(if epa-file-encrypt-to
	245	(epg-list-keys context recipients)))))
	246	(error
	247	(if (setq entry (assoc file epa-file-passphrase-alist))
	248	(setcdr entry nil))
	249	(signal 'file-error (cons "Opening output file" (cdr error)))))
	250	(epa-file-run-real-handler
	251	#'write-region
	252	(list string nil file append visit lockname mustbenew))
	253	(if (boundp 'last-coding-system-used)
	254	(setq last-coding-system-used coding-system))
	255	(if (eq visit t)
	256	(progn
	257	(setq buffer-file-name file)
	258	(set-visited-file-modtime))
	259	(if (stringp visit)
	260	(progn
	261	(set-visited-file-modtime)
	262	(setq buffer-file-name visit))))
	263	(if (or (eq visit t)
	264	(eq visit nil)
	265	(stringp visit))
	266	(message "Wrote %s" buffer-file-name))))
	267	(put 'write-region 'epa-file 'epa-file-write-region)
	268
c154c0be MO	269	(defun epa-file-select-keys ()
	270	"Select recipients for encryption."
	271	(interactive)
0962f376 SM	272	(setq-local epa-file-encrypt-to
	273	(mapcar
	274	(lambda (key)
	275	(epg-sub-key-id (car (epg-key-sub-key-list key))))
	276	(epa-select-keys
	277	(epg-make-context)
	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