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 (defvar pp-escape-newlines
)
341 (defun plstore-save (plstore)
342 "Save the contents of PLSTORE associated with a FILE."
343 (with-current-buffer (plstore--get-buffer plstore
)
345 (insert ";;; public entries -*- mode: emacs-lisp -*- \n"
346 (pp-to-string (plstore--get-alist plstore
)))
347 (if (plstore--get-secret-alist plstore
)
348 (let ((context (epg-make-context 'OpenPGP
))
349 (pp-escape-newlines nil
)
352 ((listp plstore-encrypt-to
) plstore-encrypt-to
)
353 ((stringp plstore-encrypt-to
) (list plstore-encrypt-to
))))
355 (epg-context-set-armor context t
)
356 (epg-context-set-passphrase-callback
358 (cons #'plstore-passphrase-callback-function
360 (setq cipher
(epg-encrypt-string
363 (plstore--get-secret-alist plstore
))
364 (if (or (eq plstore-select-keys t
)
365 (and (null plstore-select-keys
)
366 (not (local-variable-p 'plstore-encrypt-to
370 "Select recipents for encryption.
371 If no one is selected, symmetric encryption will be performed. "
373 (if plstore-encrypt-to
374 (epg-list-keys context recipients
)))))
375 (goto-char (point-max))
376 (insert ";;; secret entries\n" (pp-to-string cipher
))))
381 ;;; plstore.el ends here