code.delx.au - gnu-emacs/blob - lisp/epa-file.el

   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     (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
 148     (unwind-protect
 149         (progn
 150           (if replace
 151               (goto-char (point-min)))
 152           (condition-case error
 153               (setq string (epg-decrypt-file context local-file nil))
 154             (error
 155              (if (setq entry (assoc file epa-file-passphrase-alist))
 156                  (setcdr entry nil))
 157              ;; If the decryption program can't be found,
 158              ;; signal that as a non-file error
 159              ;; so that find-file-noselect-1 won't handle it.
 160              ;; Borrowed from jka-compr.el.
 161              (if (and (eq (car error) 'file-error)
 162                       (equal (cadr error) "Searching for program"))
 163                  (error "Decryption program `%s' not found"
 164                         (nth 3 error)))
 165              (when (file-exists-p local-file)
 166                ;; Hack to prevent find-file from opening empty buffer
 167                ;; when decryption failed (bug#6568).  See the place
 168                ;; where `find-file-not-found-functions' are called in
 169                ;; `find-file-noselect-1'.
 170                (setq-local epa-file-error error)
 171                (add-hook 'find-file-not-found-functions
 172                          'epa-file--find-file-not-found-function
 173                          nil t)
 174                (epa-display-error context))
 175              (signal 'file-error
 176                      (cons "Opening input file" (cdr error)))))
 177           (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
 178           (setq-local epa-file-encrypt-to
 179                       (mapcar #'car (epg-context-result-for
 180                                      context 'encrypted-to)))
 181           (if (or beg end)
 182               (setq string (substring string (or beg 0) end)))
 183           (save-excursion
 184             ;; If visiting, bind off buffer-file-name so that
 185             ;; file-locking will not ask whether we should
 186             ;; really edit the buffer.
 187             (let ((buffer-file-name
 188                    (if visit nil buffer-file-name)))
 189               (save-restriction
 190                 (narrow-to-region (point) (point))
 191                 (epa-file-decode-and-insert string file visit beg end replace)
 192                 (setq length (- (point-max) (point-min))))
 193               (if replace
 194                   (delete-region (point) (point-max))))
 195             (if visit
 196                 (set-visited-file-modtime))))
 197       (if (and local-copy
 198                (file-exists-p local-copy))
 199           (delete-file local-copy)))
 200     (list file length)))
 201 (put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
 202
 203 (defun epa-file-write-region (start end file &optional append visit lockname
 204                                     mustbenew)
 205   (if append
 206       (error "Can't append to the file"))
 207   (setq file (expand-file-name file))
 208   (let* ((coding-system (or coding-system-for-write
 209                             (if (fboundp 'select-safe-coding-system)
 210                                 ;; This is needed since Emacs 22 has
 211                                 ;; no-conversion setting for *.gpg in
 212                                 ;; `auto-coding-alist'.
 213                                 (let ((buffer-file-name
 214                                        (file-name-sans-extension file)))
 215                                   (select-safe-coding-system
 216                                    (point-min) (point-max)))
 217                               buffer-file-coding-system)))
 218          (context (epg-make-context))
 219          (coding-system-for-write 'binary)
 220          string entry
 221          (recipients
 222           (cond
 223            ((listp epa-file-encrypt-to) epa-file-encrypt-to)
 224            ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to))))
 225          buffer)
 226     (epg-context-set-passphrase-callback
 227      context
 228      (cons #'epa-file-passphrase-callback-function
 229            file))
 230     (epg-context-set-progress-callback
 231      context
 232      (cons #'epa-progress-callback-function
 233            (format "Encrypting %s" file)))
 234     (setf (epg-context-armor context) epa-armor)
 235     (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
 236     (condition-case error
 237         (setq string
 238               (epg-encrypt-string
 239                context
 240                (if (stringp start)
 241                    (epa-file--encode-coding-string start coding-system)
 242                  (unless start
 243                    (setq start (point-min)
 244                          end (point-max)))
 245                  (setq buffer (current-buffer))
 246                  (with-temp-buffer
 247                    (insert-buffer-substring buffer start end)
 248                    ;; Translate the region according to
 249                    ;; `buffer-file-format', as `write-region' would.
 250                    ;; We can't simply do `write-region' (into a
 251                    ;; temporary file) here, since it writes out
 252                    ;; decrypted contents.
 253                    (format-encode-buffer (with-current-buffer buffer
 254                                            buffer-file-format))
 255                    (epa-file--encode-coding-string (buffer-string)
 256                                                    coding-system)))
 257                (if (or (eq epa-file-select-keys t)
 258                        (and (null epa-file-select-keys)
 259                             (not (local-variable-p 'epa-file-encrypt-to
 260                                                    (current-buffer)))))
 261                    (epa-select-keys
 262                     context
 263                     "Select recipients for encryption.
 264 If no one is selected, symmetric encryption will be performed.  "
 265                     recipients)
 266                  (if epa-file-encrypt-to
 267                      (epg-list-keys context recipients)))))
 268       (error
 269        (epa-display-error context)
 270        (if (setq entry (assoc file epa-file-passphrase-alist))
 271            (setcdr entry nil))
 272        (signal 'file-error (cons "Opening output file" (cdr error)))))
 273     (epa-file-run-real-handler
 274      #'write-region
 275      (list string nil file append visit lockname mustbenew))
 276     (if (boundp 'last-coding-system-used)
 277         (setq last-coding-system-used coding-system))
 278     (if (eq visit t)
 279         (progn
 280           (setq buffer-file-name file)
 281           (set-visited-file-modtime))
 282       (if (stringp visit)
 283           (progn
 284             (set-visited-file-modtime)
 285             (setq buffer-file-name visit))))
 286     (if (or (eq visit t)
 287             (eq visit nil)
 288             (stringp visit))
 289         (message "Wrote %s" buffer-file-name))))
 290 (put 'write-region 'epa-file 'epa-file-write-region)
 291
 292 (defun epa-file-select-keys ()
 293   "Select recipients for encryption."
 294   (interactive)
 295   (setq-local epa-file-encrypt-to
 296               (mapcar
 297                (lambda (key)
 298                  (epg-sub-key-id (car (epg-key-sub-key-list key))))
 299                (epa-select-keys
 300                 (epg-make-context)
 301                 "Select recipients for encryption.
 302 If no one is selected, symmetric encryption will be performed.  "))))
 303
 304 ;;;###autoload
 305 (defun epa-file-enable ()
 306   (interactive)
 307   (if (memq epa-file-handler file-name-handler-alist)
 308       (message "`epa-file' already enabled")
 309     (setq file-name-handler-alist
 310           (cons epa-file-handler file-name-handler-alist))
 311     (add-hook 'find-file-hook 'epa-file-find-file-hook)
 312     (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist))
 313     (message "`epa-file' enabled")))
 314
 315 ;;;###autoload
 316 (defun epa-file-disable ()
 317   (interactive)
 318   (if (memq epa-file-handler file-name-handler-alist)
 319       (progn
 320         (setq file-name-handler-alist
 321               (delq epa-file-handler file-name-handler-alist))
 322         (remove-hook 'find-file-hook 'epa-file-find-file-hook)
 323         (setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
 324                                     auto-mode-alist))
 325         (message "`epa-file' disabled"))
 326     (message "`epa-file' already disabled")))
 327
 328 (provide 'epa-file)
 329
 330 ;;; epa-file.el ends here