lisp/epa-file.el

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