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 (defun epa-file--file-name-regexp-set (variable value)
  33   (set-default variable value)
  34   (if (fboundp 'epa-file-name-regexp-update)
  35       (epa-file-name-regexp-update)))
  36
  37 (defcustom epa-file-name-regexp "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'"
  38   "Regexp which matches filenames to be encrypted with GnuPG.
  39
  40 If you set this outside Custom while epa-file is already enabled, you
  41 have to call `epa-file-name-regexp-update' after setting it to
  42 properly update file-name-handler-alist.  Setting this through Custom
  43 does that automatically."
  44   :type 'regexp
  45   :group 'epa-file
  46   :set 'epa-file--file-name-regexp-set)
  47
  48 (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
  49   "If non-nil, cache passphrase for symmetric encryption."
  50   :type 'boolean
  51   :group 'epa-file)
  52
  53 (defcustom epa-file-inhibit-auto-save t
  54   "If non-nil, disable auto-saving when opening an encrypted file."
  55   :type 'boolean
  56   :group 'epa-file)
  57
  58 (defvar epa-file-encrypt-to nil
  59   "*Recipient(s) used for encrypting files.
  60 May either be a string or a list of strings.")
  61
  62 ;;;###autoload
  63 (put 'epa-file-encrypt-to 'safe-local-variable
  64      (lambda (val)
  65        (or (stringp val)
  66            (and (listp val)
  67                 (catch 'safe
  68                   (mapc (lambda (elt)
  69                           (unless (stringp elt)
  70                             (throw 'safe nil)))
  71                         val)
  72                   t)))))
  73
  74 ;;;###autoload
  75 (put 'epa-file-encrypt-to 'permanent-local t)
  76
  77 (defvar epa-file-handler
  78   (cons epa-file-name-regexp 'epa-file-handler))
  79
  80 (defvar epa-file-passphrase-alist nil)
  81
  82 (if (fboundp 'encode-coding-string)
  83     (defalias 'epa-file--encode-coding-string 'encode-coding-string)
  84   (defalias 'epa-file--encode-coding-string 'identity))
  85
  86 (if (fboundp 'decode-coding-string)
  87     (defalias 'epa-file--decode-coding-string 'decode-coding-string)
  88   (defalias 'epa-file--decode-coding-string 'identity))
  89
  90 (defun epa-file-name-regexp-update ()
  91   (interactive)
  92   (unless (equal (car epa-file-handler) epa-file-name-regexp)
  93     (setcar epa-file-handler epa-file-name-regexp)))
  94
  95 (defun epa-file-passphrase-callback-function (context key-id file)
  96   (if (and epa-file-cache-passphrase-for-symmetric-encryption
  97            (eq key-id 'SYM))
  98       (let ((entry (assoc file epa-file-passphrase-alist))
  99             passphrase)
 100         (or (copy-sequence (cdr entry))
 101             (progn
 102               (unless entry
 103                 (setq entry (list file)
 104                       epa-file-passphrase-alist (cons entry
 105                                                  epa-file-passphrase-alist)))
 106               (setq passphrase (epa-passphrase-callback-function context
 107                                                                  key-id nil))
 108               (setcdr entry (copy-sequence passphrase))
 109               passphrase)))
 110     (epa-passphrase-callback-function context key-id nil)))
 111
 112 (defun epa-file-handler (operation &rest args)
 113   (save-match-data
 114     (let ((op (get operation 'epa-file)))
 115       (if op
 116           (apply op args)
 117         (epa-file-run-real-handler operation args)))))
 118
 119 (defun epa-file-run-real-handler (operation args)
 120   (let ((inhibit-file-name-handlers
 121          (cons 'epa-file-handler
 122                (and (eq inhibit-file-name-operation operation)
 123                     inhibit-file-name-handlers)))
 124         (inhibit-file-name-operation operation))
 125     (apply operation args)))
 126
 127 (defun epa-file-decode-and-insert (string file visit beg end replace)
 128   (if (fboundp 'decode-coding-inserted-region)
 129       (save-restriction
 130         (narrow-to-region (point) (point))
 131         (let ((multibyte enable-multibyte-characters))
 132           (set-buffer-multibyte nil)
 133           (insert string)
 134           (set-buffer-multibyte multibyte)
 135           (decode-coding-inserted-region
 136            (point-min) (point-max)
 137            (substring file 0 (string-match epa-file-name-regexp file))
 138            visit beg end replace)))
 139     (insert (epa-file--decode-coding-string string (or coding-system-for-read
 140                                                        'undecided)))))
 141
 142 (defvar last-coding-system-used)
 143 (defun epa-file-insert-file-contents (file &optional visit beg end replace)
 144   (barf-if-buffer-read-only)
 145   (if (and visit (or beg end))
 146       (error "Attempt to visit less than an entire file"))
 147   (setq file (expand-file-name file))
 148   (let ((local-copy (epa-file-run-real-handler #'file-local-copy (list file)))
 149         (context (epg-make-context))
 150         string length entry)
 151     (if visit
 152         (setq buffer-file-name file))
 153     (epg-context-set-passphrase-callback
 154      context
 155      (cons #'epa-file-passphrase-callback-function
 156            file))
 157     (epg-context-set-progress-callback context
 158                                        #'epa-progress-callback-function)
 159     (unwind-protect
 160         (progn
 161           (if replace
 162               (goto-char (point-min)))
 163           (condition-case error
 164               (setq string (epg-decrypt-file context file nil))
 165             (error
 166              (if (setq entry (assoc file epa-file-passphrase-alist))
 167                  (setcdr entry nil))
 168              (signal 'file-error
 169                      (cons "Opening input file" (cdr error)))))
 170           (make-local-variable 'epa-file-encrypt-to)
 171           (setq epa-file-encrypt-to
 172                 (mapcar #'car (epg-context-result-for context 'encrypted-to)))
 173           (if (or beg end)
 174               (setq string (substring string (or beg 0) end)))
 175           (save-excursion
 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 (and local-copy
 183                (file-exists-p local-copy))
 184           (delete-file local-copy)))
 185     (list file length)))
 186 (put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
 187
 188 (defun epa-file-write-region (start end file &optional append visit lockname
 189                                     mustbenew)
 190   (if append
 191       (error "Can't append to the file."))
 192   (setq file (expand-file-name file))
 193   (let* ((coding-system (or coding-system-for-write
 194                             (if (fboundp 'select-safe-coding-system)
 195                                 ;; This is needed since Emacs 22 has
 196                                 ;; no-conversion setting for *.gpg in
 197                                 ;; `auto-coding-alist'.
 198                                 (let ((buffer-file-name
 199                                        (file-name-sans-extension file)))
 200                                   (select-safe-coding-system
 201                                    (point-min) (point-max)))
 202                               buffer-file-coding-system)))
 203          (context (epg-make-context))
 204          (coding-system-for-write 'binary)
 205          string entry
 206          (recipients
 207           (cond
 208            ((listp epa-file-encrypt-to) epa-file-encrypt-to)
 209            ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))
 210     (epg-context-set-passphrase-callback
 211      context
 212      (cons #'epa-file-passphrase-callback-function
 213            file))
 214     (epg-context-set-progress-callback context
 215                                        #'epa-progress-callback-function)
 216     (condition-case error
 217         (setq string
 218               (epg-encrypt-string
 219                context
 220                (if (stringp start)
 221                    (epa-file--encode-coding-string start coding-system)
 222                  (epa-file--encode-coding-string (buffer-substring start end)
 223                                                  coding-system))
 224                (if (local-variable-p 'epa-file-encrypt-to)
 225                    (if epa-file-encrypt-to
 226                        (epg-list-keys context recipients))
 227                  (epa-select-keys
 228                   context
 229                   "Select recipents for encryption.
 230 If no one is selected, symmetric encryption will be performed.  "
 231                   recipients))))
 232       (error
 233        (if (setq entry (assoc file epa-file-passphrase-alist))
 234            (setcdr entry nil))
 235        (signal 'file-error (cons "Opening output file" (cdr error)))))
 236     (epa-file-run-real-handler
 237      #'write-region
 238      (list string nil file append visit lockname mustbenew))
 239     (if (boundp 'last-coding-system-used)
 240         (setq last-coding-system-used coding-system))
 241     (if (eq visit t)
 242         (progn
 243           (setq buffer-file-name file)
 244           (set-visited-file-modtime))
 245       (if (stringp visit)
 246           (progn
 247             (set-visited-file-modtime)
 248             (setq buffer-file-name visit))))
 249     (if (or (eq visit t)
 250             (eq visit nil)
 251             (stringp visit))
 252         (message "Wrote %s" buffer-file-name))))
 253 (put 'write-region 'epa-file 'epa-file-write-region)
 254
 255 (defun epa-file-find-file-hook ()
 256   (if (and buffer-file-name
 257            (string-match epa-file-name-regexp buffer-file-name)
 258            epa-file-inhibit-auto-save)
 259       (auto-save-mode 0)))
 260
 261 ;;;###autoload
 262 (defun epa-file-enable ()
 263   (interactive)
 264   (if (memq epa-file-handler file-name-handler-alist)
 265       (message "`epa-file' already enabled")
 266     (setq file-name-handler-alist
 267           (cons epa-file-handler file-name-handler-alist))
 268     (add-hook 'find-file-hooks 'epa-file-find-file-hook)
 269     (message "`epa-file' enabled")))
 270
 271 ;;;###autoload
 272 (defun epa-file-disable ()
 273   (interactive)
 274   (if (memq epa-file-handler file-name-handler-alist)
 275       (progn
 276         (setq file-name-handler-alist
 277               (delq epa-file-handler file-name-handler-alist))
 278         (remove-hook 'find-file-hooks 'epa-file-find-file-hook)
 279         (message "`epa-file' disabled"))
 280     (message "`epa-file' already disabled")))
 281
 282 (provide 'epa-file)
 283
 284 ;;; epa-file.el ends here