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