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