lisp/epa-file.el

   1 ;;; epa-file.el --- the EasyPG Assistant, transparent file encryption
   2 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: PGP, GnuPG
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs 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 3, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs 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   :version "23.1"
  31   :group 'epa)
  32
  33 (defun epa-file--file-name-regexp-set (variable value)
  34   (set-default variable value)
  35   (if (fboundp 'epa-file-name-regexp-update)
  36       (epa-file-name-regexp-update)))
  37
  38 (defcustom epa-file-name-regexp "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'"
  39   "Regexp which matches filenames to be encrypted with GnuPG.
  40
  41 If you set this outside Custom while epa-file is already enabled, you
  42 have to call `epa-file-name-regexp-update' after setting it to
  43 properly update file-name-handler-alist.  Setting this through Custom
  44 does that automatically."
  45   :type 'regexp
  46   :group 'epa-file
  47   :set 'epa-file--file-name-regexp-set)
  48
  49 (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
  50   "If non-nil, cache passphrase for symmetric encryption."
  51   :type 'boolean
  52   :group 'epa-file)
  53
  54 (defcustom epa-file-inhibit-auto-save t
  55   "If non-nil, disable auto-saving when opening an encrypted file."
  56   :type 'boolean
  57   :group 'epa-file)
  58
  59 (defcustom epa-file-select-keys nil
  60   "If non-nil, always asks user to select recipients."
  61   :type 'boolean
  62   :group 'epa-file)
  63
  64 (defvar epa-file-encrypt-to nil
  65   "*Recipient(s) used for encrypting files.
  66 May either be a string or a list of strings.")
  67
  68 ;;;###autoload
  69 (put 'epa-file-encrypt-to 'safe-local-variable
  70      (lambda (val)
  71        (or (stringp val)
  72            (and (listp val)
  73                 (catch 'safe
  74                   (mapc (lambda (elt)
  75                           (unless (stringp elt)
  76                             (throw 'safe nil)))
  77                         val)
  78                   t)))))
  79
  80 ;;;###autoload
  81 (put 'epa-file-encrypt-to 'permanent-local t)
  82
  83 (defvar epa-file-handler
  84   (cons epa-file-name-regexp 'epa-file-handler))
  85
  86 (defvar epa-file-auto-mode-alist-entry
  87   (list epa-file-name-regexp nil 'epa-file))
  88
  89 (defvar epa-file-passphrase-alist nil)
  90
  91 (eval-and-compile
  92   (if (fboundp 'encode-coding-string)
  93       (defalias 'epa-file--encode-coding-string 'encode-coding-string)
  94     (defalias 'epa-file--encode-coding-string 'identity)))
  95
  96 (eval-and-compile
  97   (if (fboundp 'decode-coding-string)
  98       (defalias 'epa-file--decode-coding-string 'decode-coding-string)
  99     (defalias 'epa-file--decode-coding-string 'identity)))
 100
 101 (defun epa-file-name-regexp-update ()
 102   (interactive)
 103   (unless (equal (car epa-file-handler) epa-file-name-regexp)
 104     (setcar epa-file-handler epa-file-name-regexp)))
 105
 106 (defun epa-file-passphrase-callback-function (context key-id file)
 107   (if (and epa-file-cache-passphrase-for-symmetric-encryption
 108            (eq key-id 'SYM))
 109       (progn
 110         (setq file (file-truename file))
 111         (let ((entry (assoc file epa-file-passphrase-alist))
 112               passphrase)
 113           (or (copy-sequence (cdr entry))
 114               (progn
 115                 (unless entry
 116                   (setq entry (list file)
 117                         epa-file-passphrase-alist
 118                         (cons entry
 119                               epa-file-passphrase-alist)))
 120                 (setq passphrase (epa-passphrase-callback-function context
 121                                                                    key-id nil))
 122                 (setcdr entry (copy-sequence passphrase))
 123                 passphrase))))
 124     (epa-passphrase-callback-function context key-id nil)))
 125
 126 (defun epa-file-handler (operation &rest args)
 127   (save-match-data
 128     (let ((op (get operation 'epa-file)))
 129       (if op
 130           (apply op args)
 131         (epa-file-run-real-handler operation args)))))
 132
 133 (defun epa-file-run-real-handler (operation args)
 134   (let ((inhibit-file-name-handlers
 135          (cons 'epa-file-handler
 136                (and (eq inhibit-file-name-operation operation)
 137                     inhibit-file-name-handlers)))
 138         (inhibit-file-name-operation operation))
 139     (apply operation args)))
 140
 141 (defun epa-file-decode-and-insert (string file visit beg end replace)
 142   (if (fboundp 'decode-coding-inserted-region)
 143       (save-restriction
 144         (narrow-to-region (point) (point))
 145         (let ((multibyte enable-multibyte-characters))
 146           (set-buffer-multibyte nil)
 147           (insert string)
 148           (set-buffer-multibyte multibyte)
 149           (decode-coding-inserted-region
 150            (point-min) (point-max)
 151            (substring file 0 (string-match epa-file-name-regexp file))
 152            visit beg end replace)))
 153     (insert (epa-file--decode-coding-string string (or coding-system-for-read
 154                                                        'undecided)))))
 155
 156 (defvar last-coding-system-used)
 157 (defun epa-file-insert-file-contents (file &optional visit beg end replace)
 158   (barf-if-buffer-read-only)
 159   (if (and visit (or beg end))
 160       (error "Attempt to visit less than an entire file"))
 161   (setq file (expand-file-name file))
 162   (let* ((local-copy
 163           (condition-case inl
 164               (epa-file-run-real-handler #'file-local-copy (list file))
 165             (error)))
 166          (local-file (or local-copy file))
 167          (context (epg-make-context))
 168          string length entry)
 169     (if visit
 170         (setq buffer-file-name file))
 171     (epg-context-set-passphrase-callback
 172      context
 173      (cons #'epa-file-passphrase-callback-function
 174            local-file))
 175     (epg-context-set-progress-callback context
 176                                        #'epa-progress-callback-function)
 177     (unwind-protect
 178         (progn
 179           (if replace
 180               (goto-char (point-min)))
 181           (condition-case error
 182               (setq string (epg-decrypt-file context local-file nil))
 183             (error
 184              (if (setq entry (assoc file epa-file-passphrase-alist))
 185                  (setcdr entry nil))
 186              (signal 'file-error
 187                      (cons "Opening input file" (cdr error)))))
 188           (make-local-variable 'epa-file-encrypt-to)
 189           (setq epa-file-encrypt-to
 190                 (mapcar #'car (epg-context-result-for context 'encrypted-to)))
 191           (if (or beg end)
 192               (setq string (substring string (or beg 0) end)))
 193           (save-excursion
 194             (save-restriction
 195               (narrow-to-region (point) (point))
 196               (epa-file-decode-and-insert string file visit beg end replace)
 197               (setq length (- (point-max) (point-min))))
 198             (if replace
 199                 (delete-region (point) (point-max)))))
 200       (if (and local-copy
 201                (file-exists-p local-copy))
 202           (delete-file local-copy)))
 203     (list file length)))
 204 (put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
 205
 206 (defun epa-file-write-region (start end file &optional append visit lockname
 207                                     mustbenew)
 208   (if append
 209       (error "Can't append to the file."))
 210   (setq file (expand-file-name file))
 211   (let* ((coding-system (or coding-system-for-write
 212                             (if (fboundp 'select-safe-coding-system)
 213                                 ;; This is needed since Emacs 22 has
 214                                 ;; no-conversion setting for *.gpg in
 215                                 ;; `auto-coding-alist'.
 216                                 (let ((buffer-file-name
 217                                        (file-name-sans-extension file)))
 218                                   (select-safe-coding-system
 219                                    (point-min) (point-max)))
 220                               buffer-file-coding-system)))
 221          (context (epg-make-context))
 222          (coding-system-for-write 'binary)
 223          string entry
 224          (recipients
 225           (cond
 226            ((listp epa-file-encrypt-to) epa-file-encrypt-to)
 227            ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))
 228     (epg-context-set-passphrase-callback
 229      context
 230      (cons #'epa-file-passphrase-callback-function
 231            file))
 232     (epg-context-set-progress-callback context
 233                                        #'epa-progress-callback-function)
 234     (epg-context-set-armor context epa-armor)
 235     (condition-case error
 236         (setq string
 237               (epg-encrypt-string
 238                context
 239                (if (stringp start)
 240                    (epa-file--encode-coding-string start coding-system)
 241                  (epa-file--encode-coding-string (buffer-substring start end)
 242                                                  coding-system))
 243                (if (or epa-file-select-keys
 244                        (not (local-variable-p 'epa-file-encrypt-to
 245                                               (current-buffer))))
 246                    (epa-select-keys
 247                     context
 248                     "Select recipents for encryption.
 249 If no one is selected, symmetric encryption will be performed.  "
 250                     recipients)
 251                  (if epa-file-encrypt-to
 252                      (epg-list-keys context recipients)))))
 253       (error
 254        (if (setq entry (assoc file epa-file-passphrase-alist))
 255            (setcdr entry nil))
 256        (signal 'file-error (cons "Opening output file" (cdr error)))))
 257     (epa-file-run-real-handler
 258      #'write-region
 259      (list string nil file append visit lockname mustbenew))
 260     (if (boundp 'last-coding-system-used)
 261         (setq last-coding-system-used coding-system))
 262     (if (eq visit t)
 263         (progn
 264           (setq buffer-file-name file)
 265           (set-visited-file-modtime))
 266       (if (stringp visit)
 267           (progn
 268             (set-visited-file-modtime)
 269             (setq buffer-file-name visit))))
 270     (if (or (eq visit t)
 271             (eq visit nil)
 272             (stringp visit))
 273         (message "Wrote %s" buffer-file-name))))
 274 (put 'write-region 'epa-file 'epa-file-write-region)
 275
 276 (defun epa-file-find-file-hook ()
 277   (if (and buffer-file-name
 278            (string-match epa-file-name-regexp buffer-file-name)
 279            epa-file-inhibit-auto-save)
 280       (auto-save-mode 0))
 281   (set-buffer-modified-p nil))
 282
 283 (defun epa-file-select-keys ()
 284   "Select recipients for encryption."
 285   (interactive)
 286   (make-local-variable 'epa-file-encrypt-to)
 287   (setq epa-file-encrypt-to
 288         (mapcar
 289          (lambda (key)
 290            (epg-sub-key-id (car (epg-key-sub-key-list key))))
 291         (epa-select-keys
 292          (epg-make-context)
 293          "Select recipents for encryption.
 294 If no one is selected, symmetric encryption will be performed.  "))))
 295
 296 ;;;###autoload
 297 (defun epa-file-enable ()
 298   (interactive)
 299   (if (memq epa-file-handler file-name-handler-alist)
 300       (message "`epa-file' already enabled")
 301     (setq file-name-handler-alist
 302           (cons epa-file-handler file-name-handler-alist))
 303     (add-hook 'find-file-hooks 'epa-file-find-file-hook)
 304     (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist))
 305     (message "`epa-file' enabled")))
 306
 307 ;;;###autoload
 308 (defun epa-file-disable ()
 309   (interactive)
 310   (if (memq epa-file-handler file-name-handler-alist)
 311       (progn
 312         (setq file-name-handler-alist
 313               (delq epa-file-handler file-name-handler-alist))
 314         (remove-hook 'find-file-hooks 'epa-file-find-file-hook)
 315         (setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
 316                                     auto-mode-alist))
 317         (message "`epa-file' disabled"))
 318     (message "`epa-file' already disabled")))
 319
 320 ;;;###autoload
 321 (define-minor-mode epa-file-mode
 322   "Toggle automatic file encryption and decryption.
 323 With prefix argument ARG, turn auto encryption on if positive, else off.
 324 Return the new status of auto encryption (non-nil means on)."
 325   :global t :init-value nil :group 'epa-file :version "23.1"
 326   (setq file-name-handler-alist
 327         (delq epa-file-handler file-name-handler-alist))
 328   (remove-hook 'find-file-hooks 'epa-file-find-file-hook)
 329   (setq auto-mode-alist (delq epa-file-auto-mode-alist-entry
 330                               auto-mode-alist))
 331   (when epa-file-mode
 332     (setq file-name-handler-alist
 333           (cons epa-file-handler file-name-handler-alist))
 334     (add-hook 'find-file-hooks 'epa-file-find-file-hook)
 335     (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry
 336                                 auto-mode-alist))))
 337
 338 (provide 'epa-file)
 339
 340 ;; arch-tag: 5715152f-0eb1-4dbc-9008-07098775314d
 341 ;;; epa-file.el ends here