1 ;;; epa-file.el --- the EasyPG Assistant, transparent file encryption
2 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: PGP, GnuPG
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02110-1301, USA.
27 (require 'epa-file-hook
)
29 (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
30 "If non-nil, cache passphrase for symmetric encryption."
34 (defcustom epa-file-select-keys nil
35 "If non-nil, always asks user to select recipients."
39 (defvar epa-file-passphrase-alist nil
)
42 (if (fboundp 'encode-coding-string
)
43 (defalias 'epa-file--encode-coding-string
'encode-coding-string
)
44 (defalias 'epa-file--encode-coding-string
'identity
)))
47 (if (fboundp 'decode-coding-string
)
48 (defalias 'epa-file--decode-coding-string
'decode-coding-string
)
49 (defalias 'epa-file--decode-coding-string
'identity
)))
51 (defun epa-file-passphrase-callback-function (context key-id file
)
52 (if (and epa-file-cache-passphrase-for-symmetric-encryption
55 (setq file
(file-truename file
))
56 (let ((entry (assoc file epa-file-passphrase-alist
))
58 (or (copy-sequence (cdr entry
))
61 (setq entry
(list file
)
62 epa-file-passphrase-alist
64 epa-file-passphrase-alist
)))
65 (setq passphrase
(epa-passphrase-callback-function context
67 (setcdr entry
(copy-sequence passphrase
))
69 (epa-passphrase-callback-function context key-id nil
)))
72 (defun epa-file-handler (operation &rest args
)
74 (let ((op (get operation
'epa-file
)))
77 (epa-file-run-real-handler operation args
)))))
79 (defun epa-file-run-real-handler (operation args
)
80 (let ((inhibit-file-name-handlers
81 (cons 'epa-file-handler
82 (and (eq inhibit-file-name-operation operation
)
83 inhibit-file-name-handlers
)))
84 (inhibit-file-name-operation operation
))
85 (apply operation args
)))
87 (defun epa-file-decode-and-insert (string file visit beg end replace
)
88 (if (fboundp 'decode-coding-inserted-region
)
90 (narrow-to-region (point) (point))
91 (let ((multibyte enable-multibyte-characters
))
92 (set-buffer-multibyte nil
)
94 (set-buffer-multibyte multibyte
)
95 (decode-coding-inserted-region
96 (point-min) (point-max)
97 (substring file
0 (string-match epa-file-name-regexp file
))
98 visit beg end replace
)))
99 (insert (epa-file--decode-coding-string string
(or coding-system-for-read
102 (defvar last-coding-system-used
)
103 (defun epa-file-insert-file-contents (file &optional visit beg end replace
)
104 (barf-if-buffer-read-only)
105 (if (and visit
(or beg end
))
106 (error "Attempt to visit less than an entire file"))
107 (setq file
(expand-file-name file
))
110 (epa-file-run-real-handler #'file-local-copy
(list file
))
112 (local-file (or local-copy file
))
113 (context (epg-make-context))
116 (setq buffer-file-name file
))
117 (epg-context-set-passphrase-callback
119 (cons #'epa-file-passphrase-callback-function
121 (epg-context-set-progress-callback context
122 #'epa-progress-callback-function
)
126 (goto-char (point-min)))
127 (condition-case error
128 (setq string
(epg-decrypt-file context local-file nil
))
130 (if (setq entry
(assoc file epa-file-passphrase-alist
))
133 (cons "Opening input file" (cdr error
)))))
134 (make-local-variable 'epa-file-encrypt-to
)
135 (setq epa-file-encrypt-to
136 (mapcar #'car
(epg-context-result-for context
'encrypted-to
)))
138 (setq string
(substring string
(or beg
0) end
)))
141 (narrow-to-region (point) (point))
142 (epa-file-decode-and-insert string file visit beg end replace
)
143 (setq length
(- (point-max) (point-min))))
145 (delete-region (point) (point-max)))))
147 (file-exists-p local-copy
))
148 (delete-file local-copy
)))
150 (put 'insert-file-contents
'epa-file
'epa-file-insert-file-contents
)
152 (defun epa-file-write-region (start end file
&optional append visit lockname
155 (error "Can't append to the file."))
156 (setq file
(expand-file-name file
))
157 (let* ((coding-system (or coding-system-for-write
158 (if (fboundp 'select-safe-coding-system
)
159 ;; This is needed since Emacs 22 has
160 ;; no-conversion setting for *.gpg in
161 ;; `auto-coding-alist'.
162 (let ((buffer-file-name
163 (file-name-sans-extension file
)))
164 (select-safe-coding-system
165 (point-min) (point-max)))
166 buffer-file-coding-system
)))
167 (context (epg-make-context))
168 (coding-system-for-write 'binary
)
172 ((listp epa-file-encrypt-to
) epa-file-encrypt-to
)
173 ((stringp epa-file-encrypt-to
) (list epa-file-encrypt-to
)))))
174 (epg-context-set-passphrase-callback
176 (cons #'epa-file-passphrase-callback-function
178 (epg-context-set-progress-callback context
179 #'epa-progress-callback-function
)
180 (epg-context-set-armor context epa-armor
)
181 (condition-case error
186 (epa-file--encode-coding-string start coding-system
)
187 (epa-file--encode-coding-string (buffer-substring start end
)
189 (if (or epa-file-select-keys
190 (not (local-variable-p 'epa-file-encrypt-to
194 "Select recipents for encryption.
195 If no one is selected, symmetric encryption will be performed. "
197 (if epa-file-encrypt-to
198 (epg-list-keys context recipients
)))))
200 (if (setq entry
(assoc file epa-file-passphrase-alist
))
202 (signal 'file-error
(cons "Opening output file" (cdr error
)))))
203 (epa-file-run-real-handler
205 (list string nil file append visit lockname mustbenew
))
206 (if (boundp 'last-coding-system-used
)
207 (setq last-coding-system-used coding-system
))
210 (setq buffer-file-name file
)
211 (set-visited-file-modtime))
214 (set-visited-file-modtime)
215 (setq buffer-file-name visit
))))
219 (message "Wrote %s" buffer-file-name
))))
220 (put 'write-region
'epa-file
'epa-file-write-region
)
222 (defun epa-file-select-keys ()
223 "Select recipients for encryption."
225 (make-local-variable 'epa-file-encrypt-to
)
226 (setq epa-file-encrypt-to
229 (epg-sub-key-id (car (epg-key-sub-key-list key
))))
232 "Select recipents for encryption.
233 If no one is selected, symmetric encryption will be performed. "))))
236 (defun epa-file-enable ()
238 (if (memq epa-file-handler file-name-handler-alist
)
239 (message "`epa-file' already enabled")
240 (setq file-name-handler-alist
241 (cons epa-file-handler file-name-handler-alist
))
242 (add-hook 'find-file-hook
'epa-file-find-file-hook
)
243 (setq auto-mode-alist
(cons epa-file-auto-mode-alist-entry auto-mode-alist
))
244 (message "`epa-file' enabled")))
247 (defun epa-file-disable ()
249 (if (memq epa-file-handler file-name-handler-alist
)
251 (setq file-name-handler-alist
252 (delq epa-file-handler file-name-handler-alist
))
253 (remove-hook 'find-file-hook
'epa-file-find-file-hook
)
254 (setq auto-mode-alist
(delq epa-file-auto-mode-alist-entry
256 (message "`epa-file' disabled"))
257 (message "`epa-file' already disabled")))
261 ;; arch-tag: 5715152f-0eb1-4dbc-9008-07098775314d
262 ;;; epa-file.el ends here