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