epa-file.el

   1 ;;; epa-file.el --- the EasyPG Assistant, transparent file encryption
   2 ;; Copyright (C) 2006 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: PGP, GnuPG
   6
   7 ;; This file is part of EasyPG.
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Code:
  25
  26 (require 'epa)
  27
  28 (defgroup epa-file nil
  29   "The EasyPG Assistant hooks for transparent file encryption"
  30   :group 'epa)
  31
  32 (defcustom epa-file-name-regexp "\\.gpg\\'"
  33   "Regexp which matches filenames to be encrypted with GnuPG."
  34   :type 'regexp
  35   :group 'epa-file)
  36
  37 (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
  38   "If non-nil, cache passphrase for symmetric encryption."
  39   :type 'boolean
  40   :group 'epa-file)
  41
  42 (defcustom epa-file-inhibit-auto-save t
  43   "If non-nil, disable auto-saving when opening an encrypted file."
  44   :type 'boolean
  45   :group 'epa-file)
  46
  47 (defvar epa-file-encrypt-to nil
  48   "*Recipient(s) used for encrypting files.
  49 May either be a string or a list of strings.")
  50
  51 ;;;###autoload
  52 (put 'epa-file-encrypt-to 'safe-local-variable
  53      (lambda (val)
  54        (or (stringp val)
  55            (and (listp val)
  56                 (catch 'safe
  57                   (mapc (lambda (elt)
  58                           (unless (stringp elt)
  59                             (throw 'safe nil)))
  60                         val)
  61                   t)))))
  62
  63 (defvar epa-file-handler
  64   (cons epa-file-name-regexp 'epa-file-handler))
  65
  66 (defvar epa-file-passphrase-alist nil)
  67
  68 (if (fboundp 'encode-coding-string)
  69     (defalias 'epa-file--encode-coding-string 'encode-coding-string)
  70   (defalias 'epa-file--encode-coding-string 'identity))
  71
  72 (if (fboundp 'decode-coding-string)
  73     (defalias 'epa-file--decode-coding-string 'decode-coding-string)
  74   (defalias 'epa-file--decode-coding-string 'identity))
  75
  76 (defun epa-file-passphrase-callback-function (context key-id file)
  77   (if (and epa-file-cache-passphrase-for-symmetric-encryption
  78            (eq key-id 'SYM))
  79       (let ((entry (assoc file epa-file-passphrase-alist))
  80             passphrase)
  81         (or (copy-sequence (cdr entry))
  82             (progn
  83               (unless entry
  84                 (setq entry (list file)
  85                       epa-file-passphrase-alist (cons entry
  86                                                  epa-file-passphrase-alist)))
  87               (setq passphrase (epa-passphrase-callback-function context
  88                                                                  key-id nil))
  89               (setcdr entry (copy-sequence passphrase))
  90               passphrase)))
  91     (epa-passphrase-callback-function context key-id nil)))
  92
  93 (defun epa-file-handler (operation &rest args)
  94   (save-match-data
  95     (let ((op (get operation 'epa-file)))
  96       (if op
  97           (apply op args)
  98         (epa-file-run-real-handler operation args)))))
  99
 100 (defun epa-file-run-real-handler (operation args)
 101   (let ((inhibit-file-name-handlers
 102          (cons 'epa-file-handler
 103                (and (eq inhibit-file-name-operation operation)
 104                     inhibit-file-name-handlers)))
 105         (inhibit-file-name-operation operation))
 106     (apply operation args)))
 107
 108 (defun epa-file-decode-and-insert (string file visit beg end replace)
 109   (if (fboundp 'decode-coding-inserted-region)
 110       (save-restriction
 111         (narrow-to-region (point) (point))
 112         (let ((multibyte enable-multibyte-characters))
 113           (set-buffer-multibyte nil)
 114           (insert string)
 115           (set-buffer-multibyte multibyte)
 116           (decode-coding-inserted-region
 117            (point-min) (point-max)
 118            (substring file 0 (string-match epa-file-name-regexp file))
 119            visit beg end replace)))
 120     (insert (epa-file--decode-coding-string string (or coding-system-for-read
 121                                                        'undecided)))))
 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 (epa-file-run-real-handler #'file-local-copy (list file)))
 130         (context (epg-make-context))
 131         string length entry)
 132     (if visit
 133         (setq buffer-file-name file))
 134     (epg-context-set-passphrase-callback
 135      context
 136      (cons #'epa-file-passphrase-callback-function
 137            file))
 138     (epg-context-set-progress-callback context
 139                                        #'epa-progress-callback-function)
 140     (unwind-protect
 141         (progn
 142           (if replace
 143               (goto-char (point-min)))
 144           (condition-case error
 145               (setq string (epg-decrypt-file context file nil))
 146             (error
 147              (if (setq entry (assoc file epa-file-passphrase-alist))
 148                  (setcdr entry nil))
 149              (signal 'file-error
 150                      (cons "Opening input file" (cdr error)))))
 151           (if (or beg end)
 152               (setq string (substring string (or beg 0) end)))
 153           (save-excursion
 154             (save-restriction
 155               (narrow-to-region (point) (point))
 156               (epa-file-decode-and-insert string file visit beg end replace)
 157               (setq length (- (point-max) (point-min))))
 158             (if replace
 159                 (delete-region (point) (point-max)))))
 160       (if (and local-copy
 161                (file-exists-p local-copy))
 162           (delete-file local-copy)))
 163     (list file length)))
 164 (put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
 165
 166 (defun epa-file-write-region (start end file &optional append visit lockname
 167                                     mustbenew)
 168   (if append
 169       (error "Can't append to the file."))
 170   (setq file (expand-file-name file))
 171   (let* ((coding-system (or coding-system-for-write
 172                             (if (fboundp 'select-safe-coding-system)
 173                                 ;; This is needed since Emacs 22 has
 174                                 ;; no-conversion setting for *.gpg in
 175                                 ;; `auto-coding-alist'.
 176                                 (let ((buffer-file-name
 177                                        (file-name-sans-extension file)))
 178                                   (select-safe-coding-system
 179                                    (point-min) (point-max)))
 180                               buffer-file-coding-system)))
 181          (context (epg-make-context))
 182          (coding-system-for-write 'binary)
 183          string entry)
 184     (epg-context-set-passphrase-callback
 185      context
 186      (cons #'epa-file-passphrase-callback-function
 187            file))
 188     (epg-context-set-progress-callback context
 189                                        #'epa-progress-callback-function)
 190     (condition-case error
 191         (setq string
 192               (epg-encrypt-string
 193                context
 194                (if (stringp start)
 195                    (epa-file--encode-coding-string start coding-system)
 196                  (epa-file--encode-coding-string (buffer-substring start end)
 197                                                  coding-system))
 198                (unless (assoc file epa-file-passphrase-alist)
 199                  (epa-select-keys
 200                   context
 201                   "Select recipents for encryption.
 202 If no one is selected, symmetric encryption will be performed.  "
 203                   (cond
 204                    ((listp epa-file-encrypt-to) epa-file-encrypt-to)
 205                    ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))))
 206       (error
 207        (if (setq entry (assoc file epa-file-passphrase-alist))
 208            (setcdr entry nil))
 209        (signal 'file-error (cons "Opening output file" (cdr error)))))
 210     (epa-file-run-real-handler
 211      #'write-region
 212      (list string nil file append visit lockname mustbenew))
 213     (if (boundp 'last-coding-system-used)
 214         (setq last-coding-system-used coding-system))
 215     (if (eq visit t)
 216         (progn
 217           (setq buffer-file-name file)
 218           (set-visited-file-modtime))
 219       (if (stringp visit)
 220           (progn
 221             (set-visited-file-modtime)
 222             (setq buffer-file-name visit))))
 223     (if (or (eq visit t)
 224             (eq visit nil)
 225             (stringp visit))
 226         (message "Wrote %s" buffer-file-name))))
 227 (put 'write-region 'epa-file 'epa-file-write-region)
 228
 229 (defun epa-file-find-file-hook ()
 230   (if (and buffer-file-name
 231            (string-match epa-file-name-regexp buffer-file-name)
 232            epa-file-inhibit-auto-save)
 233       (auto-save-mode 0)))
 234
 235 ;;;###autoload
 236 (defun epa-file-enable ()
 237   (interactive)
 238   (if (memq epa-file-handler file-name-handler-alist)
 239       (message "`epa-file' already enabled")
 240     (setq file-name-handler-alist
 241           (cons epa-file-handler file-name-handler-alist))
 242     (add-hook 'find-file-hooks 'epa-file-find-file-hook)
 243     (message "`epa-file' enabled")))
 244
 245 ;;;###autoload
 246 (defun epa-file-disable ()
 247   (interactive)
 248   (if (memq epa-file-handler file-name-handler-alist)
 249       (progn
 250         (setq file-name-handler-alist
 251               (delq epa-file-handler file-name-handler-alist))
 252         (remove-hook 'find-file-hooks 'epa-file-find-file-hook)
 253         (message "`epa-file' disabled"))
 254     (message "`epa-file' already disabled")))
 255
 256 (provide 'epa-file)
 257
 258 ;;; epa-file.el ends here