1 ;;; plstore.el --- searchable, partially encrypted, persistent 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/>.
26 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
27 ;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil)
28 ;; (plstore-save store)
29 ;; ;; :user property is secret
30 ;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test"))
31 ;; (plstore-put store "baz" '(:host "baz.example.org") '(:user "test"))
32 ;; (plstore-save store) ;<= will ask passphrase via GPG
33 ;; (plstore-close store)
37 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
38 ;; (plstore-find store '(:host ("foo.example.org")))
39 ;; (plstore-find store '(:host ("bar.example.org"))) ;<= will ask passphrase via GPG
40 ;; (plstore-close store)
48 "Searchable, partially encrypted, persistent plist store"
52 (defcustom plstore-select-keys 'silent
53 "Control whether or not to pop up the key selection dialog.
55 If t, always asks user to select recipients.
56 If nil, query user only when `plstore-encrypt-to' is not set.
57 If neither t nor nil, doesn't ask user. In this case, symmetric
59 :type '(choice (const :tag "Ask always" t)
60 (const :tag "Ask when recipients are not set" nil)
61 (const :tag "Don't ask" silent))
64 (defvar plstore-encrypt-to nil
65 "*Recipient(s) used for encrypting secret entries.
66 May either be a string or a list of strings.")
68 (put 'plstore-encrypt-to 'safe-local-variable
79 (put 'plstore-encrypt-to 'permanent-local t)
81 (defvar plstore-cache-passphrase-for-symmetric-encryption nil)
82 (defvar plstore-passphrase-alist nil)
84 (defun plstore-passphrase-callback-function (_context _key-id plstore)
85 (if plstore-cache-passphrase-for-symmetric-encryption
86 (let* ((file (file-truename (plstore--get-buffer plstore)))
87 (entry (assoc file plstore-passphrase-alist))
89 (or (copy-sequence (cdr entry))
92 (setq entry (list file)
93 plstore-passphrase-alist
95 plstore-passphrase-alist)))
97 (read-passwd (format "Passphrase for PLSTORE %s: "
98 (plstore--get-buffer plstore))))
99 (setcdr entry (copy-sequence passphrase))
101 (read-passwd (format "Passphrase for PLSTORE %s: "
102 (plstore--get-buffer plstore)))))
104 (defun plstore-progress-callback-function (_context _what _char current total
106 (if (= current total)
107 (message "%s...done" handback)
108 (message "%s...%d%%" handback
109 (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
111 (defun plstore--get-buffer (this)
114 (defun plstore--get-alist (this)
117 (defun plstore--get-encrypted-data (this)
120 (defun plstore--get-secret-alist (this)
123 (defun plstore--get-merged-alist (this)
126 (defun plstore--set-file (this file)
129 (defun plstore--set-alist (this plist)
132 (defun plstore--set-encrypted-data (this encrypted-data)
133 (aset this 2 encrypted-data))
135 (defun plstore--set-secret-alist (this secret-alist)
136 (aset this 3 secret-alist))
138 (defun plstore--set-merged-alist (this merged-alist)
139 (aset this 4 merged-alist))
141 (defun plstore-get-file (this)
142 (buffer-file-name (plstore--get-buffer this)))
144 (defun plstore--init-from-buffer (plstore)
145 (goto-char (point-min))
146 (when (looking-at ";;; public entries")
148 (plstore--set-alist plstore (read (point-marker)))
151 (when (looking-at ";;; secret entries")
153 (plstore--set-encrypted-data plstore (read (point-marker))))
154 (plstore--merge-secret plstore)))
157 (defun plstore-open (file)
158 "Create a plstore instance associated with FILE."
159 (with-current-buffer (find-file-noselect file)
160 ;; make the buffer invisible from user
161 (rename-buffer (format " plstore %s" (buffer-file-name)))
165 nil ;encrypted data (string)
166 nil ;secret plist (plist)
167 nil ;merged plist (plist)
169 (plstore--init-from-buffer store)
172 (defun plstore-revert (plstore)
173 "Replace current data in PLSTORE with the file on disk."
174 (with-current-buffer (plstore--get-buffer plstore)
176 (plstore--init-from-buffer plstore)))
178 (defun plstore-close (plstore)
179 "Destroy a plstore instance PLSTORE."
180 (kill-buffer (plstore--get-buffer plstore)))
182 (defun plstore--merge-secret (plstore)
183 (let ((alist (plstore--get-secret-alist plstore))
190 (plstore--set-merged-alist
192 (copy-tree (plstore--get-alist plstore)))
193 (setq modified-alist (plstore--get-merged-alist plstore))
195 (setq entry (car alist)
198 modified-entry (assoc (car entry) modified-alist)
199 modified-plist (cdr modified-entry))
204 (intern (concat ":secret-"
205 (substring (symbol-name (car plist)) 1)))))
207 (setcar placeholder (car plist)))
209 (plist-put modified-plist (car plist) (car (cdr plist))))
210 (setq plist (nthcdr 2 plist)))
211 (setcdr modified-entry modified-plist))))
213 (defun plstore--decrypt (plstore)
214 (if (plstore--get-encrypted-data plstore)
215 (let ((context (epg-make-context 'OpenPGP))
217 (epg-context-set-passphrase-callback
219 (cons #'plstore-passphrase-callback-function
221 (epg-context-set-progress-callback
223 (cons #'plstore-progress-callback-function
224 (format "Decrypting %s" (plstore-get-file plstore))))
226 (epg-decrypt-string context
227 (plstore--get-encrypted-data plstore)))
228 (plstore--set-secret-alist plstore (car (read-from-string plain)))
229 (plstore--merge-secret plstore)
230 (plstore--set-encrypted-data plstore nil))))
232 (defun plstore--match (entry keys skip-if-secret-found)
233 (let ((result t) key-name key-value prop-value secret-name)
235 (setq key-name (car keys)
236 key-value (car (cdr keys))
237 prop-value (plist-get (cdr entry) key-name))
238 (unless (member prop-value key-value)
239 (if skip-if-secret-found
242 (intern (concat ":secret-"
243 (substring (symbol-name key-name) 1))))
244 (if (plist-member (cdr entry) secret-name)
245 (setq result 'secret)
250 (setq keys (nthcdr 2 keys)))
253 (defun plstore-find (plstore keys)
254 "Perform search on PLSTORE with KEYS.
256 (let (entries alist entry match decrypt plist)
257 ;; First, go through the merged plist alist and collect entries
258 ;; matched with keys.
259 (setq alist (plstore--get-merged-alist plstore))
261 (setq entry (car alist)
263 match (plstore--match entry keys t))
264 (if (eq match 'secret)
267 (setq plist (cdr entry))
269 (if (string-match "\\`:secret-" (symbol-name (car plist)))
272 (setq plist (nthcdr 2 plist)))
273 (setq entries (cons entry entries)))))
274 ;; Second, decrypt the encrypted plist and try again.
277 (plstore--decrypt plstore)
278 (setq alist (plstore--get-merged-alist plstore))
280 (setq entry (car alist)
282 match (plstore--match entry keys nil))
284 (setq entries (cons entry entries)))))
287 (defun plstore-get (plstore name)
288 "Get an entry with NAME in PLSTORE."
289 (let ((entry (assoc name (plstore--get-merged-alist plstore)))
291 (setq plist (cdr entry))
293 (if (string-match "\\`:secret-" (symbol-name (car plist)))
295 (plstore--decrypt plstore)
296 (setq entry (assoc name (plstore--get-merged-alist plstore))
298 (setq plist (nthcdr 2 plist))))
301 (defun plstore-put (plstore name keys secret-keys)
302 "Put an entry with NAME in PLSTORE.
303 KEYS is a plist containing non-secret data.
304 SECRET-KEYS is a plist containing secret data."
310 (plstore--decrypt plstore))
313 (intern (concat ":secret-"
314 (substring (symbol-name (car secret-keys)) 1))))
315 (setq plist (plist-put plist symbol t)
316 secret-plist (plist-put secret-plist
317 (car secret-keys) (car (cdr secret-keys)))
318 secret-keys (nthcdr 2 secret-keys)))
321 (intern (concat ":secret-"
322 (substring (symbol-name (car keys)) 1))))
323 (setq plist (plist-put plist (car keys) (car (cdr keys)))
324 keys (nthcdr 2 keys)))
325 (setq entry (assoc name (plstore--get-alist plstore)))
330 (cons (cons name plist) (plstore--get-alist plstore))))
332 (setq entry (assoc name (plstore--get-secret-alist plstore)))
334 (setcdr entry secret-plist)
335 (plstore--set-secret-alist
337 (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
338 (plstore--merge-secret plstore)))
340 (defun plstore-delete (plstore name)
341 "Delete an entry with NAME from PLSTORE."
342 (let ((entry (assoc name (plstore--get-alist plstore))))
346 (delq entry (plstore--get-alist plstore))))
347 (setq entry (assoc name (plstore--get-secret-alist plstore)))
349 (plstore--set-secret-alist
351 (delq entry (plstore--get-secret-alist plstore))))
352 (setq entry (assoc name (plstore--get-merged-alist plstore)))
354 (plstore--set-merged-alist
356 (delq entry (plstore--get-merged-alist plstore))))))
358 (defvar pp-escape-newlines)
359 (defun plstore-save (plstore)
360 "Save the contents of PLSTORE associated with a FILE."
361 (with-current-buffer (plstore--get-buffer plstore)
363 (insert ";;; public entries -*- mode: emacs-lisp -*- \n"
364 (pp-to-string (plstore--get-alist plstore)))
365 (if (plstore--get-secret-alist plstore)
366 (let ((context (epg-make-context 'OpenPGP))
367 (pp-escape-newlines nil)
370 ((listp plstore-encrypt-to) plstore-encrypt-to)
371 ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
373 (epg-context-set-armor context t)
374 (epg-context-set-passphrase-callback
376 (cons #'plstore-passphrase-callback-function
378 (setq cipher (epg-encrypt-string
381 (plstore--get-secret-alist plstore))
382 (if (or (eq plstore-select-keys t)
383 (and (null plstore-select-keys)
384 (not (local-variable-p 'plstore-encrypt-to
388 "Select recipents for encryption.
389 If no one is selected, symmetric encryption will be performed. "
391 (if plstore-encrypt-to
392 (epg-list-keys context recipients)))))
393 (goto-char (point-max))
394 (insert ";;; secret entries\n" (pp-to-string cipher))))
399 ;;; plstore.el ends here