(calendar-other-dates): New function.
[emacs.git] / lisp / epa-file.el
blob558048403ce8b3b0a77533bee57c95996d5361c1
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)
12 ;; any later version.
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.
24 ;;; Code:
26 (require 'epa)
28 (defgroup epa-file nil
29 "The EasyPG Assistant hooks for transparent file encryption"
30 :version "23.1"
31 :group 'epa)
33 (defun epa-file--file-name-regexp-set (variable value)
34 (set-default variable value)
35 (if (fboundp 'epa-file-name-regexp-update)
36 (epa-file-name-regexp-update)))
38 (defcustom epa-file-name-regexp "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'"
39 "Regexp which matches filenames to be encrypted with GnuPG.
41 If you set this outside Custom while epa-file is already enabled, you
42 have to call `epa-file-name-regexp-update' after setting it to
43 properly update file-name-handler-alist. Setting this through Custom
44 does that automatically."
45 :type 'regexp
46 :group 'epa-file
47 :set 'epa-file--file-name-regexp-set)
49 (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
50 "If non-nil, cache passphrase for symmetric encryption."
51 :type 'boolean
52 :group 'epa-file)
54 (defcustom epa-file-inhibit-auto-save t
55 "If non-nil, disable auto-saving when opening an encrypted file."
56 :type 'boolean
57 :group 'epa-file)
59 (defcustom epa-file-select-keys nil
60 "If non-nil, always asks user to select recipients."
61 :type 'boolean
62 :group 'epa-file)
64 (defvar epa-file-encrypt-to nil
65 "*Recipient(s) used for encrypting files.
66 May either be a string or a list of strings.")
68 ;;;###autoload
69 (put 'epa-file-encrypt-to 'safe-local-variable
70 (lambda (val)
71 (or (stringp val)
72 (and (listp val)
73 (catch 'safe
74 (mapc (lambda (elt)
75 (unless (stringp elt)
76 (throw 'safe nil)))
77 val)
78 t)))))
80 ;;;###autoload
81 (put 'epa-file-encrypt-to 'permanent-local t)
83 (defvar epa-file-handler
84 (cons epa-file-name-regexp 'epa-file-handler))
86 (defvar epa-file-auto-mode-alist-entry
87 (list epa-file-name-regexp nil 'epa-file))
89 (defvar epa-file-passphrase-alist nil)
91 (eval-and-compile
92 (if (fboundp 'encode-coding-string)
93 (defalias 'epa-file--encode-coding-string 'encode-coding-string)
94 (defalias 'epa-file--encode-coding-string 'identity)))
96 (eval-and-compile
97 (if (fboundp 'decode-coding-string)
98 (defalias 'epa-file--decode-coding-string 'decode-coding-string)
99 (defalias 'epa-file--decode-coding-string 'identity)))
101 (defun epa-file-name-regexp-update ()
102 (interactive)
103 (unless (equal (car epa-file-handler) epa-file-name-regexp)
104 (setcar epa-file-handler epa-file-name-regexp)))
106 (defun epa-file-passphrase-callback-function (context key-id file)
107 (if (and epa-file-cache-passphrase-for-symmetric-encryption
108 (eq key-id 'SYM))
109 (progn
110 (setq file (file-truename file))
111 (let ((entry (assoc file epa-file-passphrase-alist))
112 passphrase)
113 (or (copy-sequence (cdr entry))
114 (progn
115 (unless entry
116 (setq entry (list file)
117 epa-file-passphrase-alist
118 (cons entry
119 epa-file-passphrase-alist)))
120 (setq passphrase (epa-passphrase-callback-function context
121 key-id nil))
122 (setcdr entry (copy-sequence passphrase))
123 passphrase))))
124 (epa-passphrase-callback-function context key-id nil)))
126 (defun epa-file-handler (operation &rest args)
127 (save-match-data
128 (let ((op (get operation 'epa-file)))
129 (if op
130 (apply op args)
131 (epa-file-run-real-handler operation args)))))
133 (defun epa-file-run-real-handler (operation args)
134 (let ((inhibit-file-name-handlers
135 (cons 'epa-file-handler
136 (and (eq inhibit-file-name-operation operation)
137 inhibit-file-name-handlers)))
138 (inhibit-file-name-operation operation))
139 (apply operation args)))
141 (defun epa-file-decode-and-insert (string file visit beg end replace)
142 (if (fboundp 'decode-coding-inserted-region)
143 (save-restriction
144 (narrow-to-region (point) (point))
145 (let ((multibyte enable-multibyte-characters))
146 (set-buffer-multibyte nil)
147 (insert string)
148 (set-buffer-multibyte multibyte)
149 (decode-coding-inserted-region
150 (point-min) (point-max)
151 (substring file 0 (string-match epa-file-name-regexp file))
152 visit beg end replace)))
153 (insert (epa-file--decode-coding-string string (or coding-system-for-read
154 'undecided)))))
156 (defvar last-coding-system-used)
157 (defun epa-file-insert-file-contents (file &optional visit beg end replace)
158 (barf-if-buffer-read-only)
159 (if (and visit (or beg end))
160 (error "Attempt to visit less than an entire file"))
161 (setq file (expand-file-name file))
162 (let* ((local-copy
163 (condition-case inl
164 (epa-file-run-real-handler #'file-local-copy (list file))
165 (error)))
166 (local-file (or local-copy file))
167 (context (epg-make-context))
168 string length entry)
169 (if visit
170 (setq buffer-file-name file))
171 (epg-context-set-passphrase-callback
172 context
173 (cons #'epa-file-passphrase-callback-function
174 local-file))
175 (epg-context-set-progress-callback context
176 #'epa-progress-callback-function)
177 (unwind-protect
178 (progn
179 (if replace
180 (goto-char (point-min)))
181 (condition-case error
182 (setq string (epg-decrypt-file context local-file nil))
183 (error
184 (if (setq entry (assoc file epa-file-passphrase-alist))
185 (setcdr entry nil))
186 (signal 'file-error
187 (cons "Opening input file" (cdr error)))))
188 (make-local-variable 'epa-file-encrypt-to)
189 (setq epa-file-encrypt-to
190 (mapcar #'car (epg-context-result-for context 'encrypted-to)))
191 (if (or beg end)
192 (setq string (substring string (or beg 0) end)))
193 (save-excursion
194 (save-restriction
195 (narrow-to-region (point) (point))
196 (epa-file-decode-and-insert string file visit beg end replace)
197 (setq length (- (point-max) (point-min))))
198 (if replace
199 (delete-region (point) (point-max)))))
200 (if (and local-copy
201 (file-exists-p local-copy))
202 (delete-file local-copy)))
203 (list file length)))
204 (put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
206 (defun epa-file-write-region (start end file &optional append visit lockname
207 mustbenew)
208 (if append
209 (error "Can't append to the file."))
210 (setq file (expand-file-name file))
211 (let* ((coding-system (or coding-system-for-write
212 (if (fboundp 'select-safe-coding-system)
213 ;; This is needed since Emacs 22 has
214 ;; no-conversion setting for *.gpg in
215 ;; `auto-coding-alist'.
216 (let ((buffer-file-name
217 (file-name-sans-extension file)))
218 (select-safe-coding-system
219 (point-min) (point-max)))
220 buffer-file-coding-system)))
221 (context (epg-make-context))
222 (coding-system-for-write 'binary)
223 string entry
224 (recipients
225 (cond
226 ((listp epa-file-encrypt-to) epa-file-encrypt-to)
227 ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))
228 (epg-context-set-passphrase-callback
229 context
230 (cons #'epa-file-passphrase-callback-function
231 file))
232 (epg-context-set-progress-callback context
233 #'epa-progress-callback-function)
234 (epg-context-set-armor context epa-armor)
235 (condition-case error
236 (setq string
237 (epg-encrypt-string
238 context
239 (if (stringp start)
240 (epa-file--encode-coding-string start coding-system)
241 (epa-file--encode-coding-string (buffer-substring start end)
242 coding-system))
243 (if (or epa-file-select-keys
244 (not (local-variable-p 'epa-file-encrypt-to
245 (current-buffer))))
246 (epa-select-keys
247 context
248 "Select recipents for encryption.
249 If no one is selected, symmetric encryption will be performed. "
250 recipients)
251 (if epa-file-encrypt-to
252 (epg-list-keys context recipients)))))
253 (error
254 (if (setq entry (assoc file epa-file-passphrase-alist))
255 (setcdr entry nil))
256 (signal 'file-error (cons "Opening output file" (cdr error)))))
257 (epa-file-run-real-handler
258 #'write-region
259 (list string nil file append visit lockname mustbenew))
260 (if (boundp 'last-coding-system-used)
261 (setq last-coding-system-used coding-system))
262 (if (eq visit t)
263 (progn
264 (setq buffer-file-name file)
265 (set-visited-file-modtime))
266 (if (stringp visit)
267 (progn
268 (set-visited-file-modtime)
269 (setq buffer-file-name visit))))
270 (if (or (eq visit t)
271 (eq visit nil)
272 (stringp visit))
273 (message "Wrote %s" buffer-file-name))))
274 (put 'write-region 'epa-file 'epa-file-write-region)
276 (defun epa-file-find-file-hook ()
277 (if (and buffer-file-name
278 (string-match epa-file-name-regexp buffer-file-name)
279 epa-file-inhibit-auto-save)
280 (auto-save-mode 0))
281 (set-buffer-modified-p nil))
283 (defun epa-file-select-keys ()
284 "Select recipients for encryption."
285 (interactive)
286 (make-local-variable 'epa-file-encrypt-to)
287 (setq epa-file-encrypt-to
288 (mapcar
289 (lambda (key)
290 (epg-sub-key-id (car (epg-key-sub-key-list key))))
291 (epa-select-keys
292 (epg-make-context)
293 "Select recipents for encryption.
294 If no one is selected, symmetric encryption will be performed. "))))
296 ;;;###autoload
297 (defun epa-file-enable ()
298 (interactive)
299 (if (memq epa-file-handler file-name-handler-alist)
300 (message "`epa-file' already enabled")
301 (setq file-name-handler-alist
302 (cons epa-file-handler file-name-handler-alist))
303 (add-hook 'find-file-hooks 'epa-file-find-file-hook)
304 (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist))
305 (message "`epa-file' enabled")))
307 ;;;###autoload
308 (defun epa-file-disable ()
309 (interactive)
310 (if (memq epa-file-handler file-name-handler-alist)
311 (progn
312 (setq file-name-handler-alist
313 (delq epa-file-handler file-name-handler-alist))
314 (remove-hook 'find-file-hooks 'epa-file-find-file-hook)
315 (setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
316 auto-mode-alist))
317 (message "`epa-file' disabled"))
318 (message "`epa-file' already disabled")))
320 ;;;###autoload
321 (define-minor-mode epa-file-mode
322 "Toggle automatic file encryption and decryption.
323 With prefix argument ARG, turn auto encryption on if positive, else off.
324 Return the new status of auto encryption (non-nil means on)."
325 :global t :init-value nil :group 'epa-file :version "23.1"
326 (setq file-name-handler-alist
327 (delq epa-file-handler file-name-handler-alist))
328 (remove-hook 'find-file-hooks 'epa-file-find-file-hook)
329 (setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
330 auto-mode-alist))
331 (when epa-file-mode
332 (setq file-name-handler-alist
333 (cons epa-file-handler file-name-handler-alist))
334 (add-hook 'find-file-hooks 'epa-file-find-file-hook)
335 (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry
336 auto-mode-alist))))
338 (provide 'epa-file)
340 ;; arch-tag: 5715152f-0eb1-4dbc-9008-07098775314d
341 ;;; epa-file.el ends here