1 ;;; epf.el --- transparent file encryption utility
2 ;; Copyright (C) 2006 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Naoto Morishima <naoto@morishima.net>
6 ;; Keywords: PGP, GnuPG
8 ;; This file is part of EasyPG.
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program 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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;; epf.el is based on hedgehog.el by Naoto Morishima.
28 ;; http://www.morishima.net/~naoto/software/hedgehog/index.php.ja
35 "Transparent file encryption utility of EasyPG."
38 (defcustom epf-name-regexp "\\.gpg\\'"
39 "Regexp that matches filenames that are assumed to be encrypted
44 (defun epf-handler (operation &rest args)
45 (let ((epf-operation (get operation 'epf)))
47 (apply epf-operation args)
48 (epf-run-real-handler operation args))))
50 (defun epf-run-real-handler (operation args)
51 (let ((inhibit-file-name-handlers
53 (and (eq inhibit-file-name-operation operation)
54 inhibit-file-name-handlers)))
55 (inhibit-file-name-operation operation))
56 (apply operation args)))
58 (defvar buffer-file-type)
59 (defvar last-coding-system-used)
60 (defun epf-write-region (start end filename &optional append visit
62 (let* ((visit-file (if (stringp visit)
63 (expand-file-name visit)
64 (expand-file-name filename)))
65 ;; XXX: Obtain the value returned by choose_write_coding_system
66 (coding-system (condition-case nil
68 'write-region (list start end "/"))
69 (file-error (if (boundp 'last-coding-system-used)
70 last-coding-system-used
71 buffer-file-coding-system))))
72 ;; start and end are normally buffer positions
73 ;; specifying the part of the buffer to write.
74 ;; If start is nil, that means to use the entire buffer contents.
75 ;; If start is a string, then output that string to the file
76 ;; instead of any buffer contents; end is ignored.
77 (string (encode-coding-string (cond
83 (buffer-substring start end)))
86 (if (fboundp 'set-buffer-multibyte)
87 (set-buffer-multibyte nil))
88 ;; Optional fourth argument append if non-nil means
89 ;; append to existing file contents (if any). If it is an integer,
90 ;; seek to that offset in the file before writing.
91 (if (and append (file-exists-p filename))
92 ;; Enable passphrase cache on this temp buffer
93 (let ((coding-system-for-read 'binary))
94 ;; set visit to t so that passphrase is cached
95 (insert-file-contents filename t)
96 (setq buffer-file-name nil)))
97 ;; Insert data to encrypt
98 (goto-char (if (integerp append) (1+ append) (point-max)))
99 (delete-region (point) (min (+ (point) (length string)) (point-max)))
102 (let ((coding-system-for-write 'binary)
103 (coding-system-for-read 'binary)
104 (context (epg-make-context))
108 (while (not (equal (setq string
109 (read-string "To (end with an empty line): "))
111 (setq recipients (cons string recipients)))
112 (when (setq cipher (epg-encrypt-string context (buffer-string)
114 (if (and (memq system-type '(ms-dos windows-nt))
115 (boundp 'buffer-file-type))
116 (setq buffer-file-type t))
117 (epf-run-real-handler
119 (list cipher nil filename nil 'not-visit lockname mustbenew)))))
120 ;; Optional fifth argument visit, if t or a string, means
121 ;; set the last-save-file-modtime of buffer to this file's modtime
122 ;; and mark buffer not modified.
123 ;; If visit is a string, it is a second file name;
124 ;; the output goes to filename, but the buffer is marked as visiting visit.
125 ;; visit is also the file name to lock and unlock for clash detection.
126 ;; If visit is neither t nor nil nor a string,
127 ;; that means do not display the "Wrote file" message.
128 (when (or (eq visit t) (stringp visit))
129 (setq buffer-file-name filename)
130 (set-visited-file-modtime))
132 (setq buffer-file-name visit))
133 (when (or (eq visit t) (eq visit nil) (stringp visit))
134 (message "Wrote %s" visit-file))
135 (if (boundp 'last-coding-system-used)
136 (setq last-coding-system-used coding-system))
139 (defun epf-insert-file-contents (filename &optional visit beg end replace)
140 (barf-if-buffer-read-only)
141 (setq filename (expand-file-name filename))
142 (let ((filename (expand-file-name filename))
144 (if (file-exists-p filename)
146 (let ((inhibit-file-name-operation
147 (when (eq inhibit-file-name-operation
148 'insert-file-contents)
150 (file-local-copy filename)))
151 (coding-system-for-read 'binary)
152 (context (epg-make-context))
156 (setq string (epg-decrypt-file context (or local-file
159 length (length string))
161 (goto-char (point-min)))
163 (let ((buffer-file-name (if visit nil buffer-file-name)))
165 (narrow-to-region (point) (point))
166 (insert (decode-coding-string string 'undecided)))
168 (delete-region (point) (point-max))))))
169 (when (and local-file (file-exists-p local-file))
170 (delete-file local-file)))))
171 ;; If second argument visit is non-nil, the buffer's visited filename
172 ;; and last save file modtime are set, and it is marked unmodified.
175 (setq buffer-file-name filename)
176 (set-visited-file-modtime))
178 ;; If visiting and the file does not exist, visiting is completed
179 ;; before the error is signaled.
180 (if (and visit (not (file-exists-p filename)))
181 (signal 'file-error (list "Opening input file" filename)))
183 ;; Returns list of absolute file name and number of characters inserted.
184 (list filename length)))
186 (put 'write-region 'epf 'epf-write-region)
187 (put 'insert-file-contents 'epf 'epf-insert-file-contents)
189 (unless (rassq 'epf-handler file-name-handler-alist)
190 (setq file-name-handler-alist
191 (cons (cons epf-name-regexp 'epf-handler)
192 file-name-handler-alist)
194 (cons (list epf-name-regexp nil 'strip-suffix)