| 1 | ;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*- |
| 2 | ;; Copyright (C) 2006-2014 Free Software Foundation, Inc. |
| 3 | |
| 4 | ;; Author: Daiki Ueno <ueno@unixuser.org> |
| 5 | ;; Keywords: PGP, GnuPG |
| 6 | ;; Package: epa |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs 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 3 of the License, or |
| 13 | ;; (at your option) any later version. |
| 14 | |
| 15 | ;; GNU Emacs 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. |
| 19 | |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 22 | |
| 23 | ;;; Code: |
| 24 | |
| 25 | (require 'epa) |
| 26 | (require 'epa-hook) |
| 27 | |
| 28 | (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil |
| 29 | "If non-nil, cache passphrase for symmetric encryption. |
| 30 | |
| 31 | For security reasons, this option is turned off by default and |
| 32 | not recommended to use. Instead, consider using gpg-agent which |
| 33 | does the same job in a safer way. See Info node `(epa) Caching |
| 34 | Passphrases' for more information. |
| 35 | |
| 36 | Note that this option has no effect if you use GnuPG 2.0." |
| 37 | :type 'boolean |
| 38 | :group 'epa-file) |
| 39 | |
| 40 | (defcustom epa-file-select-keys nil |
| 41 | "Control whether or not to pop up the key selection dialog. |
| 42 | |
| 43 | If t, always asks user to select recipients. |
| 44 | If nil, query user only when `epa-file-encrypt-to' is not set. |
| 45 | If neither t nor nil, doesn't ask user. In this case, symmetric |
| 46 | encryption is used." |
| 47 | :type '(choice (const :tag "Ask always" t) |
| 48 | (const :tag "Ask when recipients are not set" nil) |
| 49 | (const :tag "Don't ask" silent)) |
| 50 | :group 'epa-file) |
| 51 | |
| 52 | (defvar epa-file-passphrase-alist nil) |
| 53 | |
| 54 | (eval-and-compile |
| 55 | (if (fboundp 'encode-coding-string) |
| 56 | (defalias 'epa-file--encode-coding-string 'encode-coding-string) |
| 57 | (defalias 'epa-file--encode-coding-string 'identity))) |
| 58 | |
| 59 | (eval-and-compile |
| 60 | (if (fboundp 'decode-coding-string) |
| 61 | (defalias 'epa-file--decode-coding-string 'decode-coding-string) |
| 62 | (defalias 'epa-file--decode-coding-string 'identity))) |
| 63 | |
| 64 | (defun epa-file-passphrase-callback-function (context key-id file) |
| 65 | (if (and epa-file-cache-passphrase-for-symmetric-encryption |
| 66 | (eq key-id 'SYM)) |
| 67 | (progn |
| 68 | (setq file (file-truename file)) |
| 69 | (let ((entry (assoc file epa-file-passphrase-alist)) |
| 70 | passphrase) |
| 71 | (or (copy-sequence (cdr entry)) |
| 72 | (progn |
| 73 | (unless entry |
| 74 | (setq entry (list file) |
| 75 | epa-file-passphrase-alist |
| 76 | (cons entry |
| 77 | epa-file-passphrase-alist))) |
| 78 | (setq passphrase (epa-passphrase-callback-function context |
| 79 | key-id |
| 80 | file)) |
| 81 | (setcdr entry (copy-sequence passphrase)) |
| 82 | passphrase)))) |
| 83 | (epa-passphrase-callback-function context key-id file))) |
| 84 | |
| 85 | ;;;###autoload |
| 86 | (defun epa-file-handler (operation &rest args) |
| 87 | (save-match-data |
| 88 | (let ((op (get operation 'epa-file))) |
| 89 | (if op |
| 90 | (apply op args) |
| 91 | (epa-file-run-real-handler operation args))))) |
| 92 | |
| 93 | (defun epa-file-run-real-handler (operation args) |
| 94 | (let ((inhibit-file-name-handlers |
| 95 | (cons 'epa-file-handler |
| 96 | (and (eq inhibit-file-name-operation operation) |
| 97 | inhibit-file-name-handlers))) |
| 98 | (inhibit-file-name-operation operation)) |
| 99 | (apply operation args))) |
| 100 | |
| 101 | (defun epa-file-decode-and-insert (string file visit beg end replace) |
| 102 | (if (fboundp 'decode-coding-inserted-region) |
| 103 | (save-restriction |
| 104 | (narrow-to-region (point) (point)) |
| 105 | (insert (if enable-multibyte-characters |
| 106 | (string-to-multibyte string) |
| 107 | string)) |
| 108 | (decode-coding-inserted-region |
| 109 | (point-min) (point-max) |
| 110 | (substring file 0 (string-match epa-file-name-regexp file)) |
| 111 | visit beg end replace)) |
| 112 | (insert (epa-file--decode-coding-string string (or coding-system-for-read |
| 113 | 'undecided))))) |
| 114 | |
| 115 | (defvar epa-file-error nil) |
| 116 | (defun epa-file--find-file-not-found-function () |
| 117 | (let ((error epa-file-error)) |
| 118 | (save-window-excursion |
| 119 | (kill-buffer)) |
| 120 | (signal 'file-error |
| 121 | (cons "Opening input file" (cdr error))))) |
| 122 | |
| 123 | (defvar last-coding-system-used) |
| 124 | (defun epa-file-insert-file-contents (file &optional visit beg end replace) |
| 125 | (barf-if-buffer-read-only) |
| 126 | (if (and visit (or beg end)) |
| 127 | (error "Attempt to visit less than an entire file")) |
| 128 | (setq file (expand-file-name file)) |
| 129 | (let* ((local-copy |
| 130 | (condition-case nil |
| 131 | (epa-file-run-real-handler #'file-local-copy (list file)) |
| 132 | (error))) |
| 133 | (local-file (or local-copy file)) |
| 134 | (context (epg-make-context)) |
| 135 | (buf (current-buffer)) |
| 136 | string length entry) |
| 137 | (if visit |
| 138 | (setq buffer-file-name file)) |
| 139 | (epg-context-set-passphrase-callback |
| 140 | context |
| 141 | (cons #'epa-file-passphrase-callback-function |
| 142 | local-file)) |
| 143 | (epg-context-set-progress-callback |
| 144 | context |
| 145 | (cons #'epa-progress-callback-function |
| 146 | (format "Decrypting %s" file))) |
| 147 | (unwind-protect |
| 148 | (progn |
| 149 | (if replace |
| 150 | (goto-char (point-min))) |
| 151 | (condition-case error |
| 152 | (setq string (epg-decrypt-file context local-file nil)) |
| 153 | (error |
| 154 | (if (setq entry (assoc file epa-file-passphrase-alist)) |
| 155 | (setcdr entry nil)) |
| 156 | ;; Hack to prevent find-file from opening empty buffer |
| 157 | ;; when decryption failed (bug#6568). See the place |
| 158 | ;; where `find-file-not-found-functions' are called in |
| 159 | ;; `find-file-noselect-1'. |
| 160 | (when (file-exists-p local-file) |
| 161 | (setq-local epa-file-error error) |
| 162 | (add-hook 'find-file-not-found-functions |
| 163 | 'epa-file--find-file-not-found-function |
| 164 | nil t)) |
| 165 | (signal 'file-error |
| 166 | (cons "Opening input file" (cdr error))))) |
| 167 | (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! |
| 168 | (setq-local epa-file-encrypt-to |
| 169 | (mapcar #'car (epg-context-result-for |
| 170 | context 'encrypted-to))) |
| 171 | (if (or beg end) |
| 172 | (setq string (substring string (or beg 0) end))) |
| 173 | (save-excursion |
| 174 | ;; If visiting, bind off buffer-file-name so that |
| 175 | ;; file-locking will not ask whether we should |
| 176 | ;; really edit the buffer. |
| 177 | (let ((buffer-file-name |
| 178 | (if visit nil buffer-file-name))) |
| 179 | (save-restriction |
| 180 | (narrow-to-region (point) (point)) |
| 181 | (epa-file-decode-and-insert string file visit beg end replace) |
| 182 | (setq length (- (point-max) (point-min)))) |
| 183 | (if replace |
| 184 | (delete-region (point) (point-max)))) |
| 185 | (if visit |
| 186 | (set-visited-file-modtime)))) |
| 187 | (if (and local-copy |
| 188 | (file-exists-p local-copy)) |
| 189 | (delete-file local-copy))) |
| 190 | (list file length))) |
| 191 | (put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents) |
| 192 | |
| 193 | (defun epa-file-write-region (start end file &optional append visit lockname |
| 194 | mustbenew) |
| 195 | (if append |
| 196 | (error "Can't append to the file")) |
| 197 | (setq file (expand-file-name file)) |
| 198 | (let* ((coding-system (or coding-system-for-write |
| 199 | (if (fboundp 'select-safe-coding-system) |
| 200 | ;; This is needed since Emacs 22 has |
| 201 | ;; no-conversion setting for *.gpg in |
| 202 | ;; `auto-coding-alist'. |
| 203 | (let ((buffer-file-name |
| 204 | (file-name-sans-extension file))) |
| 205 | (select-safe-coding-system |
| 206 | (point-min) (point-max))) |
| 207 | buffer-file-coding-system))) |
| 208 | (context (epg-make-context)) |
| 209 | (coding-system-for-write 'binary) |
| 210 | string entry |
| 211 | (recipients |
| 212 | (cond |
| 213 | ((listp epa-file-encrypt-to) epa-file-encrypt-to) |
| 214 | ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))) |
| 215 | buffer) |
| 216 | (epg-context-set-passphrase-callback |
| 217 | context |
| 218 | (cons #'epa-file-passphrase-callback-function |
| 219 | file)) |
| 220 | (epg-context-set-progress-callback |
| 221 | context |
| 222 | (cons #'epa-progress-callback-function |
| 223 | (format "Encrypting %s" file))) |
| 224 | (epg-context-set-armor context epa-armor) |
| 225 | (condition-case error |
| 226 | (setq string |
| 227 | (epg-encrypt-string |
| 228 | context |
| 229 | (if (stringp start) |
| 230 | (epa-file--encode-coding-string start coding-system) |
| 231 | (unless start |
| 232 | (setq start (point-min) |
| 233 | end (point-max))) |
| 234 | (setq buffer (current-buffer)) |
| 235 | (with-temp-buffer |
| 236 | (insert-buffer-substring buffer start end) |
| 237 | ;; Translate the region according to |
| 238 | ;; `buffer-file-format', as `write-region' would. |
| 239 | ;; We can't simply do `write-region' (into a |
| 240 | ;; temporary file) here, since it writes out |
| 241 | ;; decrypted contents. |
| 242 | (format-encode-buffer (with-current-buffer buffer |
| 243 | buffer-file-format)) |
| 244 | (epa-file--encode-coding-string (buffer-string) |
| 245 | coding-system))) |
| 246 | (if (or (eq epa-file-select-keys t) |
| 247 | (and (null epa-file-select-keys) |
| 248 | (not (local-variable-p 'epa-file-encrypt-to |
| 249 | (current-buffer))))) |
| 250 | (epa-select-keys |
| 251 | context |
| 252 | "Select recipients for encryption. |
| 253 | If no one is selected, symmetric encryption will be performed. " |
| 254 | recipients) |
| 255 | (if epa-file-encrypt-to |
| 256 | (epg-list-keys context recipients))))) |
| 257 | (error |
| 258 | (if (setq entry (assoc file epa-file-passphrase-alist)) |
| 259 | (setcdr entry nil)) |
| 260 | (signal 'file-error (cons "Opening output file" (cdr error))))) |
| 261 | (epa-file-run-real-handler |
| 262 | #'write-region |
| 263 | (list string nil file append visit lockname mustbenew)) |
| 264 | (if (boundp 'last-coding-system-used) |
| 265 | (setq last-coding-system-used coding-system)) |
| 266 | (if (eq visit t) |
| 267 | (progn |
| 268 | (setq buffer-file-name file) |
| 269 | (set-visited-file-modtime)) |
| 270 | (if (stringp visit) |
| 271 | (progn |
| 272 | (set-visited-file-modtime) |
| 273 | (setq buffer-file-name visit)))) |
| 274 | (if (or (eq visit t) |
| 275 | (eq visit nil) |
| 276 | (stringp visit)) |
| 277 | (message "Wrote %s" buffer-file-name)))) |
| 278 | (put 'write-region 'epa-file 'epa-file-write-region) |
| 279 | |
| 280 | (defun epa-file-select-keys () |
| 281 | "Select recipients for encryption." |
| 282 | (interactive) |
| 283 | (setq-local epa-file-encrypt-to |
| 284 | (mapcar |
| 285 | (lambda (key) |
| 286 | (epg-sub-key-id (car (epg-key-sub-key-list key)))) |
| 287 | (epa-select-keys |
| 288 | (epg-make-context) |
| 289 | "Select recipients for encryption. |
| 290 | If no one is selected, symmetric encryption will be performed. ")))) |
| 291 | |
| 292 | ;;;###autoload |
| 293 | (defun epa-file-enable () |
| 294 | (interactive) |
| 295 | (if (memq epa-file-handler file-name-handler-alist) |
| 296 | (message "`epa-file' already enabled") |
| 297 | (setq file-name-handler-alist |
| 298 | (cons epa-file-handler file-name-handler-alist)) |
| 299 | (add-hook 'find-file-hook 'epa-file-find-file-hook) |
| 300 | (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist)) |
| 301 | (message "`epa-file' enabled"))) |
| 302 | |
| 303 | ;;;###autoload |
| 304 | (defun epa-file-disable () |
| 305 | (interactive) |
| 306 | (if (memq epa-file-handler file-name-handler-alist) |
| 307 | (progn |
| 308 | (setq file-name-handler-alist |
| 309 | (delq epa-file-handler file-name-handler-alist)) |
| 310 | (remove-hook 'find-file-hook 'epa-file-find-file-hook) |
| 311 | (setq auto-mode-alist (delq epa-file-auto-mode-alist-entry |
| 312 | auto-mode-alist)) |
| 313 | (message "`epa-file' disabled")) |
| 314 | (message "`epa-file' already disabled"))) |
| 315 | |
| 316 | (provide 'epa-file) |
| 317 | |
| 318 | ;;; epa-file.el ends here |