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