Spelling fixes.
[gnus] / lisp / plstore.el
index 360388d..50208cc 100644 (file)
@@ -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 <ueno@unixuser.org>
 ;; Copyright (C) 2011 Free Software Foundation, Inc.
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 
 ;;; Commentary
 
 
 ;;; Commentary
 
+;; Plist based data store providing search and partial encryption.
+;;
 ;; Creating:
 ;;
 ;; Creating:
 ;;
+;; ;; Open a new store associated with ~/.emacs.d/auth.plist.
 ;; (setq store (plstore-open (expand-file-name "~/.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)
 ;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil)
+;; ;; No encryption will be needed.
 ;; (plstore-save store)
 ;; (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 "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")))
 ;; (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 ("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)
 ;;
 ;; (plstore-close store)
 ;;
+;; Editing:
+;;
+;; Currently not supported but in the future plstore will provide a
+;; major mode to edit PLSTORE files.
 
 ;;; Code:
 
 
 ;;; Code:
 
   "Control whether or not to pop up the key selection dialog.
 
 If t, always asks user to select recipients.
   "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))
   :type '(choice (const :tag "Ask always" t)
                 (const :tag "Ask when recipients are not set" nil)
                 (const :tag "Don't ask" silent))
@@ -63,7 +91,8 @@ encryption is used."
 
 (defvar plstore-encrypt-to nil
   "*Recipient(s) used for encrypting secret entries.
 
 (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)
 
 (put 'plstore-encrypt-to 'safe-local-variable
      (lambda (val)
@@ -108,38 +137,42 @@ May either be a string or a list of strings.")
     (message "%s...%d%%" handback
             (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
 
     (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 (arg)
+  (aref arg 1))
 
 
-(defun plstore--get-alist (this)
-  (aref this 1))
+(defun plstore--get-encrypted-data (arg)
+  (aref arg 2))
 
 
-(defun plstore--get-encrypted-data (this)
-  (aref this 2))
+(defun plstore--get-secret-alist (arg)
+  (aref arg 3))
 
 
-(defun plstore--get-secret-alist (this)
-  (aref this 3))
+(defun plstore--get-merged-alist (arg)
+  (aref arg 4))
 
 
-(defun plstore--get-merged-alist (this)
-  (aref this 4))
+(defun plstore--set-buffer (arg buffer)
+  (aset arg 0 buffer))
 
 
-(defun plstore--set-file (this file)
-  (aset this 0 file))
+(defun plstore--set-alist (arg plist)
+  (aset arg 1 plist))
 
 
-(defun plstore--set-alist (this plist)
-  (aset this 1 plist))
+(defun plstore--set-encrypted-data (arg encrypted-data)
+  (aset arg 2 encrypted-data))
 
 
-(defun plstore--set-encrypted-data (this encrypted-data)
-  (aset this 2 encrypted-data))
+(defun plstore--set-secret-alist (arg secret-alist)
+  (aset arg 3 secret-alist))
 
 
-(defun plstore--set-secret-alist (this secret-alist)
-  (aset this 3 secret-alist))
+(defun plstore--set-merged-alist (arg merged-alist)
+  (aset arg 4 merged-alist))
 
 
-(defun plstore--set-merged-alist (this merged-alist)
-  (aset this 4 merged-alist))
+(defun plstore-get-file (arg)
+  (buffer-file-name (plstore--get-buffer arg)))
 
 
-(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))
 
 (defun plstore--init-from-buffer (plstore)
   (goto-char (point-min))
@@ -156,16 +189,21 @@ May either be a string or a list of strings.")
 ;;;###autoload
 (defun plstore-open (file)
   "Create a plstore instance associated with FILE."
 ;;;###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
+      ;; 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)
+       (error))
+      (setq buffer-file-name (file-truename file))
+      (set-buffer-modified-p nil)
       (plstore--init-from-buffer store)
       store)))
 
       (plstore--init-from-buffer store)
       store)))
 
@@ -337,43 +375,64 @@ SECRET-KEYS is a plist containing secret data."
         (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
     (plstore--merge-secret plstore)))
 
         (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
     (plstore--merge-secret plstore)))
 
+(defun plstore-delete (plstore name)
+  "Delete an entry with NAME from PLSTORE."
+  (let ((entry (assoc name (plstore--get-alist plstore))))
+    (if entry
+       (plstore--set-alist
+        plstore
+        (delq entry (plstore--get-alist plstore))))
+    (setq entry (assoc name (plstore--get-secret-alist plstore)))
+    (if entry
+       (plstore--set-secret-alist
+        plstore
+        (delq entry (plstore--get-secret-alist plstore))))
+    (setq entry (assoc name (plstore--get-merged-alist plstore)))
+    (if entry
+       (plstore--set-merged-alist
+        plstore
+        (delq entry (plstore--get-merged-alist plstore))))))
+
 (defvar pp-escape-newlines)
 (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 recipients 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)
 (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)))
 
 (provide 'plstore)
     (save-buffer)))
 
 (provide 'plstore)