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)
47 (defvar plstore-cache-passphrase-for-symmetric-encryption nil)
48 (defvar plstore-passphrase-alist nil)
50 (defun plstore-passphrase-callback-function (_context _key-id plstore)
51 (if plstore-cache-passphrase-for-symmetric-encryption
52 (let* ((file (file-truename (plstore--get-buffer plstore)))
53 (entry (assoc file plstore-passphrase-alist))
55 (or (copy-sequence (cdr entry))
58 (setq entry (list file)
59 plstore-passphrase-alist
61 plstore-passphrase-alist)))
63 (read-passwd (format "Passphrase for PLSTORE %s: "
64 (plstore--get-buffer plstore))))
65 (setcdr entry (copy-sequence passphrase))
67 (read-passwd (format "Passphrase for PLSTORE %s: "
68 (plstore--get-buffer plstore)))))
70 (defun plstore-progress-callback-function (_context _what _char current total
73 (message "%s...done" handback)
74 (message "%s...%d%%" handback
75 (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
77 (defun plstore--get-buffer (this)
80 (defun plstore--get-alist (this)
83 (defun plstore--get-encrypted-data (this)
86 (defun plstore--get-secret-alist (this)
89 (defun plstore--get-merged-alist (this)
92 (defun plstore--set-file (this file)
95 (defun plstore--set-alist (this plist)
98 (defun plstore--set-encrypted-data (this encrypted-data)
99 (aset this 2 encrypted-data))
101 (defun plstore--set-secret-alist (this secret-alist)
102 (aset this 3 secret-alist))
104 (defun plstore--set-merged-alist (this merged-alist)
105 (aset this 4 merged-alist))
107 (defun plstore-get-file (this)
108 (buffer-file-name (plstore--get-buffer this)))
111 (defun plstore-open (file)
112 "Create a plstore instance associated with FILE."
114 (find-file-noselect file)
116 nil ;encrypted data (string)
117 nil ;secret plist (plist)
118 nil ;merged plist (plist)
120 (plstore-revert store)
123 (defun plstore-revert (plstore)
124 "Replace current data in PLSTORE with the file on disk."
125 (with-current-buffer (plstore--get-buffer plstore)
126 ;; make the buffer invisible from user
127 (rename-buffer (format " plstore %s" (buffer-file-name)))
128 (goto-char (point-min))
129 (when (looking-at ";;; public entries\n")
131 (plstore--set-alist plstore (read (point-marker)))
134 (when (looking-at ";;; secret entries\n")
136 (plstore--set-encrypted-data plstore (read (point-marker))))
137 (plstore--merge-secret plstore))))
139 (defun plstore-close (plstore)
140 "Destroy a plstore instance PLSTORE."
141 (kill-buffer (plstore--get-buffer plstore)))
143 (defun plstore--merge-secret (plstore)
144 (let ((alist (plstore--get-secret-alist plstore))
151 (plstore--set-merged-alist
153 (copy-tree (plstore--get-alist plstore)))
154 (setq modified-alist (plstore--get-merged-alist plstore))
156 (setq entry (car alist)
159 modified-entry (assoc (car entry) modified-alist)
160 modified-plist (cdr modified-entry))
165 (intern (concat ":secret-"
166 (substring (symbol-name (car plist)) 1)))))
168 (setcar placeholder (car plist)))
170 (plist-put modified-plist (car plist) (car (cdr plist))))
171 (setq plist (nthcdr 2 plist)))
172 (setcdr modified-entry modified-plist))))
174 (defun plstore--decrypt (plstore)
175 (if (plstore--get-encrypted-data plstore)
176 (let ((context (epg-make-context 'OpenPGP))
178 (epg-context-set-passphrase-callback
180 (cons #'plstore-passphrase-callback-function
182 (epg-context-set-progress-callback
184 (cons #'plstore-progress-callback-function
185 (format "Decrypting %s" (plstore-get-file plstore))))
187 (epg-decrypt-string context
188 (plstore--get-encrypted-data plstore)))
189 (plstore--set-secret-alist plstore (car (read-from-string plain)))
190 (plstore--merge-secret plstore)
191 (plstore--set-encrypted-data plstore nil))))
193 (defun plstore--match (entry keys skip-if-secret-found)
194 (let ((result t) key-name key-value prop-value secret-name)
196 (setq key-name (car keys)
197 key-value (car (cdr keys))
198 prop-value (plist-get (cdr entry) key-name))
199 (unless (member prop-value key-value)
200 (if skip-if-secret-found
203 (intern (concat ":secret-"
204 (substring (symbol-name key-name) 1))))
205 (if (plist-member (cdr entry) secret-name)
206 (setq result 'secret)
211 (setq keys (nthcdr 2 keys)))
214 (defun plstore-find (plstore keys)
215 "Perform search on PLSTORE with KEYS.
217 (let (entries alist entry match decrypt plist)
218 ;; First, go through the merged plist alist and collect entries
219 ;; matched with keys.
220 (setq alist (plstore--get-merged-alist plstore))
222 (setq entry (car alist)
224 match (plstore--match entry keys t))
225 (if (eq match 'secret)
228 (setq plist (cdr entry))
230 (if (string-match "\\`:secret-" (symbol-name (car plist)))
233 (setq plist (nthcdr 2 plist)))
234 (setq entries (cons entry entries)))))
235 ;; Second, decrypt the encrypted plist and try again.
238 (plstore--decrypt plstore)
239 (setq alist (plstore--get-merged-alist plstore))
241 (setq entry (car alist)
243 match (plstore--match entry keys nil))
245 (setq entries (cons entry entries)))))
248 (defun plstore-get (plstore name)
249 "Get an entry with NAME in PLSTORE."
250 (let ((entry (assoc name (plstore--get-merged-alist plstore)))
252 (setq plist (cdr entry))
254 (if (string-match "\\`:secret-" (symbol-name (car plist)))
256 (plstore--decrypt plstore)
257 (setq entry (assoc name (plstore--get-merged-alist plstore))
259 (setq plist (nthcdr 2 plist))))
262 (defun plstore-put (plstore name keys secret-keys)
263 "Put an entry with NAME in PLSTORE.
264 KEYS is a plist containing non-secret data.
265 SECRET-KEYS is a plist containing secret data."
271 (plstore--decrypt plstore))
274 (intern (concat ":secret-"
275 (substring (symbol-name (car secret-keys)) 1))))
276 (setq plist (plist-put plist symbol t)
277 secret-plist (plist-put secret-plist
278 (car secret-keys) (car (cdr secret-keys)))
279 secret-keys (nthcdr 2 secret-keys)))
282 (intern (concat ":secret-"
283 (substring (symbol-name (car keys)) 1))))
284 (setq plist (plist-put plist (car keys) (car (cdr keys)))
285 keys (nthcdr 2 keys)))
286 (setq entry (assoc name (plstore--get-alist plstore)))
291 (cons (cons name plist) (plstore--get-alist plstore))))
293 (setq entry (assoc name (plstore--get-secret-alist plstore)))
295 (setcdr entry secret-plist)
296 (plstore--set-secret-alist
298 (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
299 (plstore--merge-secret plstore)))
301 (defvar pp-escape-newlines)
302 (defun plstore-save (plstore)
303 "Save the contents of PLSTORE associated with a FILE."
304 (with-current-buffer (plstore--get-buffer plstore)
306 (insert ";;; public entries\n" (pp-to-string (plstore--get-alist plstore)))
307 (if (plstore--get-secret-alist plstore)
308 (let ((context (epg-make-context 'OpenPGP))
309 (pp-escape-newlines nil)
311 (epg-context-set-armor context t)
312 (epg-context-set-passphrase-callback
314 (cons #'plstore-passphrase-callback-function
316 (setq cipher (epg-encrypt-string context
318 (plstore--get-secret-alist plstore))
320 (insert ";;; secret entries\n" (pp-to-string cipher))))
325 ;;; plstore.el ends here