1 ;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
2 ;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: PGP, GnuPG
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; Plist based data store providing search and partial encryption.
28 ;; ;; Open a new store associated with ~/.emacs.d/auth.plist.
29 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
30 ;; ;; Both `:host' and `:port' are public property.
31 ;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil)
32 ;; ;; No encryption will be needed.
33 ;; (plstore-save store)
35 ;; ;; `:user' is marked as secret.
36 ;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test"))
37 ;; ;; `:password' is marked as secret.
38 ;; (plstore-put store "baz" '(:host "baz.example.org") '(:password "test"))
39 ;; ;; Those secret properties are encrypted together.
40 ;; (plstore-save store)
42 ;; ;; Kill the buffer visiting ~/.emacs.d/auth.plist.
43 ;; (plstore-close store)
47 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
49 ;; ;; As the entry "foo" associated with "foo.example.org" has no
50 ;; ;; secret properties, no need to decryption.
51 ;; (plstore-find store '(:host ("foo.example.org")))
53 ;; ;; As the entry "bar" associated with "bar.example.org" has a
54 ;; ;; secret property `:user', Emacs tries to decrypt the secret (and
55 ;; ;; thus you will need to input passphrase).
56 ;; (plstore-find store '(:host ("bar.example.org")))
58 ;; ;; While the entry "baz" associated with "baz.example.org" has also
59 ;; ;; a secret property `:password', it is encrypted together with
60 ;; ;; `:user' of "bar", so no need to decrypt the secret.
61 ;; (plstore-find store '(:host ("bar.example.org")))
63 ;; (plstore-close store)
67 ;; Currently not supported but in the future plstore will provide a
68 ;; major mode to edit PLSTORE files.
75 "Searchable, partially encrypted, persistent plist store"
79 (defcustom plstore-select-keys 'silent
80 "Control whether or not to pop up the key selection dialog.
82 If t, always asks user to select recipients.
83 If nil, query user only when a file's default recipients are not
84 known (i.e. `plstore-encrypt-to' is not locally set in the buffer
85 visiting a plstore file).
86 If neither t nor nil, doesn't ask user."
87 :type '(choice (const :tag "Ask always" t)
88 (const :tag "Ask when recipients are not set" nil)
89 (const :tag "Don't ask" silent))
92 (defvar plstore-encrypt-to nil
93 "*Recipient(s) used for encrypting secret entries.
94 May either be a string or a list of strings. If it is nil,
95 symmetric encryption will be used.")
97 (put 'plstore-encrypt-to 'safe-local-variable
103 (unless (stringp elt)
108 (put 'plstore-encrypt-to 'permanent-local t)
110 (defvar plstore-cache-passphrase-for-symmetric-encryption nil)
111 (defvar plstore-passphrase-alist nil)
113 (defun plstore-passphrase-callback-function (_context _key-id plstore)
114 (if plstore-cache-passphrase-for-symmetric-encryption
115 (let* ((file (file-truename (plstore--get-buffer plstore)))
116 (entry (assoc file plstore-passphrase-alist))
118 (or (copy-sequence (cdr entry))
121 (setq entry (list file)
122 plstore-passphrase-alist
124 plstore-passphrase-alist)))
126 (read-passwd (format "Passphrase for PLSTORE %s: "
127 (plstore--get-buffer plstore))))
128 (setcdr entry (copy-sequence passphrase))
130 (read-passwd (format "Passphrase for PLSTORE %s: "
131 (plstore--get-buffer plstore)))))
133 (defun plstore-progress-callback-function (_context _what _char current total
135 (if (= current total)
136 (message "%s...done" handback)
137 (message "%s...%d%%" handback
138 (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
140 (defun plstore--get-buffer (arg)
143 (defun plstore--get-alist (arg)
146 (defun plstore--get-encrypted-data (arg)
149 (defun plstore--get-secret-alist (arg)
152 (defun plstore--get-merged-alist (arg)
155 (defun plstore--set-buffer (arg buffer)
158 (defun plstore--set-alist (arg plist)
161 (defun plstore--set-encrypted-data (arg encrypted-data)
162 (aset arg 2 encrypted-data))
164 (defun plstore--set-secret-alist (arg secret-alist)
165 (aset arg 3 secret-alist))
167 (defun plstore--set-merged-alist (arg merged-alist)
168 (aset arg 4 merged-alist))
170 (defun plstore-get-file (arg)
171 (buffer-file-name (plstore--get-buffer arg)))
173 (defun plstore--make (&optional buffer alist encrypted-data secret-alist
175 (vector buffer alist encrypted-data secret-alist merged-alist))
177 (defun plstore--init-from-buffer (plstore)
178 (goto-char (point-min))
179 (when (looking-at ";;; public entries")
181 (plstore--set-alist plstore (read (point-marker)))
184 (when (looking-at ";;; secret entries")
186 (plstore--set-encrypted-data plstore (read (point-marker))))
187 (plstore--merge-secret plstore)))
190 (defun plstore-open (file)
191 "Create a plstore instance associated with FILE."
192 (let* ((filename (file-truename file))
193 (buffer (or (find-buffer-visiting filename)
194 (generate-new-buffer (format " plstore %s" filename))))
195 (store (plstore--make buffer)))
196 (with-current-buffer buffer
197 ;; In the future plstore will provide a major mode called
198 ;; `plstore-mode' to edit PLSTORE files.
199 (if (eq major-mode 'plstore-mode)
200 (error "%s is opened for editing; kill the buffer first" file))
203 (insert-file-contents-literally file)
205 (setq buffer-file-name (file-truename file))
206 (set-buffer-modified-p nil)
207 (plstore--init-from-buffer store)
210 (defun plstore-revert (plstore)
211 "Replace current data in PLSTORE with the file on disk."
212 (with-current-buffer (plstore--get-buffer plstore)
214 (plstore--init-from-buffer plstore)))
216 (defun plstore-close (plstore)
217 "Destroy a plstore instance PLSTORE."
218 (kill-buffer (plstore--get-buffer plstore)))
220 (defun plstore--merge-secret (plstore)
221 (let ((alist (plstore--get-secret-alist plstore))
228 (plstore--set-merged-alist
230 (copy-tree (plstore--get-alist plstore)))
231 (setq modified-alist (plstore--get-merged-alist plstore))
233 (setq entry (car alist)
236 modified-entry (assoc (car entry) modified-alist)
237 modified-plist (cdr modified-entry))
242 (intern (concat ":secret-"
243 (substring (symbol-name (car plist)) 1)))))
245 (setcar placeholder (car plist)))
247 (plist-put modified-plist (car plist) (car (cdr plist))))
248 (setq plist (nthcdr 2 plist)))
249 (setcdr modified-entry modified-plist))))
251 (defun plstore--decrypt (plstore)
252 (if (plstore--get-encrypted-data plstore)
253 (let ((context (epg-make-context 'OpenPGP))
255 (epg-context-set-passphrase-callback
257 (cons #'plstore-passphrase-callback-function
259 (epg-context-set-progress-callback
261 (cons #'plstore-progress-callback-function
262 (format "Decrypting %s" (plstore-get-file plstore))))
264 (epg-decrypt-string context
265 (plstore--get-encrypted-data plstore)))
266 (plstore--set-secret-alist plstore (car (read-from-string plain)))
267 (plstore--merge-secret plstore)
268 (plstore--set-encrypted-data plstore nil))))
270 (defun plstore--match (entry keys skip-if-secret-found)
271 (let ((result t) key-name key-value prop-value secret-name)
273 (setq key-name (car keys)
274 key-value (car (cdr keys))
275 prop-value (plist-get (cdr entry) key-name))
276 (unless (member prop-value key-value)
277 (if skip-if-secret-found
280 (intern (concat ":secret-"
281 (substring (symbol-name key-name) 1))))
282 (if (plist-member (cdr entry) secret-name)
283 (setq result 'secret)
288 (setq keys (nthcdr 2 keys)))
291 (defun plstore-find (plstore keys)
292 "Perform search on PLSTORE with KEYS.
294 (let (entries alist entry match decrypt plist)
295 ;; First, go through the merged plist alist and collect entries
296 ;; matched with keys.
297 (setq alist (plstore--get-merged-alist plstore))
299 (setq entry (car alist)
301 match (plstore--match entry keys t))
302 (if (eq match 'secret)
305 (setq plist (cdr entry))
307 (if (string-match "\\`:secret-" (symbol-name (car plist)))
310 (setq plist (nthcdr 2 plist)))
311 (setq entries (cons entry entries)))))
312 ;; Second, decrypt the encrypted plist and try again.
315 (plstore--decrypt plstore)
316 (setq alist (plstore--get-merged-alist plstore))
318 (setq entry (car alist)
320 match (plstore--match entry keys nil))
322 (setq entries (cons entry entries)))))
325 (defun plstore-get (plstore name)
326 "Get an entry with NAME in PLSTORE."
327 (let ((entry (assoc name (plstore--get-merged-alist plstore)))
329 (setq plist (cdr entry))
331 (if (string-match "\\`:secret-" (symbol-name (car plist)))
333 (plstore--decrypt plstore)
334 (setq entry (assoc name (plstore--get-merged-alist plstore))
336 (setq plist (nthcdr 2 plist))))
339 (defun plstore-put (plstore name keys secret-keys)
340 "Put an entry with NAME in PLSTORE.
341 KEYS is a plist containing non-secret data.
342 SECRET-KEYS is a plist containing secret data."
348 (plstore--decrypt plstore))
351 (intern (concat ":secret-"
352 (substring (symbol-name (car secret-keys)) 1))))
353 (setq plist (plist-put plist symbol t)
354 secret-plist (plist-put secret-plist
355 (car secret-keys) (car (cdr secret-keys)))
356 secret-keys (nthcdr 2 secret-keys)))
359 (intern (concat ":secret-"
360 (substring (symbol-name (car keys)) 1))))
361 (setq plist (plist-put plist (car keys) (car (cdr keys)))
362 keys (nthcdr 2 keys)))
363 (setq entry (assoc name (plstore--get-alist plstore)))
368 (cons (cons name plist) (plstore--get-alist plstore))))
370 (setq entry (assoc name (plstore--get-secret-alist plstore)))
372 (setcdr entry secret-plist)
373 (plstore--set-secret-alist
375 (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
376 (plstore--merge-secret plstore)))
378 (defun plstore-delete (plstore name)
379 "Delete an entry with NAME from PLSTORE."
380 (let ((entry (assoc name (plstore--get-alist plstore))))
384 (delq entry (plstore--get-alist plstore))))
385 (setq entry (assoc name (plstore--get-secret-alist plstore)))
387 (plstore--set-secret-alist
389 (delq entry (plstore--get-secret-alist plstore))))
390 (setq entry (assoc name (plstore--get-merged-alist plstore)))
392 (plstore--set-merged-alist
394 (delq entry (plstore--get-merged-alist plstore))))))
396 (defvar pp-escape-newlines)
397 (defun plstore--insert-buffer (plstore)
398 (insert ";;; public entries -*- mode: plstore -*- \n"
399 (pp-to-string (plstore--get-alist plstore)))
400 (if (plstore--get-secret-alist plstore)
401 (let ((context (epg-make-context 'OpenPGP))
402 (pp-escape-newlines nil)
405 ((listp plstore-encrypt-to) plstore-encrypt-to)
406 ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
408 (epg-context-set-armor context t)
409 (epg-context-set-passphrase-callback
411 (cons #'plstore-passphrase-callback-function
413 (setq cipher (epg-encrypt-string
416 (plstore--get-secret-alist plstore))
417 (if (or (eq plstore-select-keys t)
418 (and (null plstore-select-keys)
419 (not (local-variable-p 'plstore-encrypt-to
423 "Select recipients for encryption.
424 If no one is selected, symmetric encryption will be performed. "
426 (if plstore-encrypt-to
427 (epg-list-keys context recipients)))))
428 (goto-char (point-max))
429 (insert ";;; secret entries\n" (pp-to-string cipher)))))
431 (defun plstore-save (plstore)
432 "Save the contents of PLSTORE associated with a FILE."
433 (with-current-buffer (plstore--get-buffer plstore)
435 (plstore--insert-buffer plstore)
440 ;;; plstore.el ends here