1 ;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
2 ;; Copyright (C) 2011 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 `plstore-encrypt-to' is not set.
84 If neither t nor nil, doesn't ask user. In this case, symmetric
86 :type '(choice (const :tag "Ask always" t)
87 (const :tag "Ask when recipients are not set" nil)
88 (const :tag "Don't ask" silent))
91 (defvar plstore-encrypt-to nil
92 "*Recipient(s) used for encrypting secret entries.
93 May either be a string or a list of strings.")
95 (put 'plstore-encrypt-to 'safe-local-variable
101 (unless (stringp elt)
106 (put 'plstore-encrypt-to 'permanent-local t)
108 (defvar plstore-cache-passphrase-for-symmetric-encryption nil)
109 (defvar plstore-passphrase-alist nil)
111 (defun plstore-passphrase-callback-function (_context _key-id plstore)
112 (if plstore-cache-passphrase-for-symmetric-encryption
113 (let* ((file (file-truename (plstore--get-buffer plstore)))
114 (entry (assoc file plstore-passphrase-alist))
116 (or (copy-sequence (cdr entry))
119 (setq entry (list file)
120 plstore-passphrase-alist
122 plstore-passphrase-alist)))
124 (read-passwd (format "Passphrase for PLSTORE %s: "
125 (plstore--get-buffer plstore))))
126 (setcdr entry (copy-sequence passphrase))
128 (read-passwd (format "Passphrase for PLSTORE %s: "
129 (plstore--get-buffer plstore)))))
131 (defun plstore-progress-callback-function (_context _what _char current total
133 (if (= current total)
134 (message "%s...done" handback)
135 (message "%s...%d%%" handback
136 (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
138 (defun plstore--get-buffer (arg)
141 (defun plstore--get-alist (arg)
144 (defun plstore--get-encrypted-data (arg)
147 (defun plstore--get-secret-alist (arg)
150 (defun plstore--get-merged-alist (arg)
153 (defun plstore--set-buffer (arg buffer)
156 (defun plstore--set-alist (arg plist)
159 (defun plstore--set-encrypted-data (arg encrypted-data)
160 (aset arg 2 encrypted-data))
162 (defun plstore--set-secret-alist (arg secret-alist)
163 (aset arg 3 secret-alist))
165 (defun plstore--set-merged-alist (arg merged-alist)
166 (aset arg 4 merged-alist))
168 (defun plstore-get-file (arg)
169 (buffer-file-name (plstore--get-buffer arg)))
171 (defun plstore--make (&optional buffer alist encrypted-data secret-alist
173 (vector buffer alist encrypted-data secret-alist merged-alist))
175 (defun plstore--init-from-buffer (plstore)
176 (goto-char (point-min))
177 (when (looking-at ";;; public entries")
179 (plstore--set-alist plstore (read (point-marker)))
182 (when (looking-at ";;; secret entries")
184 (plstore--set-encrypted-data plstore (read (point-marker))))
185 (plstore--merge-secret plstore)))
188 (defun plstore-open (file)
189 "Create a plstore instance associated with FILE."
190 (let* ((filename (file-truename file))
191 (buffer (or (find-buffer-visiting filename)
192 (generate-new-buffer (format " plstore %s" filename))))
193 (store (plstore--make buffer)))
194 (with-current-buffer buffer
195 ;; In the future plstore will provide a major mode called
196 ;; `plstore-mode' to edit PLSTORE files.
197 (if (eq major-mode 'plstore-mode)
198 (error "%s is opened for editing; kill the buffer first" file))
201 (insert-file-contents-literally file)
203 (setq buffer-file-name (file-truename file))
204 (set-buffer-modified-p nil)
205 (plstore--init-from-buffer store)
208 (defun plstore-revert (plstore)
209 "Replace current data in PLSTORE with the file on disk."
210 (with-current-buffer (plstore--get-buffer plstore)
212 (plstore--init-from-buffer plstore)))
214 (defun plstore-close (plstore)
215 "Destroy a plstore instance PLSTORE."
216 (kill-buffer (plstore--get-buffer plstore)))
218 (defun plstore--merge-secret (plstore)
219 (let ((alist (plstore--get-secret-alist plstore))
226 (plstore--set-merged-alist
228 (copy-tree (plstore--get-alist plstore)))
229 (setq modified-alist (plstore--get-merged-alist plstore))
231 (setq entry (car alist)
234 modified-entry (assoc (car entry) modified-alist)
235 modified-plist (cdr modified-entry))
240 (intern (concat ":secret-"
241 (substring (symbol-name (car plist)) 1)))))
243 (setcar placeholder (car plist)))
245 (plist-put modified-plist (car plist) (car (cdr plist))))
246 (setq plist (nthcdr 2 plist)))
247 (setcdr modified-entry modified-plist))))
249 (defun plstore--decrypt (plstore)
250 (if (plstore--get-encrypted-data plstore)
251 (let ((context (epg-make-context 'OpenPGP))
253 (epg-context-set-passphrase-callback
255 (cons #'plstore-passphrase-callback-function
257 (epg-context-set-progress-callback
259 (cons #'plstore-progress-callback-function
260 (format "Decrypting %s" (plstore-get-file plstore))))
262 (epg-decrypt-string context
263 (plstore--get-encrypted-data plstore)))
264 (plstore--set-secret-alist plstore (car (read-from-string plain)))
265 (plstore--merge-secret plstore)
266 (plstore--set-encrypted-data plstore nil))))
268 (defun plstore--match (entry keys skip-if-secret-found)
269 (let ((result t) key-name key-value prop-value secret-name)
271 (setq key-name (car keys)
272 key-value (car (cdr keys))
273 prop-value (plist-get (cdr entry) key-name))
274 (unless (member prop-value key-value)
275 (if skip-if-secret-found
278 (intern (concat ":secret-"
279 (substring (symbol-name key-name) 1))))
280 (if (plist-member (cdr entry) secret-name)
281 (setq result 'secret)
286 (setq keys (nthcdr 2 keys)))
289 (defun plstore-find (plstore keys)
290 "Perform search on PLSTORE with KEYS.
292 (let (entries alist entry match decrypt plist)
293 ;; First, go through the merged plist alist and collect entries
294 ;; matched with keys.
295 (setq alist (plstore--get-merged-alist plstore))
297 (setq entry (car alist)
299 match (plstore--match entry keys t))
300 (if (eq match 'secret)
303 (setq plist (cdr entry))
305 (if (string-match "\\`:secret-" (symbol-name (car plist)))
308 (setq plist (nthcdr 2 plist)))
309 (setq entries (cons entry entries)))))
310 ;; Second, decrypt the encrypted plist and try again.
313 (plstore--decrypt plstore)
314 (setq alist (plstore--get-merged-alist plstore))
316 (setq entry (car alist)
318 match (plstore--match entry keys nil))
320 (setq entries (cons entry entries)))))
323 (defun plstore-get (plstore name)
324 "Get an entry with NAME in PLSTORE."
325 (let ((entry (assoc name (plstore--get-merged-alist plstore)))
327 (setq plist (cdr entry))
329 (if (string-match "\\`:secret-" (symbol-name (car plist)))
331 (plstore--decrypt plstore)
332 (setq entry (assoc name (plstore--get-merged-alist plstore))
334 (setq plist (nthcdr 2 plist))))
337 (defun plstore-put (plstore name keys secret-keys)
338 "Put an entry with NAME in PLSTORE.
339 KEYS is a plist containing non-secret data.
340 SECRET-KEYS is a plist containing secret data."
346 (plstore--decrypt plstore))
349 (intern (concat ":secret-"
350 (substring (symbol-name (car secret-keys)) 1))))
351 (setq plist (plist-put plist symbol t)
352 secret-plist (plist-put secret-plist
353 (car secret-keys) (car (cdr secret-keys)))
354 secret-keys (nthcdr 2 secret-keys)))
357 (intern (concat ":secret-"
358 (substring (symbol-name (car keys)) 1))))
359 (setq plist (plist-put plist (car keys) (car (cdr keys)))
360 keys (nthcdr 2 keys)))
361 (setq entry (assoc name (plstore--get-alist plstore)))
366 (cons (cons name plist) (plstore--get-alist plstore))))
368 (setq entry (assoc name (plstore--get-secret-alist plstore)))
370 (setcdr entry secret-plist)
371 (plstore--set-secret-alist
373 (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
374 (plstore--merge-secret plstore)))
376 (defun plstore-delete (plstore name)
377 "Delete an entry with NAME from PLSTORE."
378 (let ((entry (assoc name (plstore--get-alist plstore))))
382 (delq entry (plstore--get-alist plstore))))
383 (setq entry (assoc name (plstore--get-secret-alist plstore)))
385 (plstore--set-secret-alist
387 (delq entry (plstore--get-secret-alist plstore))))
388 (setq entry (assoc name (plstore--get-merged-alist plstore)))
390 (plstore--set-merged-alist
392 (delq entry (plstore--get-merged-alist plstore))))))
394 (defvar pp-escape-newlines)
395 (defun plstore--insert-buffer (plstore)
396 (insert ";;; public entries -*- mode: plstore -*- \n"
397 (pp-to-string (plstore--get-alist plstore)))
398 (if (plstore--get-secret-alist plstore)
399 (let ((context (epg-make-context 'OpenPGP))
400 (pp-escape-newlines nil)
403 ((listp plstore-encrypt-to) plstore-encrypt-to)
404 ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
406 (epg-context-set-armor context t)
407 (epg-context-set-passphrase-callback
409 (cons #'plstore-passphrase-callback-function
411 (setq cipher (epg-encrypt-string
414 (plstore--get-secret-alist plstore))
415 (if (or (eq plstore-select-keys t)
416 (and (null plstore-select-keys)
417 (not (local-variable-p 'plstore-encrypt-to
421 "Select recipents for encryption.
422 If no one is selected, symmetric encryption will be performed. "
424 (if plstore-encrypt-to
425 (epg-list-keys context recipients)))))
426 (goto-char (point-max))
427 (insert ";;; secret entries\n" (pp-to-string cipher)))))
429 (defun plstore-save (plstore)
430 "Save the contents of PLSTORE associated with a FILE."
431 (with-current-buffer (plstore--get-buffer plstore)
433 (plstore--insert-buffer plstore)
438 ;;; plstore.el ends here