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