X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2238127283d703f38765f9b3f6a64f799d18e9e5..ffcee8d7c43cef38612c39554212a5a20b75e05b:/lisp/gnus/plstore.el

diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el
index 5f9a61aa84..6d5424e833 100644
--- a/lisp/gnus/plstore.el
+++ b/lisp/gnus/plstore.el
@@ -1,5 +1,5 @@
 ;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; Keywords: PGP, GnuPG
@@ -64,8 +64,18 @@
 ;;
 ;; Editing:
 ;;
-;; Currently not supported but in the future plstore will provide a
-;; major mode to edit PLSTORE files.
+;; This file also provides `plstore-mode', a major mode for editing
+;; the PLSTORE format file.  Visit a non-existing file and put the
+;; following line:
+;;
+;; (("foo" :host "foo.example.org" :secret-user "user"))
+;;
+;; where the prefixing `:secret-' means the property (without
+;; `:secret-' prefix) is marked as secret.  Thus, when you save the
+;; buffer, the `:secret-user' property is encrypted as `:user'.
+;;
+;; You can toggle the view between encrypted form and the decrypted
+;; form with C-c C-c.
 
 ;;; Code:
 
@@ -80,9 +90,10 @@
   "Control whether or not to pop up the key selection dialog.
 
 If t, always asks user to select recipients.
-If nil, query user only when `plstore-encrypt-to' is not set.
-If neither t nor nil, doesn't ask user.  In this case, symmetric
-encryption is used."
+If nil, query user only when a file's default recipients are not
+known (i.e. `plstore-encrypt-to' is not locally set in the buffer
+visiting a plstore file).
+If neither t nor nil, doesn't ask user."
   :type '(choice (const :tag "Ask always" t)
 		 (const :tag "Ask when recipients are not set" nil)
 		 (const :tag "Don't ask" silent))
@@ -90,7 +101,8 @@ encryption is used."
 
 (defvar plstore-encrypt-to nil
   "*Recipient(s) used for encrypting secret entries.
-May either be a string or a list of strings.")
+May either be a string or a list of strings.  If it is nil,
+symmetric encryption will be used.")
 
 (put 'plstore-encrypt-to 'safe-local-variable
      (lambda (val)
@@ -105,6 +117,10 @@ May either be a string or a list of strings.")
 
 (put 'plstore-encrypt-to 'permanent-local t)
 
+(defvar plstore-encoded nil)
+
+(put 'plstore-encoded 'permanent-local t)
+
 (defvar plstore-cache-passphrase-for-symmetric-encryption nil)
 (defvar plstore-passphrase-alist nil)
 
@@ -135,38 +151,38 @@ May either be a string or a list of strings.")
     (message "%s...%d%%" handback
 	     (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
 
-(defun plstore--get-buffer (this)
-  (aref this 0))
+(defun plstore--get-buffer (arg)
+  (aref arg 0))
 
-(defun plstore--get-alist (this)
-  (aref this 1))
+(defun plstore--get-alist (arg)
+  (aref arg 1))
 
-(defun plstore--get-encrypted-data (this)
-  (aref this 2))
+(defun plstore--get-encrypted-data (arg)
+  (aref arg 2))
 
-(defun plstore--get-secret-alist (this)
-  (aref this 3))
+(defun plstore--get-secret-alist (arg)
+  (aref arg 3))
 
-(defun plstore--get-merged-alist (this)
-  (aref this 4))
+(defun plstore--get-merged-alist (arg)
+  (aref arg 4))
 
-(defun plstore--set-buffer (this buffer)
-  (aset this 0 buffer))
+(defun plstore--set-buffer (arg buffer)
+  (aset arg 0 buffer))
 
-(defun plstore--set-alist (this plist)
-  (aset this 1 plist))
+(defun plstore--set-alist (arg plist)
+  (aset arg 1 plist))
 
-(defun plstore--set-encrypted-data (this encrypted-data)
-  (aset this 2 encrypted-data))
+(defun plstore--set-encrypted-data (arg encrypted-data)
+  (aset arg 2 encrypted-data))
 
-(defun plstore--set-secret-alist (this secret-alist)
-  (aset this 3 secret-alist))
+(defun plstore--set-secret-alist (arg secret-alist)
+  (aset arg 3 secret-alist))
 
-(defun plstore--set-merged-alist (this merged-alist)
-  (aset this 4 merged-alist))
+(defun plstore--set-merged-alist (arg merged-alist)
+  (aset arg 4 merged-alist))
 
-(defun plstore-get-file (this)
-  (buffer-file-name (plstore--get-buffer this)))
+(defun plstore-get-file (arg)
+  (buffer-file-name (plstore--get-buffer arg)))
 
 (defun plstore--make (&optional buffer alist encrypted-data secret-alist
 				merged-alist)
@@ -192,10 +208,6 @@ May either be a string or a list of strings.")
 		     (generate-new-buffer (format " plstore %s" filename))))
 	 (store (plstore--make buffer)))
     (with-current-buffer buffer
-      ;; In the future plstore will provide a major mode called
-      ;; `plstore-mode' to edit PLSTORE files.
-      (if (eq major-mode 'plstore-mode)
-	  (error "%s is opened for editing; kill the buffer first" file))
       (erase-buffer)
       (condition-case nil
 	  (insert-file-contents-literally file)
@@ -418,7 +430,7 @@ SECRET-KEYS is a plist containing secret data."
 							  (current-buffer)))))
 			  (epa-select-keys
 			   context
-			   "Select recipents for encryption.
+			   "Select recipients for encryption.
 If no one is selected, symmetric encryption will be performed.  "
 			   recipients)
 			(if plstore-encrypt-to
@@ -433,6 +445,131 @@ If no one is selected, symmetric encryption will be performed.  "
     (plstore--insert-buffer plstore)
     (save-buffer)))
 
+(defun plstore--encode (plstore)
+  (plstore--decrypt plstore)
+  (let ((merged-alist (plstore--get-merged-alist plstore)))
+    (concat "("
+	    (mapconcat
+	     (lambda (entry)
+	       (setq entry (copy-sequence entry))
+	       (let ((merged-plist (cdr (assoc (car entry) merged-alist)))
+		     (plist (cdr entry)))
+		 (while plist
+		   (if (string-match "\\`:secret-" (symbol-name (car plist)))
+		       (setcar (cdr plist)
+			       (plist-get
+				merged-plist
+				(intern (concat ":"
+						(substring (symbol-name
+							    (car plist))
+							   (match-end 0)))))))
+		   (setq plist (nthcdr 2 plist)))
+		 (prin1-to-string entry)))
+	     (plstore--get-alist plstore)
+	     "\n")
+	    ")")))
+
+(defun plstore--decode (string)
+  (let* ((alist (car (read-from-string string)))
+	 (pointer alist)
+	 secret-alist
+	 plist
+	 entry)
+    (while pointer
+      (unless (stringp (car (car pointer)))
+	(error "Invalid PLSTORE format %s" string))
+      (setq plist (cdr (car pointer)))
+      (while plist
+	(when (string-match "\\`:secret-" (symbol-name (car plist)))
+	  (setq entry (assoc (car (car pointer)) secret-alist))
+	  (unless entry
+	    (setq entry (list (car (car pointer)))
+		  secret-alist (cons entry secret-alist)))
+	  (setcdr entry (plist-put (cdr entry)
+				   (intern (concat ":"
+						(substring (symbol-name
+							    (car plist))
+							   (match-end 0))))
+				   (car (cdr plist))))
+	  (setcar (cdr plist) t))
+	(setq plist (nthcdr 2 plist)))
+      (setq pointer (cdr pointer)))
+    (plstore--make nil alist nil secret-alist)))
+
+(defun plstore--write-contents-functions ()
+  (when plstore-encoded
+    (let ((store (plstore--decode (buffer-string)))
+	  (file (buffer-file-name)))
+      (unwind-protect
+	  (progn
+	    (set-visited-file-name nil)
+	    (with-temp-buffer
+	      (plstore--insert-buffer store)
+	      (write-region (buffer-string) nil file)))
+	(set-visited-file-name file)
+	(set-buffer-modified-p nil))
+      t)))
+
+(defun plstore-mode-original ()
+  "Show the original form of the this buffer."
+  (interactive)
+  (when plstore-encoded
+    (if (and (buffer-modified-p)
+	     (y-or-n-p "Save buffer before reading the original form? "))
+	(save-buffer))
+    (erase-buffer)
+    (insert-file-contents-literally (buffer-file-name))
+    (set-buffer-modified-p nil)
+    (setq plstore-encoded nil)))
+
+(defun plstore-mode-decoded ()
+  "Show the decoded form of the this buffer."
+  (interactive)
+  (unless plstore-encoded
+    (if (and (buffer-modified-p)
+	     (y-or-n-p "Save buffer before decoding? "))
+	(save-buffer))
+    (let ((store (plstore--make (current-buffer))))
+      (plstore--init-from-buffer store)
+      (erase-buffer)
+      (insert
+       (substitute-command-keys "\
+;;; You are looking at the decoded form of the PLSTORE file.\n\
+;;; To see the original form content, do \\[plstore-mode-toggle-display]\n\n"))
+      (insert (plstore--encode store))
+      (set-buffer-modified-p nil)
+      (setq plstore-encoded t))))
+
+(defun plstore-mode-toggle-display ()
+  "Toggle the display mode of PLSTORE between the original and decoded forms."
+  (interactive)
+  (if plstore-encoded
+      (plstore-mode-original)
+    (plstore-mode-decoded)))
+
+(eval-when-compile
+  (defmacro plstore-called-interactively-p (kind)
+    (condition-case nil
+        (progn
+          (eval '(called-interactively-p 'any))
+          ;; Emacs >=23.2
+          `(called-interactively-p ,kind))
+      ;; Emacs <23.2
+      (wrong-number-of-arguments '(called-interactively-p))
+      ;; XEmacs
+      (void-function '(interactive-p)))))
+
+;;;###autoload
+(define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE"
+  "Major mode for editing PLSTORE files."
+  (make-local-variable 'plstore-encoded)
+  (add-hook 'write-contents-functions #'plstore--write-contents-functions)
+  (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display)
+  ;; to create a new file with plstore-mode, mark it as already decoded
+  (if (plstore-called-interactively-p 'any)
+      (setq plstore-encoded t)
+    (plstore-mode-decoded)))
+
 (provide 'plstore)
 
 ;;; plstore.el ends here