;;; epf.el --- transparent file encryption utility
;; Copyright (C) 2006 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;;	Naoto Morishima <naoto@morishima.net>
;; Keywords: PGP, GnuPG

;; This file is part of EasyPG.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; epf.el is based on hedgehog.el by Naoto Morishima.
;; http://www.morishima.net/~naoto/software/hedgehog/index.php.ja

;;; Code:

(require 'epg)

(defgroup epf ()
  "Transparent file encryption utility of EasyPG."
  :group 'epg)

(defcustom epf-name-regexp "\\.gpg\\'"
  "Regexp that matches filenames that are assumed to be encrypted
with GnuPG."
  :type 'regexp
  :group 'epf)

(defun epf-handler (operation &rest args)
  (let ((epf-operation (get operation 'epf)))
    (if epf-operation
        (apply epf-operation args)
      (epf-run-real-handler operation args))))

(defun epf-run-real-handler (operation args)
  (let ((inhibit-file-name-handlers
	 (cons 'epf-handler
	       (and (eq inhibit-file-name-operation operation)
		    inhibit-file-name-handlers)))
	(inhibit-file-name-operation operation))
    (apply operation args)))

(defvar buffer-file-type)
(defvar last-coding-system-used)
(defun epf-write-region (start end filename &optional append visit
				    lockname mustbenew)
  (let* ((visit-file (if (stringp visit)
                         (expand-file-name visit)
                       (expand-file-name filename)))
         ;; XXX: Obtain the value returned by choose_write_coding_system
         (coding-system (condition-case nil
			    (epf-run-real-handler
			     'write-region (list start end "/"))
                          (file-error (if (boundp 'last-coding-system-used)
					  last-coding-system-used
					buffer-file-coding-system))))
         ;; start and end are normally buffer positions
         ;; specifying the part of the buffer to write.
         ;; If start is nil, that means to use the entire buffer contents.
         ;; If start is a string, then output that string to the file
         ;; instead of any buffer contents; end is ignored.
         (string (encode-coding-string (cond
                                        ((stringp start)
                                         start)
                                        ((null start)
                                         (buffer-string))
                                        (t
                                         (buffer-substring start end)))
                                       coding-system)))
    (with-temp-buffer
      (if (fboundp 'set-buffer-multibyte)
	  (set-buffer-multibyte nil))
      ;; Optional fourth argument append if non-nil means
      ;;   append to existing file contents (if any).  If it is an integer,
      ;;   seek to that offset in the file before writing.
      (if (and append (file-exists-p filename))
          ;; Enable passphrase cache on this temp buffer
          (let ((coding-system-for-read 'binary))
            ;; set visit to t so that passphrase is cached
            (insert-file-contents filename t)
            (setq buffer-file-name nil)))
      ;; Insert data to encrypt
      (goto-char (if (integerp append) (1+ append) (point-max)))
      (delete-region (point) (min (+ (point) (length string)) (point-max)))
      (insert string)

      (let ((coding-system-for-write 'binary)
            (coding-system-for-read 'binary)
	    (context (epg-make-context))
	    recipients
	    string
	    cipher)
	(while (not (equal (setq string
				 (read-string "To (end with an empty line): "))
			   ""))
	  (setq recipients (cons string recipients)))
	(when (setq cipher (epg-encrypt-string context (buffer-string)
					       recipients))
	  (if (and (memq system-type '(ms-dos windows-nt))
		   (boundp 'buffer-file-type))
	      (setq buffer-file-type t))
	  (epf-run-real-handler
	   'write-region
	   (list cipher nil filename nil 'not-visit lockname mustbenew)))))
    ;; Optional fifth argument visit, if t or a string, means
    ;;   set the last-save-file-modtime of buffer to this file's modtime
    ;;   and mark buffer not modified.
    ;; If visit is a string, it is a second file name;
    ;;   the output goes to filename, but the buffer is marked as visiting visit.
    ;;   visit is also the file name to lock and unlock for clash detection.
    ;; If visit is neither t nor nil nor a string,
    ;;   that means do not display the "Wrote file" message.
    (when (or (eq visit t) (stringp visit))
      (setq buffer-file-name filename)
      (set-visited-file-modtime))
    (if (stringp visit)
	(setq buffer-file-name visit))
    (when (or (eq visit t) (eq visit nil) (stringp visit))
      (message "Wrote %s" visit-file))
    (if (boundp 'last-coding-system-used)
	(setq last-coding-system-used coding-system))
    nil))

(defun epf-insert-file-contents (filename &optional visit beg end replace)
  (barf-if-buffer-read-only)
  (setq filename (expand-file-name filename))
  (let ((filename (expand-file-name filename))
	(length 0))
    (if (file-exists-p filename)
	(let ((local-file
	       (let ((inhibit-file-name-operation
		      (when (eq inhibit-file-name-operation
				'insert-file-contents)
			'file-local-copy)))
		 (file-local-copy filename)))
	      (coding-system-for-read 'binary)
	      (context (epg-make-context))
	      string)
	  (unwind-protect
	      (progn
		(setq string (epg-decrypt-file context (or local-file
							   filename)
					       nil)
		      length (length string))
		(if replace
		    (goto-char (point-min)))
		(save-excursion
		  (let ((buffer-file-name (if visit nil buffer-file-name)))
		    (save-restriction
		      (narrow-to-region (point) (point))
		      (insert (decode-coding-string string 'undecided)))
		    (if replace
			(delete-region (point) (point-max))))))
	    (when (and local-file (file-exists-p local-file))
	      (delete-file local-file)))))
    ;; If second argument visit is non-nil, the buffer's visited filename
    ;; and last save file modtime are set, and it is marked unmodified.
    (when visit
      (unlock-buffer)
      (setq buffer-file-name filename)
      (set-visited-file-modtime))

    ;; If visiting and the file does not exist, visiting is completed
    ;; before the error is signaled.
    (if (and visit (not (file-exists-p filename)))
	(signal 'file-error (list "Opening input file" filename)))

    ;; Returns list of absolute file name and number of characters inserted.
    (list filename length)))

(put 'write-region 'epf 'epf-write-region)
(put 'insert-file-contents 'epf 'epf-insert-file-contents)

(unless (rassq 'epf-handler file-name-handler-alist)
  (setq file-name-handler-alist
	(cons (cons epf-name-regexp 'epf-handler)
	      file-name-handler-alist)
	auto-mode-alist
	(cons (list epf-name-regexp nil 'strip-suffix)
	      auto-mode-alist)))

(provide 'epf)

;;; epf.el ends here