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 ;; This file also provides `plstore-mode', a major mode for editing
68 ;; the PLSTORE format file. Visit a non-existing file and put the
71 ;; (("foo" :host "foo.example.org" :secret-user "user"))
73 ;; where the prefixing `:secret-' means the property (without
74 ;; `:secret-' prefix) is marked as secret. Thus, when you save the
75 ;; buffer, the `:secret-user' property is encrypted as `:user'.
77 ;; You can toggle the view between encrypted form and the decrypted
85 "Searchable, partially encrypted, persistent plist store"
89 (defcustom plstore-select-keys 'silent
90 "Control whether or not to pop up the key selection dialog.
92 If t, always asks user to select recipients.
93 If nil, query user only when a file's default recipients are not
94 known (i.e. `plstore-encrypt-to' is not locally set in the buffer
95 visiting a plstore file).
96 If neither t nor nil, doesn't ask user."
97 :type '(choice (const :tag "Ask always" t)
98 (const :tag "Ask when recipients are not set" nil)
99 (const :tag "Don't ask" silent))
102 (defvar plstore-encrypt-to nil
103 "*Recipient(s) used for encrypting secret entries.
104 May either be a string or a list of strings. If it is nil,
105 symmetric encryption will be used.")
107 (put 'plstore-encrypt-to 'safe-local-variable
113 (unless (stringp elt)
118 (put 'plstore-encrypt-to 'permanent-local t)
120 (defvar plstore-encoded nil)
122 (put 'plstore-encoded 'permanent-local t)
124 (defvar plstore-cache-passphrase-for-symmetric-encryption nil)
125 (defvar plstore-passphrase-alist nil)
127 (defun plstore-passphrase-callback-function (_context _key-id plstore)
128 (if plstore-cache-passphrase-for-symmetric-encryption
129 (let* ((file (file-truename (plstore-get-file plstore)))
130 (entry (assoc file plstore-passphrase-alist))
132 (or (copy-sequence (cdr entry))
135 (setq entry (list file)
136 plstore-passphrase-alist
138 plstore-passphrase-alist)))
140 (read-passwd (format "Passphrase for PLSTORE %s: "
141 (plstore--get-buffer plstore))))
142 (setcdr entry (copy-sequence passphrase))
144 (read-passwd (format "Passphrase for PLSTORE %s: "
145 (plstore--get-buffer plstore)))))
147 (defun plstore-progress-callback-function (_context _what _char current total
149 (if (= current total)
150 (message "%s...done" handback)
151 (message "%s...%d%%" handback
152 (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
154 (defun plstore--get-buffer (arg)
157 (defun plstore--get-alist (arg)
160 (defun plstore--get-encrypted-data (arg)
163 (defun plstore--get-secret-alist (arg)
166 (defun plstore--get-merged-alist (arg)
169 (defun plstore--set-buffer (arg buffer)
172 (defun plstore--set-alist (arg plist)
175 (defun plstore--set-encrypted-data (arg encrypted-data)
176 (aset arg 2 encrypted-data))
178 (defun plstore--set-secret-alist (arg secret-alist)
179 (aset arg 3 secret-alist))
181 (defun plstore--set-merged-alist (arg merged-alist)
182 (aset arg 4 merged-alist))
184 (defun plstore-get-file (arg)
185 (buffer-file-name (plstore--get-buffer arg)))
187 (defun plstore--make (&optional buffer alist encrypted-data secret-alist
189 (vector buffer alist encrypted-data secret-alist merged-alist))
191 (defun plstore--init-from-buffer (plstore)
192 (goto-char (point-min))
193 (when (looking-at ";;; public entries")
195 (plstore--set-alist plstore (read (point-marker)))
198 (when (looking-at ";;; secret entries")
200 (plstore--set-encrypted-data plstore (read (point-marker))))
201 (plstore--merge-secret plstore)))
204 (defun plstore-open (file)
205 "Create a plstore instance associated with FILE."
206 (let* ((filename (file-truename file))
207 (buffer (or (find-buffer-visiting filename)
208 (generate-new-buffer (format " plstore %s" filename))))
209 (store (plstore--make buffer)))
210 (with-current-buffer buffer
213 (insert-file-contents-literally file)
215 (setq buffer-file-name (file-truename file))
216 (set-buffer-modified-p nil)
217 (plstore--init-from-buffer store)
220 (defun plstore-revert (plstore)
221 "Replace current data in PLSTORE with the file on disk."
222 (with-current-buffer (plstore--get-buffer plstore)
224 (plstore--init-from-buffer plstore)))
226 (defun plstore-close (plstore)
227 "Destroy a plstore instance PLSTORE."
228 (kill-buffer (plstore--get-buffer plstore)))
230 (defun plstore--merge-secret (plstore)
231 (let ((alist (plstore--get-secret-alist plstore))
238 (plstore--set-merged-alist
240 (copy-tree (plstore--get-alist plstore)))
241 (setq modified-alist (plstore--get-merged-alist plstore))
243 (setq entry (car alist)
246 modified-entry (assoc (car entry) modified-alist)
247 modified-plist (cdr modified-entry))
252 (intern (concat ":secret-"
253 (substring (symbol-name (car plist)) 1)))))
255 (setcar placeholder (car plist)))
257 (plist-put modified-plist (car plist) (car (cdr plist))))
258 (setq plist (nthcdr 2 plist)))
259 (setcdr modified-entry modified-plist))))
261 (defun plstore--decrypt (plstore)
262 (if (plstore--get-encrypted-data plstore)
263 (let ((context (epg-make-context 'OpenPGP))
265 (epg-context-set-passphrase-callback
267 (cons #'plstore-passphrase-callback-function
269 (epg-context-set-progress-callback
271 (cons #'plstore-progress-callback-function
272 (format "Decrypting %s" (plstore-get-file plstore))))
274 (epg-decrypt-string context
275 (plstore--get-encrypted-data plstore)))
276 (plstore--set-secret-alist plstore (car (read-from-string plain)))
277 (plstore--merge-secret plstore)
278 (plstore--set-encrypted-data plstore nil))))
280 (defun plstore--match (entry keys skip-if-secret-found)
281 (let ((result t) key-name key-value prop-value secret-name)
283 (setq key-name (car keys)
284 key-value (car (cdr keys))
285 prop-value (plist-get (cdr entry) key-name))
286 (unless (member prop-value key-value)
287 (if skip-if-secret-found
290 (intern (concat ":secret-"
291 (substring (symbol-name key-name) 1))))
292 (if (plist-member (cdr entry) secret-name)
293 (setq result 'secret)
298 (setq keys (nthcdr 2 keys)))
301 (defun plstore-find (plstore keys)
302 "Perform search on PLSTORE with KEYS.
304 (let (entries alist entry match decrypt plist)
305 ;; First, go through the merged plist alist and collect entries
306 ;; matched with keys.
307 (setq alist (plstore--get-merged-alist plstore))
309 (setq entry (car alist)
311 match (plstore--match entry keys t))
312 (if (eq match 'secret)
315 (setq plist (cdr entry))
317 (if (string-match "\\`:secret-" (symbol-name (car plist)))
320 (setq plist (nthcdr 2 plist)))
321 (setq entries (cons entry entries)))))
322 ;; Second, decrypt the encrypted plist and try again.
325 (plstore--decrypt plstore)
326 (setq alist (plstore--get-merged-alist plstore))
328 (setq entry (car alist)
330 match (plstore--match entry keys nil))
332 (setq entries (cons entry entries)))))
335 (defun plstore-get (plstore name)
336 "Get an entry with NAME in PLSTORE."
337 (let ((entry (assoc name (plstore--get-merged-alist plstore)))
339 (setq plist (cdr entry))
341 (if (string-match "\\`:secret-" (symbol-name (car plist)))
343 (plstore--decrypt plstore)
344 (setq entry (assoc name (plstore--get-merged-alist plstore))
346 (setq plist (nthcdr 2 plist))))
349 (defun plstore-put (plstore name keys secret-keys)
350 "Put an entry with NAME in PLSTORE.
351 KEYS is a plist containing non-secret data.
352 SECRET-KEYS is a plist containing secret data."
358 (plstore--decrypt plstore))
361 (intern (concat ":secret-"
362 (substring (symbol-name (car secret-keys)) 1))))
363 (setq plist (plist-put plist symbol t)
364 secret-plist (plist-put secret-plist
365 (car secret-keys) (car (cdr secret-keys)))
366 secret-keys (nthcdr 2 secret-keys)))
369 (intern (concat ":secret-"
370 (substring (symbol-name (car keys)) 1))))
371 (setq plist (plist-put plist (car keys) (car (cdr keys)))
372 keys (nthcdr 2 keys)))
373 (setq entry (assoc name (plstore--get-alist plstore)))
378 (cons (cons name plist) (plstore--get-alist plstore))))
380 (setq entry (assoc name (plstore--get-secret-alist plstore)))
382 (setcdr entry secret-plist)
383 (plstore--set-secret-alist
385 (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
386 (plstore--merge-secret plstore)))
388 (defun plstore-delete (plstore name)
389 "Delete an entry with NAME from PLSTORE."
390 (let ((entry (assoc name (plstore--get-alist plstore))))
394 (delq entry (plstore--get-alist plstore))))
395 (setq entry (assoc name (plstore--get-secret-alist plstore)))
397 (plstore--set-secret-alist
399 (delq entry (plstore--get-secret-alist plstore))))
400 (setq entry (assoc name (plstore--get-merged-alist plstore)))
402 (plstore--set-merged-alist
404 (delq entry (plstore--get-merged-alist plstore))))))
406 (defvar pp-escape-newlines)
407 (defun plstore--insert-buffer (plstore)
408 (insert ";;; public entries -*- mode: plstore -*- \n"
409 (pp-to-string (plstore--get-alist plstore)))
410 (if (plstore--get-secret-alist plstore)
411 (let ((context (epg-make-context 'OpenPGP))
412 (pp-escape-newlines nil)
415 ((listp plstore-encrypt-to) plstore-encrypt-to)
416 ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
418 (epg-context-set-armor context t)
419 (epg-context-set-passphrase-callback
421 (cons #'plstore-passphrase-callback-function
423 (setq cipher (epg-encrypt-string
426 (plstore--get-secret-alist plstore))
427 (if (or (eq plstore-select-keys t)
428 (and (null plstore-select-keys)
429 (not (local-variable-p 'plstore-encrypt-to
433 "Select recipients for encryption.
434 If no one is selected, symmetric encryption will be performed. "
436 (if plstore-encrypt-to
437 (epg-list-keys context recipients)))))
438 (goto-char (point-max))
439 (insert ";;; secret entries\n" (pp-to-string cipher)))))
441 (defun plstore-save (plstore)
442 "Save the contents of PLSTORE associated with a FILE."
443 (with-current-buffer (plstore--get-buffer plstore)
445 (plstore--insert-buffer plstore)
448 (defun plstore--encode (plstore)
449 (plstore--decrypt plstore)
450 (let ((merged-alist (plstore--get-merged-alist plstore)))
454 (setq entry (copy-sequence entry))
455 (let ((merged-plist (cdr (assoc (car entry) merged-alist)))
458 (if (string-match "\\`:secret-" (symbol-name (car plist)))
463 (substring (symbol-name
466 (setq plist (nthcdr 2 plist)))
467 (prin1-to-string entry)))
468 (plstore--get-alist plstore)
472 (defun plstore--decode (string)
473 (let* ((alist (car (read-from-string string)))
479 (unless (stringp (car (car pointer)))
480 (error "Invalid PLSTORE format %s" string))
481 (setq plist (cdr (car pointer)))
483 (when (string-match "\\`:secret-" (symbol-name (car plist)))
484 (setq entry (assoc (car (car pointer)) secret-alist))
486 (setq entry (list (car (car pointer)))
487 secret-alist (cons entry secret-alist)))
488 (setcdr entry (plist-put (cdr entry)
490 (substring (symbol-name
494 (setcar (cdr plist) t))
495 (setq plist (nthcdr 2 plist)))
496 (setq pointer (cdr pointer)))
497 (plstore--make nil alist nil secret-alist)))
499 (defun plstore--write-contents-functions ()
500 (when plstore-encoded
501 (let ((store (plstore--decode (buffer-string)))
502 (file (buffer-file-name)))
505 (set-visited-file-name nil)
507 (plstore--insert-buffer store)
508 (write-region (buffer-string) nil file)))
509 (set-visited-file-name file)
510 (set-buffer-modified-p nil))
513 (defun plstore-mode-original ()
514 "Show the original form of the this buffer."
516 (when plstore-encoded
517 (if (and (buffer-modified-p)
518 (y-or-n-p "Save buffer before reading the original form? "))
521 (insert-file-contents-literally (buffer-file-name))
522 (set-buffer-modified-p nil)
523 (setq plstore-encoded nil)))
525 (defun plstore-mode-decoded ()
526 "Show the decoded form of the this buffer."
528 (unless plstore-encoded
529 (if (and (buffer-modified-p)
530 (y-or-n-p "Save buffer before decoding? "))
532 (let ((store (plstore--make (current-buffer))))
533 (plstore--init-from-buffer store)
536 (substitute-command-keys "\
537 ;;; You are looking at the decoded form of the PLSTORE file.\n\
538 ;;; To see the original form content, do \\[plstore-mode-toggle-display]\n\n"))
539 (insert (plstore--encode store))
540 (set-buffer-modified-p nil)
541 (setq plstore-encoded t))))
543 (defun plstore-mode-toggle-display ()
544 "Toggle the display mode of PLSTORE between the original and decoded forms."
547 (plstore-mode-original)
548 (plstore-mode-decoded)))
551 (defmacro plstore-called-interactively-p (kind)
554 (eval '(called-interactively-p 'any))
556 `(called-interactively-p ,kind))
558 (wrong-number-of-arguments '(called-interactively-p))
560 (void-function '(interactive-p)))))
563 (define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE"
564 "Major mode for editing PLSTORE files."
565 (make-local-variable 'plstore-encoded)
566 (add-hook 'write-contents-functions #'plstore--write-contents-functions)
567 (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display)
568 ;; to create a new file with plstore-mode, mark it as already decoded
569 (if (plstore-called-interactively-p 'any)
570 (setq plstore-encoded t)
571 (plstore-mode-decoded)))
575 ;;; plstore.el ends here