Added more information.
[elisp/epg.git] / epg-file.el
1 ;;; epg-file.el --- transparent file encryption utility
2 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
3 ;;   2005, 2006 Free Software Foundation, Inc.
4 ;; Copyright (C) 2006 Daiki Ueno
5
6 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;;      Naoto Morishima <naoto@morishima.net>
8 ;; Keywords: PGP, GnuPG
9
10 ;; This file is part of EasyPG.
11
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
16
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
26
27 ;;; Commentary:
28
29 ;; epg-file.el is based on hedgehog.el by Naoto Morishima.
30 ;; http://www.morishima.net/~naoto/software/hedgehog/index.php.ja
31
32 ;;; Code:
33
34 (require 'epg)
35
36 (defgroup epg-file ()
37   "Transparent file encryption utility of EasyPG."
38   :group 'epg)
39
40 (defcustom epg-file-name-regexp "\\.gpg\\'"
41   "Regexp that matches filenames that are assumed to be encrypted
42 with GnuPG."
43   :type 'regexp
44   :group 'epg-file)
45
46 (defun epg-file-handler (operation &rest args)
47   (let ((epg-file-operation (get operation 'epg-file)))
48     (if epg-file-operation
49         (apply epg-file-operation args)
50       (epg-file-run-real-handler operation args))))
51
52 (defun epg-file-run-real-handler (operation args)
53   (let ((inhibit-file-name-handlers
54          (cons 'epg-file-handler
55                (and (eq inhibit-file-name-operation operation)
56                     inhibit-file-name-handlers)))
57         (inhibit-file-name-operation operation))
58     (apply operation args)))
59
60 (defvar buffer-file-type)
61 (defvar last-coding-system-used)
62 (defun epg-file-write-region (start end filename &optional append visit
63                                     lockname mustbenew)
64   (let* ((visit-file (if (stringp visit)
65                          (expand-file-name visit)
66                        (expand-file-name filename)))
67          ;; XXX: Obtain the value returned by choose_write_coding_system
68          (coding-system (condition-case nil
69                             (epg-file-run-real-handler
70                              'write-region (list start end "/"))
71                           (file-error (if (boundp 'last-coding-system-used)
72                                           last-coding-system-used
73                                         buffer-file-coding-system))))
74          ;; start and end are normally buffer positions
75          ;; specifying the part of the buffer to write.
76          ;; If start is nil, that means to use the entire buffer contents.
77          ;; If start is a string, then output that string to the file
78          ;; instead of any buffer contents; end is ignored.
79          (string (encode-coding-string (cond
80                                         ((stringp start)
81                                          start)
82                                         ((null start)
83                                          (buffer-string))
84                                         (t
85                                          (buffer-substring start end)))
86                                        coding-system)))
87     (with-temp-buffer
88       (if (fboundp 'set-buffer-multibyte)
89           (set-buffer-multibyte nil))
90       ;; Optional fourth argument append if non-nil means
91       ;;   append to existing file contents (if any).  If it is an integer,
92       ;;   seek to that offset in the file before writing.
93       (if (and append (file-exists-p filename))
94           ;; Enable passphrase cache on this temp buffer
95           (let ((coding-system-for-read 'binary))
96             ;; set visit to t so that passphrase is cached
97             (insert-file-contents filename t)
98             (setq buffer-file-name nil)))
99       ;; Insert data to encrypt
100       (goto-char (if (integerp append) (1+ append) (point-max)))
101       (delete-region (point) (min (+ (point) (length string)) (point-max)))
102       (insert string)
103
104       (let ((coding-system-for-write 'binary)
105             (coding-system-for-read 'binary)
106             (context (epg-make-context))
107             recipients
108             string
109             cipher)
110         (while (not (equal (setq string
111                                  (read-string "To (end with an empty line): "))
112                            ""))
113           (setq recipients (cons string recipients)))
114         (when (setq cipher (epg-encrypt-string context (buffer-string)
115                                                recipients))
116           (if (and (memq system-type '(ms-dos windows-nt))
117                    (boundp 'buffer-file-type))
118               (setq buffer-file-type t))
119           (epg-file-run-real-handler
120            'write-region
121            (list cipher nil filename nil 'not-visit lockname mustbenew)))))
122     ;; Optional fifth argument visit, if t or a string, means
123     ;;   set the last-save-file-modtime of buffer to this file's modtime
124     ;;   and mark buffer not modified.
125     ;; If visit is a string, it is a second file name;
126     ;;   the output goes to filename, but the buffer is marked as visiting visit.
127     ;;   visit is also the file name to lock and unlock for clash detection.
128     ;; If visit is neither t nor nil nor a string,
129     ;;   that means do not display the "Wrote file" message.
130     (when (or (eq visit t) (stringp visit))
131       (setq buffer-file-name filename)
132       (set-visited-file-modtime))
133     (if (stringp visit)
134         (setq buffer-file-name visit))
135     (when (or (eq visit t) (eq visit nil) (stringp visit))
136       (message "Wrote %s" visit-file))
137     (if (boundp 'last-coding-system-used)
138         (setq last-coding-system-used coding-system))
139     nil))
140
141 (defun epg-file-insert-file-contents (filename &optional visit beg end replace)
142   (barf-if-buffer-read-only)
143   (setq filename (expand-file-name filename))
144   (let ((filename (expand-file-name filename))
145         (length 0))
146     (if (file-exists-p filename)
147         (let ((local-file
148                (let ((inhibit-file-name-operation
149                       (when (eq inhibit-file-name-operation
150                                 'insert-file-contents)
151                         'file-local-copy)))
152                  (file-local-copy filename)))
153               (coding-system-for-read 'binary)
154               (context (epg-make-context))
155               string)
156           (unwind-protect
157               (progn
158                 (setq string (epg-decrypt-file context (or local-file
159                                                            filename))
160                       length (length string))
161                 (if replace
162                     (goto-char (point-min)))
163                 (save-excursion
164                   (let ((buffer-file-name (if visit nil buffer-file-name)))
165                     (save-restriction
166                       (narrow-to-region (point) (point))
167                       (insert (decode-coding-string string 'undecided)))
168                     (if replace
169                         (delete-region (point) (point-max))))))
170             (when (and local-file (file-exists-p local-file))
171               (delete-file local-file)))))
172     ;; If second argument visit is non-nil, the buffer's visited filename
173     ;; and last save file modtime are set, and it is marked unmodified.
174     (when visit
175       (unlock-buffer)
176       (setq buffer-file-name filename)
177       (set-visited-file-modtime))
178
179     ;; If visiting and the file does not exist, visiting is completed
180     ;; before the error is signaled.
181     (if (and visit (not (file-exists-p filename)))
182         (signal 'file-error (list "Opening input file" filename)))
183
184     ;; Returns list of absolute file name and number of characters inserted.
185     (list filename length)))
186
187 (put 'write-region 'epg-file 'epg-file-write-region)
188 (put 'insert-file-contents 'epg-file 'epg-file-insert-file-contents)
189
190 (unless (assoc epg-file-name-regexp file-name-handler-alist)
191   (setq file-name-handler-alist
192         (cons (cons epg-file-name-regexp 'epg-file-handler)
193               file-name-handler-alist)))
194
195 (unless (assoc epg-file-name-regexp auto-mode-alist)
196   (setq auto-mode-alist
197         (cons (list epg-file-name-regexp nil 'strip-suffix)
198               auto-mode-alist)))
199
200 (provide 'epg-file)
201
202 ;;; epg-file.el ends here