Simplified.
[elisp/epg.git] / epg-file.el
1 (require 'epg)
2
3 (defcustom epg-file-name-regexp "\\.gpg\\'"
4   "Regexp that matches filenames that are assumed to be encrypted
5 with GnuPG."
6   :type 'regexp
7   :group 'epg-file)
8
9 (defun epg-file-handler (operation &rest args)
10   (let ((epg-file-operation (get operation 'epg-file)))
11     (if epg-file-operation
12         (apply epg-file-operation args)
13       (epg-file-invoke-default-handler operation args))))
14
15 (defun epg-file-invoke-default-handler (operation args)
16   (let ((inhibit-file-name-handlers
17          (cons 'epg-file-handler
18                (and (eq inhibit-file-name-operation operation)
19                     inhibit-file-name-handlers)))
20         (inhibit-file-name-operation operation))
21     (apply operation args)))
22
23 (defun epg-file-write-region (start end filename &optional append visit
24                                     lockname mustbenew)
25   (let* ((visit-file (if (stringp visit)
26                          (expand-file-name visit)
27                        (expand-file-name filename)))
28          ;; XXX: Obtain the value returned by choose_write_coding_system
29          (coding-system (condition-case nil
30                             (epg-file-invoke-default-handler
31                              #'write-region
32                              (list start end "/"))
33                           (file-error last-coding-system-used)))
34          ;; start and end are normally buffer positions
35          ;; specifying the part of the buffer to write.
36          ;; If start is nil, that means to use the entire buffer contents.
37          ;; If start is a string, then output that string to the file
38          ;; instead of any buffer contents; end is ignored.
39          (string (encode-coding-string (cond
40                                         ((stringp start)
41                                          start)
42                                         ((null start)
43                                          (buffer-string))
44                                         (t
45                                          (buffer-substring start end)))
46                                        coding-system)))
47     (with-temp-buffer
48       (set-buffer-multibyte nil)
49       ;; Optional fourth argument append if non-nil means
50       ;;   append to existing file contents (if any).  If it is an integer,
51       ;;   seek to that offset in the file before writing.
52       (if (and append (file-exists-p filename))
53           ;; Enable passphrase cache on this temp buffer
54           (let ((coding-system-for-read 'binary))
55             ;; set visit to t so that passphrase is cached
56             (insert-file-contents filename t)
57             (setq buffer-file-name nil)))
58       ;; Insert data to encrypt
59       (goto-char (if (integerp append) (1+ append) (point-max)))
60       (delete-region (point) (min (+ (point) (length string)) (point-max)))
61       (insert string)
62
63       (let ((coding-system-for-write 'binary)
64             (coding-system-for-read 'binary)
65             (context (epg-make-context))
66             cipher)
67         (when (setq cipher (epg-encrypt-string context (buffer-string) nil))
68           (if (memq system-type '(ms-dos windows-nt))
69               (setq buffer-file-type t))
70           (epg-file-invoke-default-handler
71            #'write-region
72            (list cipher nil filename nil 'not-visit lockname mustbenew)))))
73     ;; Optional fifth argument visit, if t or a string, means
74     ;;   set the last-save-file-modtime of buffer to this file's modtime
75     ;;   and mark buffer not modified.
76     ;; If visit is a string, it is a second file name;
77     ;;   the output goes to filename, but the buffer is marked as visiting visit.
78     ;;   visit is also the file name to lock and unlock for clash detection.
79     ;; If visit is neither t nor nil nor a string,
80     ;;   that means do not display the "Wrote file" message.
81     (when (or (eq visit t) (stringp visit))
82       (setq buffer-file-name filename)
83       (set-visited-file-modtime))
84     (when (stringp visit)
85       (setq buffer-file-name visit))
86     (when (or (eq visit t) (eq visit nil) (stringp visit))
87       (message "Wrote %s" visit-file))
88     (setq last-coding-system-used coding-system)
89     nil))
90
91 (defun epg-file-insert-file-contents (filename &optional visit beg end replace)
92   (barf-if-buffer-read-only)
93
94   ;; If visit is non-nil, beg and end must be nil.
95   (if (and visit (or beg end))
96       (error "Attempt to visit less than an entire file"))
97
98   (let ((expanded-filename (expand-file-name filename))
99         (length 0))
100     (if (file-exists-p expanded-filename)
101         (let* ((local-copy (epg-file-invoke-default-handler
102                             'file-local-copy
103                             (list expanded-filename)))
104                (local-file (or local-copy expanded-filename))
105                (coding-system-for-read 'binary)
106                (context (epg-make-context))
107                string)
108           (unwind-protect
109               (progn
110                 (setq string (epg-decrypt-file context local-file)
111                       length (length string))
112                 (if replace
113                     (goto-char (point-min)))
114                 (save-excursion
115                   (let ((buffer-file-name (if visit nil buffer-file-name)))
116                     (save-restriction
117                       (narrow-to-region (point) (point))
118                       (insert (decode-coding-string string 'undecided)))
119                     (if replace
120                         (delete-region (point) (point-max))))))
121             (when (and local-copy (file-exists-p local-copy))
122               (delete-file local-copy)))))
123     ;; If second argument visit is non-nil, the buffer's visited filename
124     ;; and last save file modtime are set, and it is marked unmodified.
125     (when visit
126       (unlock-buffer)
127       (setq buffer-file-name expanded-filename)
128       (set-visited-file-modtime))
129
130     ;; If visiting and the file does not exist, visiting is completed
131     ;; before the error is signaled.
132     (if (and visit (not (file-exists-p expanded-filename)))
133         (signal 'file-error (list "Opening input file" filename)))
134
135     ;; Returns list of absolute file name and number of characters inserted.
136     (list expanded-filename length)))
137
138 (put 'write-region 'epg-file 'epg-file-write-region)
139 (put 'insert-file-contents 'epg-file 'epg-file-insert-file-contents)
140
141 (unless (assoc epg-file-name-regexp file-name-handler-alist)
142   (setq file-name-handler-alist
143         (cons (cons epg-file-name-regexp 'epg-file-handler)
144               file-name-handler-alist)))
145
146 (unless (assoc epg-file-name-regexp auto-mode-alist)
147   (setq auto-mode-alist
148         (cons (list epg-file-name-regexp nil 'strip-suffix)
149               auto-mode-alist)))