epg-file.el

   1 (require 'epg)
   2
   3 (defcustom epg-file-name-regexp "\\.gpg\\'"
   4   "Regexp that matches filenames that are assumed to be encrypted
   5 with GnuPG."
   6   :type 'regexp
   7   :group 'epg-file)
   8
   9 (defun epg-file-handler (operation &rest args)
  10   (let ((epg-file-operation (get operation 'epg-file)))
  11     (if epg-file-operation
  12         (apply epg-file-operation args)
  13       (epg-file-run-real-handler operation args))))
  14
  15 (defun epg-file-run-real-handler (operation args)
  16   (let ((inhibit-file-name-handlers
  17          (cons 'epg-file-handler
  18                (and (eq inhibit-file-name-operation operation)
  19                     inhibit-file-name-handlers)))
  20         (inhibit-file-name-operation operation))
  21     (apply operation args)))
  22
  23 (defvar buffer-file-type)
  24 (defvar last-coding-system-used)
  25 (defun epg-file-write-region (start end filename &optional append visit
  26                                     lockname mustbenew)
  27   (let* ((visit-file (if (stringp visit)
  28                          (expand-file-name visit)
  29                        (expand-file-name filename)))
  30          ;; XXX: Obtain the value returned by choose_write_coding_system
  31          (coding-system (condition-case nil
  32                             (epg-file-run-real-handler
  33                              'write-region (list start end "/"))
  34                           (file-error (if (boundp 'last-coding-system-used)
  35                                           last-coding-system-used
  36                                         buffer-file-coding-system))))
  37          ;; start and end are normally buffer positions
  38          ;; specifying the part of the buffer to write.
  39          ;; If start is nil, that means to use the entire buffer contents.
  40          ;; If start is a string, then output that string to the file
  41          ;; instead of any buffer contents; end is ignored.
  42          (string (encode-coding-string (cond
  43                                         ((stringp start)
  44                                          start)
  45                                         ((null start)
  46                                          (buffer-string))
  47                                         (t
  48                                          (buffer-substring start end)))
  49                                        coding-system)))
  50     (with-temp-buffer
  51       (if (fboundp 'set-buffer-multibyte)
  52           (set-buffer-multibyte nil))
  53       ;; Optional fourth argument append if non-nil means
  54       ;;   append to existing file contents (if any).  If it is an integer,
  55       ;;   seek to that offset in the file before writing.
  56       (if (and append (file-exists-p filename))
  57           ;; Enable passphrase cache on this temp buffer
  58           (let ((coding-system-for-read 'binary))
  59             ;; set visit to t so that passphrase is cached
  60             (insert-file-contents filename t)
  61             (setq buffer-file-name nil)))
  62       ;; Insert data to encrypt
  63       (goto-char (if (integerp append) (1+ append) (point-max)))
  64       (delete-region (point) (min (+ (point) (length string)) (point-max)))
  65       (insert string)
  66
  67       (let ((coding-system-for-write 'binary)
  68             (coding-system-for-read 'binary)
  69             (context (epg-make-context))
  70             recipients
  71             string
  72             cipher)
  73         (while (not (equal (setq string
  74                                  (read-string "To (end with an empty line): "))
  75                            ""))
  76           (setq recipients (cons string recipients)))
  77         (when (setq cipher (epg-encrypt-string context (buffer-string)
  78                                                recipients))
  79           (if (and (memq system-type '(ms-dos windows-nt))
  80                    (boundp 'buffer-file-type))
  81               (setq buffer-file-type t))
  82           (epg-file-run-real-handler
  83            'write-region
  84            (list cipher nil filename nil 'not-visit lockname mustbenew)))))
  85     ;; Optional fifth argument visit, if t or a string, means
  86     ;;   set the last-save-file-modtime of buffer to this file's modtime
  87     ;;   and mark buffer not modified.
  88     ;; If visit is a string, it is a second file name;
  89     ;;   the output goes to filename, but the buffer is marked as visiting visit.
  90     ;;   visit is also the file name to lock and unlock for clash detection.
  91     ;; If visit is neither t nor nil nor a string,
  92     ;;   that means do not display the "Wrote file" message.
  93     (when (or (eq visit t) (stringp visit))
  94       (setq buffer-file-name filename)
  95       (set-visited-file-modtime))
  96     (if (stringp visit)
  97         (setq buffer-file-name visit))
  98     (when (or (eq visit t) (eq visit nil) (stringp visit))
  99       (message "Wrote %s" visit-file))
 100     (if (boundp 'last-coding-system-used)
 101         (setq last-coding-system-used coding-system))
 102     nil))
 103
 104 (defun epg-file-insert-file-contents (filename &optional visit beg end replace)
 105   (barf-if-buffer-read-only)
 106   (setq filename (expand-file-name filename))
 107   (let ((filename (expand-file-name filename))
 108         (length 0))
 109     (if (file-exists-p filename)
 110         (let ((local-file
 111                (let ((inhibit-file-name-operation
 112                       (when (eq inhibit-file-name-operation
 113                                 'insert-file-contents)
 114                         'file-local-copy)))
 115                  (file-local-copy filename)))
 116               (coding-system-for-read 'binary)
 117               (context (epg-make-context))
 118               string)
 119           (unwind-protect
 120               (progn
 121                 (setq string (epg-decrypt-file context (or local-file
 122                                                            filename))
 123                       length (length string))
 124                 (if replace
 125                     (goto-char (point-min)))
 126                 (save-excursion
 127                   (let ((buffer-file-name (if visit nil buffer-file-name)))
 128                     (save-restriction
 129                       (narrow-to-region (point) (point))
 130                       (insert (decode-coding-string string 'undecided)))
 131                     (if replace
 132                         (delete-region (point) (point-max))))))
 133             (when (and local-file (file-exists-p local-file))
 134               (delete-file local-file)))))
 135     ;; If second argument visit is non-nil, the buffer's visited filename
 136     ;; and last save file modtime are set, and it is marked unmodified.
 137     (when visit
 138       (unlock-buffer)
 139       (setq buffer-file-name filename)
 140       (set-visited-file-modtime))
 141
 142     ;; If visiting and the file does not exist, visiting is completed
 143     ;; before the error is signaled.
 144     (if (and visit (not (file-exists-p filename)))
 145         (signal 'file-error (list "Opening input file" filename)))
 146
 147     ;; Returns list of absolute file name and number of characters inserted.
 148     (list filename length)))
 149
 150 (put 'write-region 'epg-file 'epg-file-write-region)
 151 (put 'insert-file-contents 'epg-file 'epg-file-insert-file-contents)
 152
 153 (unless (assoc epg-file-name-regexp file-name-handler-alist)
 154   (setq file-name-handler-alist
 155         (cons (cons epg-file-name-regexp 'epg-file-handler)
 156               file-name-handler-alist)))
 157
 158 (unless (assoc epg-file-name-regexp auto-mode-alist)
 159   (setq auto-mode-alist
 160         (cons (list epg-file-name-regexp nil 'strip-suffix)
 161               auto-mode-alist)))
 162
 163 (provide 'epg-file)
 164
 165 ;;; epg-file.el ends here