lisp/epa-file.el

   1 ;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*-
   2 ;; Copyright (C) 2006-2017 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 (defvar epa-inhibit nil
  86   "Non-nil means don't try to decrypt .gpg files when operating on them.")
  87
  88 ;;;###autoload
  89 (defun epa-file-handler (operation &rest args)
  90   (save-match-data
  91     (let ((op (get operation 'epa-file)))
  92       (if (and op (not epa-inhibit))
  93           (apply op args)
  94         (epa-file-run-real-handler operation args)))))
  95
  96 (defun epa-file-run-real-handler (operation args)
  97   (let ((inhibit-file-name-handlers
  98          (cons 'epa-file-handler
  99                (and (eq inhibit-file-name-operation operation)
 100                     inhibit-file-name-handlers)))
 101         (inhibit-file-name-operation operation))
 102     (apply operation args)))
 103
 104 (defun epa-file-decode-and-insert (string file visit beg end replace)
 105   (if (fboundp 'decode-coding-inserted-region)
 106       (save-restriction
 107         (narrow-to-region (point) (point))
 108         (insert (if enable-multibyte-characters
 109                     (string-to-multibyte string)
 110                   string))
 111         (decode-coding-inserted-region
 112          (point-min) (point-max)
 113          (substring file 0 (string-match epa-file-name-regexp file))
 114          visit beg end replace))
 115     (insert (epa-file--decode-coding-string string (or coding-system-for-read
 116                                                        'undecided)))))
 117
 118 (defvar epa-file-error nil)
 119 (defun epa-file--find-file-not-found-function ()
 120   (let ((error epa-file-error))
 121     (save-window-excursion
 122       (kill-buffer))
 123     (signal 'file-missing
 124             (cons "Opening input file" (cdr error)))))
 125
 126 (defvar last-coding-system-used)
 127 (defun epa-file-insert-file-contents (file &optional visit beg end replace)
 128   (barf-if-buffer-read-only)
 129   (if (and visit (or beg end))
 130       (error "Attempt to visit less than an entire file"))
 131   (setq file (expand-file-name file))
 132   (let* ((local-copy
 133           (condition-case nil
 134               (epa-file-run-real-handler #'file-local-copy (list file))
 135             (error)))
 136          (local-file (or local-copy file))
 137          (context (epg-make-context))
 138          (buf (current-buffer))
 139          string length entry)
 140     (if visit
 141         (setq buffer-file-name file))
 142     (epg-context-set-passphrase-callback
 143      context
 144      (cons #'epa-file-passphrase-callback-function
 145            local-file))
 146     (epg-context-set-progress-callback
 147      context
 148      (cons #'epa-progress-callback-function
 149            (format "Decrypting %s" file)))
 150     (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
 151     (unwind-protect
 152         (progn
 153           (if replace
 154               (goto-char (point-min)))
 155           (condition-case error
 156               (setq string (epg-decrypt-file context local-file nil))
 157             (error
 158              (if (setq entry (assoc file epa-file-passphrase-alist))
 159                  (setcdr entry nil))
 160              ;; If the decryption program can't be found,
 161              ;; signal that as a non-file error
 162              ;; so that find-file-noselect-1 won't handle it.
 163              ;; Borrowed from jka-compr.el.
 164              (if (and (memq 'file-error (get (car error) 'error-conditions))
 165                       (equal (cadr error) "Searching for program"))
 166                  (error "Decryption program `%s' not found"
 167                         (nth 3 error)))
 168              (let ((exists (file-exists-p local-file)))
 169                (when exists
 170                  ;; Hack to prevent find-file from opening empty buffer
 171                  ;; when decryption failed (bug#6568).  See the place
 172                  ;; where `find-file-not-found-functions' are called in
 173                  ;; `find-file-noselect-1'.
 174                  (setq-local epa-file-error error)
 175                  (add-hook 'find-file-not-found-functions
 176                            'epa-file--find-file-not-found-function
 177                            nil t)
 178                  (epa-display-error context))
 179                (signal (if exists 'file-error 'file-missing)
 180                        (cons "Opening input file" (cdr error))))))
 181           (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
 182           (setq-local epa-file-encrypt-to
 183                       (mapcar #'car (epg-context-result-for
 184                                      context 'encrypted-to)))
 185           (if (or beg end)
 186               (setq string (substring string (or beg 0) end)))
 187           (save-excursion
 188             ;; If visiting, bind off buffer-file-name so that
 189             ;; file-locking will not ask whether we should
 190             ;; really edit the buffer.
 191             (let ((buffer-file-name
 192                    (if visit nil buffer-file-name)))
 193               (save-restriction
 194                 (narrow-to-region (point) (point))
 195                 (epa-file-decode-and-insert string file visit beg end replace)
 196                 (setq length (- (point-max) (point-min))))
 197               (if replace
 198                   (delete-region (point) (point-max))))
 199             (if visit
 200                 (set-visited-file-modtime))))
 201       (if (and local-copy
 202                (file-exists-p local-copy))
 203           (delete-file local-copy)))
 204     (list file length)))
 205 (put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
 206
 207 (defun epa-file-write-region (start end file &optional append visit lockname
 208                                     mustbenew)
 209   (if append
 210       (error "Can't append to the file"))
 211   (setq file (expand-file-name file))
 212   (let* ((coding-system (or coding-system-for-write
 213                             (if (fboundp 'select-safe-coding-system)
 214                                 ;; This is needed since Emacs 22 has
 215                                 ;; no-conversion setting for *.gpg in
 216                                 ;; `auto-coding-alist'.
 217                                 (let ((buffer-file-name
 218                                        (file-name-sans-extension file)))
 219                                   (select-safe-coding-system
 220                                    (point-min) (point-max)))
 221                               buffer-file-coding-system)))
 222          (context (epg-make-context))
 223          (coding-system-for-write 'binary)
 224          string entry
 225          (recipients
 226           (cond
 227            ((listp epa-file-encrypt-to) epa-file-encrypt-to)
 228            ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to))))
 229          buffer)
 230     (epg-context-set-passphrase-callback
 231      context
 232      (cons #'epa-file-passphrase-callback-function
 233            file))
 234     (epg-context-set-progress-callback
 235      context
 236      (cons #'epa-progress-callback-function
 237            (format "Encrypting %s" file)))
 238     (setf (epg-context-armor context) epa-armor)
 239     (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
 240     (condition-case error
 241         (setq string
 242               (epg-encrypt-string
 243                context
 244                (if (stringp start)
 245                    (epa-file--encode-coding-string start coding-system)
 246                  (unless start
 247                    (setq start (point-min)
 248                          end (point-max)))
 249                  (setq buffer (current-buffer))
 250                  (with-temp-buffer
 251                    (insert-buffer-substring buffer start end)
 252                    ;; Translate the region according to
 253                    ;; `buffer-file-format', as `write-region' would.
 254                    ;; We can't simply do `write-region' (into a
 255                    ;; temporary file) here, since it writes out
 256                    ;; decrypted contents.
 257                    (format-encode-buffer (with-current-buffer buffer
 258                                            buffer-file-format))
 259                    (epa-file--encode-coding-string (buffer-string)
 260                                                    coding-system)))
 261                (if (or (eq epa-file-select-keys t)
 262                        (and (null epa-file-select-keys)
 263                             (not (local-variable-p 'epa-file-encrypt-to
 264                                                    (current-buffer)))))
 265                    (epa-select-keys
 266                     context
 267                     "Select recipients for encryption.
 268 If no one is selected, symmetric encryption will be performed.  "
 269                     recipients)
 270                  (if epa-file-encrypt-to
 271                      (epg-list-keys context recipients)))))
 272       (error
 273        (epa-display-error context)
 274        (if (setq entry (assoc file epa-file-passphrase-alist))
 275            (setcdr entry nil))
 276        (signal 'file-error (cons "Opening output file" (cdr error)))))
 277     (epa-file-run-real-handler
 278      #'write-region
 279      (list string nil file append visit lockname mustbenew))
 280     (if (boundp 'last-coding-system-used)
 281         (setq last-coding-system-used coding-system))
 282     (if (eq visit t)
 283         (progn
 284           (setq buffer-file-name file)
 285           (set-visited-file-modtime))
 286       (if (stringp visit)
 287           (progn
 288             (set-visited-file-modtime)
 289             (setq buffer-file-name visit))))
 290     (if (or (eq visit t)
 291             (eq visit nil)
 292             (stringp visit))
 293         (message "Wrote %s" buffer-file-name))))
 294 (put 'write-region 'epa-file 'epa-file-write-region)
 295
 296 (defun epa-file-select-keys ()
 297   "Select recipients for encryption."
 298   (interactive)
 299   (setq-local epa-file-encrypt-to
 300               (mapcar
 301                (lambda (key)
 302                  (epg-sub-key-id (car (epg-key-sub-key-list key))))
 303                (epa-select-keys
 304                 (epg-make-context)
 305                 "Select recipients for encryption.
 306 If no one is selected, symmetric encryption will be performed.  "))))
 307
 308 ;;;###autoload
 309 (defun epa-file-enable ()
 310   (interactive)
 311   (if (memq epa-file-handler file-name-handler-alist)
 312       (message "`epa-file' already enabled")
 313     (setq file-name-handler-alist
 314           (cons epa-file-handler file-name-handler-alist))
 315     (add-hook 'find-file-hook 'epa-file-find-file-hook)
 316     (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist))
 317     (message "`epa-file' enabled")))
 318
 319 ;;;###autoload
 320 (defun epa-file-disable ()
 321   (interactive)
 322   (if (memq epa-file-handler file-name-handler-alist)
 323       (progn
 324         (setq file-name-handler-alist
 325               (delq epa-file-handler file-name-handler-alist))
 326         (remove-hook 'find-file-hook 'epa-file-find-file-hook)
 327         (setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
 328                                     auto-mode-alist))
 329         (message "`epa-file' disabled"))
 330     (message "`epa-file' already disabled")))
 331
 332 (provide 'epa-file)
 333
 334 ;;; epa-file.el ends here