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-invoke-default-handler operation args))))
  14
  15 (defun epg-file-invoke-default-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 (defun epg-file-write-region (start end filename &optional append visit
  24                                     lockname mustbenew)
  25   (let* ((visit-file (if (stringp visit)
  26                          (expand-file-name visit)
  27                        (expand-file-name filename)))
  28          ;; XXX: Obtain the value returned by choose_write_coding_system
  29          (coding-system (condition-case nil
  30                             (epg-file-invoke-default-handler
  31                              #'write-region
  32                              (list start end "/"))
  33                           (file-error last-coding-system-used)))
  34          ;; start and end are normally buffer positions
  35          ;; specifying the part of the buffer to write.
  36          ;; If start is nil, that means to use the entire buffer contents.
  37          ;; If start is a string, then output that string to the file
  38          ;; instead of any buffer contents; end is ignored.
  39          (string (encode-coding-string (cond
  40                                         ((stringp start)
  41                                          start)
  42                                         ((null start)
  43                                          (buffer-string))
  44                                         (t
  45                                          (buffer-substring start end)))
  46                                        coding-system)))
  47     (with-temp-buffer
  48       (set-buffer-multibyte nil)
  49       ;; Optional fourth argument append if non-nil means
  50       ;;   append to existing file contents (if any).  If it is an integer,
  51       ;;   seek to that offset in the file before writing.
  52       (if (and append (file-exists-p filename))
  53           ;; Enable passphrase cache on this temp buffer
  54           (let ((coding-system-for-read 'binary))
  55             ;; set visit to t so that passphrase is cached
  56             (insert-file-contents filename t)
  57             (setq buffer-file-name nil)))
  58       ;; Insert data to encrypt
  59       (goto-char (if (integerp append) (1+ append) (point-max)))
  60       (delete-region (point) (min (+ (point) (length string)) (point-max)))
  61       (insert string)
  62
  63       (let ((coding-system-for-write 'binary)
  64             (coding-system-for-read 'binary)
  65             (context (epg-make-context))
  66             cipher)
  67         (when (setq cipher (epg-encrypt-string context (buffer-string) nil))
  68           (if (memq system-type '(ms-dos windows-nt))
  69               (setq buffer-file-type t))
  70           (epg-file-invoke-default-handler
  71            #'write-region
  72            (list cipher nil filename nil 'not-visit lockname mustbenew)))))
  73     ;; Optional fifth argument visit, if t or a string, means
  74     ;;   set the last-save-file-modtime of buffer to this file's modtime
  75     ;;   and mark buffer not modified.
  76     ;; If visit is a string, it is a second file name;
  77     ;;   the output goes to filename, but the buffer is marked as visiting visit.
  78     ;;   visit is also the file name to lock and unlock for clash detection.
  79     ;; If visit is neither t nor nil nor a string,
  80     ;;   that means do not display the "Wrote file" message.
  81     (when (or (eq visit t) (stringp visit))
  82       (setq buffer-file-name filename)
  83       (set-visited-file-modtime))
  84     (when (stringp visit)
  85       (setq buffer-file-name visit))
  86     (when (or (eq visit t) (eq visit nil) (stringp visit))
  87       (message "Wrote %s" visit-file))
  88     (setq last-coding-system-used coding-system)
  89     nil))
  90
  91 (defun epg-file-insert-file-contents (filename &optional visit beg end replace)
  92   (barf-if-buffer-read-only)
  93
  94   ;; If visit is non-nil, beg and end must be nil.
  95   (if (and visit (or beg end))
  96       (error "Attempt to visit less than an entire file"))
  97
  98   (let ((expanded-filename (expand-file-name filename))
  99         (length 0))
 100     (if (file-exists-p expanded-filename)
 101         (let* ((local-copy (epg-file-invoke-default-handler
 102                             'file-local-copy
 103                             (list expanded-filename)))
 104                (local-file (or local-copy expanded-filename))
 105                (coding-system-for-read 'binary)
 106                (context (epg-make-context))
 107                string)
 108           (unwind-protect
 109               (progn
 110                 (setq string (epg-decrypt-file context local-file)
 111                       length (length string))
 112                 (if replace
 113                     (goto-char (point-min)))
 114                 (save-excursion
 115                   (let ((buffer-file-name (if visit nil buffer-file-name)))
 116                     (save-restriction
 117                       (narrow-to-region (point) (point))
 118                       (insert string)
 119                       (epg-file-decode-coding-inserted-region
 120                        (point-min) (point-max)
 121                        expanded-filename
 122                        visit beg end replace))
 123                     (if replace
 124                         (delete-region (point) (point-max))))))
 125             (when (and local-copy (file-exists-p local-copy))
 126               (delete-file local-copy)))))
 127     ;; If second argument visit is non-nil, the buffer's visited filename
 128     ;; and last save file modtime are set, and it is marked unmodified.
 129     (when visit
 130       (unlock-buffer)
 131       (setq buffer-file-name expanded-filename)
 132       (set-visited-file-modtime))
 133
 134     ;; If visiting and the file does not exist, visiting is completed
 135     ;; before the error is signaled.
 136     (if (and visit (not (file-exists-p expanded-filename)))
 137         (signal 'file-error (list "Opening input file" filename)))
 138
 139     ;; Returns list of absolute file name and number of characters inserted.
 140     (list expanded-filename length)))
 141
 142 (if (fboundp 'decode-coding-inserted-region)
 143     (defalias 'epg-file-decode-coding-inserted-region 'decode-coding-inserted-region)
 144   (defun epg-file-decode-coding-inserted-region (from to filename
 145                                                  &optional visit beg end replace)
 146     "Decode the region between FROM and TO as if it is read from file FILENAME.
 147 The idea is that the text between FROM and TO was just inserted somehow.
 148 Optional arguments VISIT, BEG, END, and REPLACE are the same as those
 149 of the function `insert-file-contents'.
 150 Part of the job of this function is setting `buffer-undo-list' appropriately."
 151   (save-excursion
 152     (save-restriction
 153       (let ((coding coding-system-for-read)
 154             undo-list-saved)
 155         (if visit
 156             ;; Temporarily turn off undo recording, if we're decoding the
 157             ;; text of a visited file.
 158             (setq buffer-undo-list t)
 159           ;; Otherwise, if we can recognize the undo elt for the insertion,
 160           ;; remove it and get ready to replace it later.
 161           ;; In the mean time, turn off undo recording.
 162           (let ((last (car-safe buffer-undo-list)))
 163             (if (and (consp last) (eql (car last) from) (eql (cdr last) to))
 164                 (setq undo-list-saved (cdr buffer-undo-list)
 165                       buffer-undo-list t))))
 166         (narrow-to-region from to)
 167         (goto-char (point-min))
 168         (or coding
 169             (setq coding (funcall set-auto-coding-function
 170                                   filename (- (point-max) (point-min)))))
 171         (or coding
 172             (setq coding (car (find-operation-coding-system
 173                                'insert-file-contents
 174                                filename visit beg end replace))))
 175         (if (coding-system-p coding)
 176             (or enable-multibyte-characters
 177                 (setq coding
 178                       (coding-system-change-text-conversion coding 'raw-text)))
 179           (setq coding nil))
 180         (if coding
 181             (decode-coding-region (point-min) (point-max) coding)
 182           (setq last-coding-system-used coding))
 183         ;; If we're decoding the text of a visited file,
 184         ;; the undo list should start out empty.
 185         (if visit
 186             (setq buffer-undo-list nil)
 187           ;; If we decided to replace the undo entry for the insertion,
 188           ;; do so now.
 189           (if undo-list-saved
 190               (setq buffer-undo-list
 191                     (cons (cons from (point-max)) undo-list-saved)))))))))
 192
 193 (put 'epg-file-handler 'safe-magic t)
 194 (let (epg-file-operations)
 195   (mapc
 196    (lambda (operation)
 197      (let ((epg-file-operation (intern (format "epg-file-%s" operation))))
 198        (when (fboundp epg-file-operation)
 199          (push operation epg-file-operations)
 200          (put operation 'epg-file epg-file-operation))))
 201    '(access-file add-name-to-file byte-compiler-base-file-name copy-file
 202      delete-directory delete-file  diff-latest-backup-file directory-file-name
 203      directory-files directory-files-and-attributes dired-call-process
 204      dired-compress-file dired-uncache expand-file-name
 205      file-accessible-directory-p file-attributes file-directory-p
 206      file-executable-p file-exists-p file-local-copy file-remote-p file-modes
 207      file-name-all-completions file-name-as-directory file-name-completion
 208      file-name-directory file-name-nondirectory file-name-sans-versions
 209      file-newer-than-file-p file-ownership-preserved-p file-readable-p
 210      file-regular-p file-symlink-p file-truename file-writable-p
 211      find-backup-file-name find-file-noselect get-file-buffer
 212      insert-directory insert-file-contents load make-directory
 213      make-directory-internal make-symbolic-link rename-file set-file-modes
 214      set-visited-file-modtime shell-command substitute-in-file-name
 215      unhandled-file-name-directory vc-registered verify-visited-file-modtime
 216      write-region))
 217   (put 'epg-file-handler 'operations epg-file-operations))
 218
 219 (unless (assoc epg-file-name-regexp file-name-handler-alist)
 220   (push (cons epg-file-name-regexp 'epg-file-handler)
 221         file-name-handler-alist))
 222
 223 (unless (assoc epg-file-name-regexp auto-mode-alist)
 224   (push (list epg-file-name-regexp nil 'strip-suffix)
 225         auto-mode-alist))