epf.el

   1 ;;; epf.el --- transparent file encryption utility
   2 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
   3 ;;   2005, 2006 Free Software Foundation, Inc.
   4 ;; Copyright (C) 2006 Daiki Ueno
   5
   6 ;; Author: Daiki Ueno <ueno@unixuser.org>
   7 ;;      Naoto Morishima <naoto@morishima.net>
   8 ;; Keywords: PGP, GnuPG
   9
  10 ;; This file is part of EasyPG.
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; epf.el is based on hedgehog.el by Naoto Morishima.
  30 ;; http://www.morishima.net/~naoto/software/hedgehog/index.php.ja
  31
  32 ;;; Code:
  33
  34 (require 'epg)
  35
  36 (defgroup epf ()
  37   "Transparent file encryption utility of EasyPG."
  38   :group 'epg)
  39
  40 (defcustom epf-name-regexp "\\.gpg\\'"
  41   "Regexp that matches filenames that are assumed to be encrypted
  42 with GnuPG."
  43   :type 'regexp
  44   :group 'epf)
  45
  46 (defun epf-handler (operation &rest args)
  47   (let ((epf-operation (get operation 'epf)))
  48     (if epf-operation
  49         (apply epf-operation args)
  50       (epf-run-real-handler operation args))))
  51
  52 (defun epf-run-real-handler (operation args)
  53   (let ((inhibit-file-name-handlers
  54          (cons 'epf-handler
  55                (and (eq inhibit-file-name-operation operation)
  56                     inhibit-file-name-handlers)))
  57         (inhibit-file-name-operation operation))
  58     (apply operation args)))
  59
  60 (defvar buffer-file-type)
  61 (defvar last-coding-system-used)
  62 (defun epf-write-region (start end filename &optional append visit
  63                                     lockname mustbenew)
  64   (let* ((visit-file (if (stringp visit)
  65                          (expand-file-name visit)
  66                        (expand-file-name filename)))
  67          ;; XXX: Obtain the value returned by choose_write_coding_system
  68          (coding-system (condition-case nil
  69                             (epf-run-real-handler
  70                              'write-region (list start end "/"))
  71                           (file-error (if (boundp 'last-coding-system-used)
  72                                           last-coding-system-used
  73                                         buffer-file-coding-system))))
  74          ;; start and end are normally buffer positions
  75          ;; specifying the part of the buffer to write.
  76          ;; If start is nil, that means to use the entire buffer contents.
  77          ;; If start is a string, then output that string to the file
  78          ;; instead of any buffer contents; end is ignored.
  79          (string (encode-coding-string (cond
  80                                         ((stringp start)
  81                                          start)
  82                                         ((null start)
  83                                          (buffer-string))
  84                                         (t
  85                                          (buffer-substring start end)))
  86                                        coding-system)))
  87     (with-temp-buffer
  88       (if (fboundp 'set-buffer-multibyte)
  89           (set-buffer-multibyte nil))
  90       ;; Optional fourth argument append if non-nil means
  91       ;;   append to existing file contents (if any).  If it is an integer,
  92       ;;   seek to that offset in the file before writing.
  93       (if (and append (file-exists-p filename))
  94           ;; Enable passphrase cache on this temp buffer
  95           (let ((coding-system-for-read 'binary))
  96             ;; set visit to t so that passphrase is cached
  97             (insert-file-contents filename t)
  98             (setq buffer-file-name nil)))
  99       ;; Insert data to encrypt
 100       (goto-char (if (integerp append) (1+ append) (point-max)))
 101       (delete-region (point) (min (+ (point) (length string)) (point-max)))
 102       (insert string)
 103
 104       (let ((coding-system-for-write 'binary)
 105             (coding-system-for-read 'binary)
 106             (context (epg-make-context))
 107             recipients
 108             string
 109             cipher)
 110         (while (not (equal (setq string
 111                                  (read-string "To (end with an empty line): "))
 112                            ""))
 113           (setq recipients (cons string recipients)))
 114         (when (setq cipher (epg-encrypt-string context (buffer-string)
 115                                                recipients))
 116           (if (and (memq system-type '(ms-dos windows-nt))
 117                    (boundp 'buffer-file-type))
 118               (setq buffer-file-type t))
 119           (epf-run-real-handler
 120            'write-region
 121            (list cipher nil filename nil 'not-visit lockname mustbenew)))))
 122     ;; Optional fifth argument visit, if t or a string, means
 123     ;;   set the last-save-file-modtime of buffer to this file's modtime
 124     ;;   and mark buffer not modified.
 125     ;; If visit is a string, it is a second file name;
 126     ;;   the output goes to filename, but the buffer is marked as visiting visit.
 127     ;;   visit is also the file name to lock and unlock for clash detection.
 128     ;; If visit is neither t nor nil nor a string,
 129     ;;   that means do not display the "Wrote file" message.
 130     (when (or (eq visit t) (stringp visit))
 131       (setq buffer-file-name filename)
 132       (set-visited-file-modtime))
 133     (if (stringp visit)
 134         (setq buffer-file-name visit))
 135     (when (or (eq visit t) (eq visit nil) (stringp visit))
 136       (message "Wrote %s" visit-file))
 137     (if (boundp 'last-coding-system-used)
 138         (setq last-coding-system-used coding-system))
 139     nil))
 140
 141 (defun epf-insert-file-contents (filename &optional visit beg end replace)
 142   (barf-if-buffer-read-only)
 143   (setq filename (expand-file-name filename))
 144   (let ((filename (expand-file-name filename))
 145         (length 0))
 146     (if (file-exists-p filename)
 147         (let ((local-file
 148                (let ((inhibit-file-name-operation
 149                       (when (eq inhibit-file-name-operation
 150                                 'insert-file-contents)
 151                         'file-local-copy)))
 152                  (file-local-copy filename)))
 153               (coding-system-for-read 'binary)
 154               (context (epg-make-context))
 155               string)
 156           (unwind-protect
 157               (progn
 158                 (setq string (epg-decrypt-file context (or local-file
 159                                                            filename)
 160                                                nil)
 161                       length (length string))
 162                 (if replace
 163                     (goto-char (point-min)))
 164                 (save-excursion
 165                   (let ((buffer-file-name (if visit nil buffer-file-name)))
 166                     (save-restriction
 167                       (narrow-to-region (point) (point))
 168                       (insert (decode-coding-string string 'undecided)))
 169                     (if replace
 170                         (delete-region (point) (point-max))))))
 171             (when (and local-file (file-exists-p local-file))
 172               (delete-file local-file)))))
 173     ;; If second argument visit is non-nil, the buffer's visited filename
 174     ;; and last save file modtime are set, and it is marked unmodified.
 175     (when visit
 176       (unlock-buffer)
 177       (setq buffer-file-name filename)
 178       (set-visited-file-modtime))
 179
 180     ;; If visiting and the file does not exist, visiting is completed
 181     ;; before the error is signaled.
 182     (if (and visit (not (file-exists-p filename)))
 183         (signal 'file-error (list "Opening input file" filename)))
 184
 185     ;; Returns list of absolute file name and number of characters inserted.
 186     (list filename length)))
 187
 188 (put 'write-region 'epf 'epf-write-region)
 189 (put 'insert-file-contents 'epf 'epf-insert-file-contents)
 190
 191 (unless (rassq 'epf-handler file-name-handler-alist)
 192   (setq file-name-handler-alist
 193         (cons (cons epf-name-regexp 'epf-handler)
 194               file-name-handler-alist)
 195         auto-mode-alist
 196         (cons (list epf-name-regexp nil 'strip-suffix)
 197               auto-mode-alist)))
 198
 199 (provide 'epf)
 200
 201 ;;; epf.el ends here