[Emacs-diffs] /srv/bzr/emacs/trunk r105008: Add a major mode to edit plstore files.

[Daiki Ueno]

------------------------------------------------------------
revno: 105008
committer: Daiki Ueno <address@hidden>
branch nick: trunk
timestamp: Thu 2011-07-07 18:20:37 +0900
message:
  Add a major mode to edit plstore files.
  
  * plstore.el: Add documentation.
  (plstore-mode): New mode to edit plstore file.
  (plstore-mode-toggle-display, plstore-mode-original)
  (plstore-mode-decoded): New command.
  (plstore--encode, plstore--decode, plstore--write-contents-functions)
  (plstore--insert-buffer, plstore--make): New function.
  (plstore-open, plstore-save): Simplify by using them.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/plstore.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-07-06 22:39:47 +0000
+++ b/lisp/gnus/ChangeLog       2011-07-07 09:20:37 +0000
@@ -1,3 +1,13 @@
+2011-07-07  Daiki Ueno  <address@hidden>
+
+       * plstore.el: Add documentation.
+       (plstore-mode): New mode to edit plstore file.
+       (plstore-mode-toggle-display, plstore-mode-original)
+       (plstore-mode-decoded): New command.
+       (plstore--encode, plstore--decode, plstore--write-contents-functions)
+       (plstore--insert-buffer, plstore--make): New function.
+       (plstore-open, plstore-save): Simplify by using them.
+
 2011-07-06  Glenn Morris  <address@hidden>
 
        * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Silence compiler.

=== modified file 'lisp/gnus/plstore.el'
--- a/lisp/gnus/plstore.el      2011-07-01 07:35:39 +0000
+++ b/lisp/gnus/plstore.el      2011-07-07 09:20:37 +0000
@@ -1,4 +1,4 @@
-;;; plstore.el --- searchable, partially encrypted, persistent plist store -*- 
lexical-binding: t -*-
+;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
 ;; Copyright (C) 2011 Free Software Foundation, Inc.
 
 ;; Author: Daiki Ueno <address@hidden>
@@ -21,24 +21,61 @@
 
 ;;; Commentary
 
+;; Plist based data store providing search and partial encryption.
+;;
 ;; Creating:
 ;;
+;; ;; Open a new store associated with ~/.emacs.d/auth.plist.
 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
+;; ;; Both `:host' and `:port' are public property.
 ;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil)
+;; ;; No encryption will be needed.
 ;; (plstore-save store)
-;; ;; :user property is secret
+;;
+;; ;; `:user' is marked as secret.
 ;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test"))
-;; (plstore-put store "baz" '(:host "baz.example.org") '(:user "test"))
-;; (plstore-save store) ;<= will ask passphrase via GPG
+;; ;; `:password' is marked as secret.
+;; (plstore-put store "baz" '(:host "baz.example.org") '(:password "test"))
+;; ;; Those secret properties are encrypted together.
+;; (plstore-save store)
+;;
+;; ;; Kill the buffer visiting ~/.emacs.d/auth.plist.
 ;; (plstore-close store)
 ;;
 ;; Searching:
 ;;
 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
+;;
+;; ;; As the entry "foo" associated with "foo.example.org" has no
+;; ;; secret properties, no need to decryption.
 ;; (plstore-find store '(:host ("foo.example.org")))
-;; (plstore-find store '(:host ("bar.example.org"))) ;<= will ask passphrase 
via GPG
+;;
+;; ;; As the entry "bar" associated with "bar.example.org" has a
+;; ;; secret property `:user', Emacs tries to decrypt the secret (and
+;; ;; thus you will need to input passphrase).
+;; (plstore-find store '(:host ("bar.example.org")))
+;;
+;; ;; While the entry "baz" associated with "baz.example.org" has also
+;; ;; a secret property `:password', it is encrypted together with
+;; ;; `:user' of "bar", so no need to decrypt the secret.
+;; (plstore-find store '(:host ("bar.example.org")))
+;;
 ;; (plstore-close store)
 ;;
+;; Editing:
+;;
+;; 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:
 
@@ -78,6 +115,10 @@
 
 (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)
 
@@ -123,8 +164,8 @@
 (defun plstore--get-merged-alist (this)
   (aref this 4))
 
-(defun plstore--set-file (this file)
-  (aset this 0 file))
+(defun plstore--set-buffer (this buffer)
+  (aset this 0 buffer))
 
 (defun plstore--set-alist (this plist)
   (aset this 1 plist))
@@ -141,6 +182,10 @@
 (defun plstore-get-file (this)
   (buffer-file-name (plstore--get-buffer this)))
 
+(defun plstore--make (&optional buffer alist encrypted-data secret-alist
+                               merged-alist)
+  (vector buffer alist encrypted-data secret-alist merged-alist))
+
 (defun plstore--init-from-buffer (plstore)
   (goto-char (point-min))
   (when (looking-at ";;; public entries")
@@ -156,16 +201,17 @@
 ;;;###autoload
 (defun plstore-open (file)
   "Create a plstore instance associated with FILE."
-  (with-current-buffer (find-file-noselect file)
-    ;; make the buffer invisible from user
-    (rename-buffer (format " plstore %s" (buffer-file-name)))
-    (let ((store (vector
-                 (current-buffer)
-                 nil                ;plist (plist)
-                 nil                ;encrypted data (string)
-                 nil                ;secret plist (plist)
-                 nil                ;merged plist (plist)
-                 )))
+  (let* ((filename (file-truename file))
+        (buffer (or (find-buffer-visiting filename)
+                    (generate-new-buffer (format " plstore %s" filename))))
+        (store (plstore--make buffer)))
+    (with-current-buffer buffer
+      (erase-buffer)
+      (condition-case nil
+         (insert-file-contents-literally file)
+       (error))
+      (setq buffer-file-name (file-truename file))
+      (set-buffer-modified-p nil)
       (plstore--init-from-buffer store)
       store)))
 
@@ -356,44 +402,160 @@
         (delq entry (plstore--get-merged-alist plstore))))))
 
 (defvar pp-escape-newlines)
+(defun plstore--insert-buffer (plstore)
+  (insert ";;; public entries -*- mode: plstore -*- \n"
+         (pp-to-string (plstore--get-alist plstore)))
+  (if (plstore--get-secret-alist plstore)
+      (let ((context (epg-make-context 'OpenPGP))
+           (pp-escape-newlines nil)
+           (recipients
+            (cond
+             ((listp plstore-encrypt-to) plstore-encrypt-to)
+             ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
+           cipher)
+       (epg-context-set-armor context t)
+       (epg-context-set-passphrase-callback
+        context
+        (cons #'plstore-passphrase-callback-function
+              plstore))
+       (setq cipher (epg-encrypt-string
+                     context
+                     (pp-to-string
+                      (plstore--get-secret-alist plstore))
+                     (if (or (eq plstore-select-keys t)
+                             (and (null plstore-select-keys)
+                                  (not (local-variable-p 'plstore-encrypt-to
+                                                         (current-buffer)))))
+                         (epa-select-keys
+                          context
+                          "Select recipents for encryption.
+If no one is selected, symmetric encryption will be performed.  "
+                          recipients)
+                       (if plstore-encrypt-to
+                           (epg-list-keys context recipients)))))
+       (goto-char (point-max))
+       (insert ";;; secret entries\n" (pp-to-string cipher)))))
+
 (defun plstore-save (plstore)
   "Save the contents of PLSTORE associated with a FILE."
   (with-current-buffer (plstore--get-buffer plstore)
     (erase-buffer)
-    (insert ";;; public entries -*- mode: emacs-lisp -*- \n"
-           (pp-to-string (plstore--get-alist plstore)))
-    (if (plstore--get-secret-alist plstore)
-       (let ((context (epg-make-context 'OpenPGP))
-             (pp-escape-newlines nil)
-             (recipients
-              (cond
-               ((listp plstore-encrypt-to) plstore-encrypt-to)
-               ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
-             cipher)
-         (epg-context-set-armor context t)
-         (epg-context-set-passphrase-callback
-          context
-          (cons #'plstore-passphrase-callback-function
-                plstore))
-         (setq cipher (epg-encrypt-string
-                       context
-                       (pp-to-string
-                        (plstore--get-secret-alist plstore))
-                       (if (or (eq plstore-select-keys t)
-                               (and (null plstore-select-keys)
-                                    (not (local-variable-p 'plstore-encrypt-to
-                                                           (current-buffer)))))
-                           (epa-select-keys
-                            context
-                            "Select recipents for encryption.
-If no one is selected, symmetric encryption will be performed.  "
-                            recipients)
-                         (if plstore-encrypt-to
-                             (epg-list-keys context recipients)))))
-         (goto-char (point-max))
-         (insert ";;; secret entries\n" (pp-to-string cipher))))
+    (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)))
+
+;;;###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 (called-interactively-p 'any)
+      (setq plstore-encoded t)
+    (plstore-mode-decoded)))
+
 (provide 'plstore)
 
 ;;; plstore.el ends here