107389
|
1 ;;; secrets.el --- Client interface to gnome-keyring and kwallet.
|
|
2
|
|
3 ;; Copyright (C) 2010 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
|
|
6 ;; Keywords: comm password passphrase
|
|
7
|
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
12 ;; the Free Software Foundation, either version 3 of the License, or
|
|
13 ;; (at your option) any later version.
|
|
14
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
18 ;; GNU General Public License for more details.
|
|
19
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
22
|
|
23 ;;; Commentary:
|
|
24
|
|
25 ;; This package provides an implementation of the Secret Service API
|
|
26 ;; <http://www.freedesktop.org/wiki/Specifications/secret-storage-spec>.
|
|
27 ;; This API is meant to make GNOME-Keyring- and KWallet-like daemons
|
|
28 ;; available under a common D-BUS interface and thus increase
|
|
29 ;; interoperability between GNOME, KDE and other applications having
|
|
30 ;; the need to securely store passwords and other confidential
|
|
31 ;; information.
|
|
32
|
|
33 ;; In order to activate this package, you must add the following code
|
|
34 ;; into your .emacs:
|
|
35
|
|
36 ;; (require 'secrets)
|
|
37
|
|
38 ;; The atomic objects to be managed by the Secret Service API are
|
|
39 ;; secret items, which are something an application wishes to store
|
|
40 ;; securely. A good example is a password that an application needs
|
|
41 ;; to save and use at a later date.
|
|
42
|
|
43 ;; Secret items are grouped in collections. A collection is similar
|
|
44 ;; in concept to the terms 'keyring' or 'wallet'. A common collection
|
|
45 ;; is called "login". A collection is stored permanently under the
|
|
46 ;; user's permissions, and can be accessed in a user session context.
|
|
47
|
|
48 ;; A collection can have an alias name. The use case for this is to
|
|
49 ;; set the alias "default" for a given collection, making it
|
|
50 ;; transparent for clients, which collection is used. Other aliases
|
|
51 ;; are not supported (yet). Since an alias is visible to all
|
|
52 ;; applications, this setting shall be performed with care.
|
|
53
|
|
54 ;; A list of all available collections is available by
|
|
55 ;;
|
|
56 ;; (secrets-list-collections)
|
|
57 ;; => ("session" "login" "ssh keys")
|
|
58
|
|
59 ;; The "default" alias could be set to the "login" collection by
|
|
60 ;;
|
|
61 ;; (secrets-set-alias "login" "default")
|
|
62
|
|
63 ;; An alias can also be dereferenced
|
|
64 ;;
|
|
65 ;; (secrets-get-alias "default")
|
|
66 ;; => "login"
|
|
67
|
|
68 ;; Collections can be created and deleted. As already said,
|
|
69 ;; collections are used by different applications. Therefore, those
|
|
70 ;; operations shall also be performed with care. Common collections,
|
|
71 ;; like "login", shall not be changed except adding or deleting secret
|
|
72 ;; items.
|
|
73 ;;
|
|
74 ;; (secrets-delete-collection "my collection")
|
|
75 ;; (secrets-create-collection "my collection")
|
|
76
|
|
77 ;; There exists a special collection called "session", which has the
|
|
78 ;; lifetime of the corrresponding client session (aka Emacs'
|
|
79 ;; lifetime). It is created automatically when Emacs uses the Secret
|
|
80 ;; Service interface, and it is deleted when Emacs is killed.
|
|
81 ;; Therefore, it can be used to store and retrieve secret items
|
|
82 ;; temporarily. This shall be preferred over creation of a persistent
|
|
83 ;; collection, when the information shall not live longer than Emacs.
|
|
84 ;; The session collection can be addressed either by the string
|
|
85 ;; "session", or by `nil', whenever a collection parameter is needed.
|
|
86
|
|
87 ;; As already said, a collection is a group of secret items. A secret
|
|
88 ;; item has a label, the "secret" (which is a string), and a set of
|
|
89 ;; lookup attributes. The attributes can be used to search and
|
|
90 ;; retrieve a secret item at a later date.
|
|
91
|
|
92 ;; A list of all available secret items of a collection is available by
|
|
93 ;;
|
|
94 ;; (secrets-list-items "my collection")
|
|
95 ;; => ("this item" "another item")
|
|
96
|
|
97 ;; Secret items can be added or deleted to a collection. In the
|
|
98 ;; following examples, we use the special collection "session", which
|
|
99 ;; is bound to Emacs' lifetime.
|
|
100 ;;
|
|
101 ;; (secrets-delete-item "session" "my item")
|
|
102 ;; (secrets-create-item "session" "my item" "geheim"
|
|
103 ;; :user "joe" :host "remote-host")
|
|
104
|
|
105 ;; The string "geheim" is the secret of the secret item "my item".
|
|
106 ;; The secret string can be retrieved from items:
|
|
107 ;;
|
|
108 ;; (secrets-get-secret "session" "my item")
|
|
109 ;; => "geheim"
|
|
110
|
|
111 ;; The lookup attributes, which are specified during creation of a
|
|
112 ;; secret item, must be a key-value pair. Keys are keyword symbols,
|
|
113 ;; starting with a colon; values are strings. They can be retrieved
|
|
114 ;; from a given secret item:
|
|
115 ;;
|
|
116 ;; (secrets-get-attribute "session" "my item" :host)
|
|
117 ;; => "remote-host"
|
|
118 ;;
|
|
119 ;; (secrets-get-attributes "session" "my item")
|
|
120 ;; => ((:user . "joe") (:host ."remote-host"))
|
|
121
|
|
122 ;; The lookup attributes can be used for searching of items. If you,
|
|
123 ;; for example, are looking for all secret items for the user "joe",
|
|
124 ;; you would perform
|
|
125 ;;
|
|
126 ;; (secrets-search-items "session" :user "joe")
|
|
127 ;; => ("my item" "another item")
|
|
128
|
|
129 ;;; Code:
|
|
130
|
|
131 ;; It has been tested with GNOME Keyring 2.29.92. An implementation
|
|
132 ;; for KWallet will be available at
|
|
133 ;; svn://anonsvn.kde.org/home/kde/trunk/playground/base/ksecretservice;
|
|
134 ;; not tested yet.
|
|
135
|
|
136 ;; Pacify byte-compiler. D-Bus support in the Emacs core can be
|
|
137 ;; disabled with configuration option "--without-dbus". Declare used
|
|
138 ;; subroutines and variables of `dbus' therefore.
|
|
139 (eval-when-compile
|
|
140 (require 'cl))
|
|
141
|
|
142 (declare-function dbus-call-method "dbusbind.c")
|
|
143 (declare-function dbus-register-signal "dbusbind.c")
|
|
144 (defvar dbus-debug)
|
|
145
|
|
146 (require 'dbus)
|
|
147
|
|
148 (defvar secrets-debug t
|
|
149 "Write debug messages")
|
|
150
|
|
151 (defconst secrets-service "org.freedesktop.secrets"
|
|
152 "The D-Bus name used to talk to Secret Service.")
|
|
153
|
|
154 (defconst secrets-path "/org/freedesktop/secrets"
|
|
155 "The D-Bus root object path used to talk to Secret Service.")
|
|
156
|
|
157 (defconst secrets-empty-path "/"
|
|
158 "The D-Bus object path representing an empty object.")
|
|
159
|
|
160 (defsubst secrets-empty-path (path)
|
|
161 "Check, whether PATH is a valid object path.
|
|
162 It returns t if not."
|
|
163 (or (not (stringp path))
|
|
164 (string-equal path secrets-empty-path)))
|
|
165
|
|
166 (defconst secrets-interface-service "org.freedesktop.Secret.Service"
|
|
167 "The D-Bus interface managing sessions and collections.")
|
|
168
|
|
169 ;; <interface name="org.freedesktop.Secret.Service">
|
|
170 ;; <property name="Collections" type="ao" access="read"/>
|
|
171 ;; <method name="OpenSession">
|
|
172 ;; <arg name="algorithm" type="s" direction="in"/>
|
|
173 ;; <arg name="input" type="v" direction="in"/>
|
|
174 ;; <arg name="output" type="v" direction="out"/>
|
|
175 ;; <arg name="result" type="o" direction="out"/>
|
|
176 ;; </method>
|
|
177 ;; <method name="CreateCollection">
|
|
178 ;; <arg name="props" type="a{sv}" direction="in"/>
|
|
179 ;; <arg name="collection" type="o" direction="out"/>
|
|
180 ;; <arg name="prompt" type="o" direction="out"/>
|
|
181 ;; </method>
|
|
182 ;; <method name="SearchItems">
|
|
183 ;; <arg name="attributes" type="a{ss}" direction="in"/>
|
|
184 ;; <arg name="unlocked" type="ao" direction="out"/>
|
|
185 ;; <arg name="locked" type="ao" direction="out"/>
|
|
186 ;; </method>
|
|
187 ;; <method name="Unlock">
|
|
188 ;; <arg name="objects" type="ao" direction="in"/>
|
|
189 ;; <arg name="unlocked" type="ao" direction="out"/>
|
|
190 ;; <arg name="prompt" type="o" direction="out"/>
|
|
191 ;; </method>
|
|
192 ;; <method name="Lock">
|
|
193 ;; <arg name="objects" type="ao" direction="in"/>
|
|
194 ;; <arg name="locked" type="ao" direction="out"/>
|
|
195 ;; <arg name="Prompt" type="o" direction="out"/>
|
|
196 ;; </method>
|
|
197 ;; <method name="GetSecrets">
|
|
198 ;; <arg name="items" type="ao" direction="in"/>
|
|
199 ;; <arg name="session" type="o" direction="in"/>
|
|
200 ;; <arg name="secrets" type="a{o(oayay)}" direction="out"/>
|
|
201 ;; </method>
|
|
202 ;; <method name="ReadAlias">
|
|
203 ;; <arg name="name" type="s" direction="in"/>
|
|
204 ;; <arg name="collection" type="o" direction="out"/>
|
|
205 ;; </method>
|
|
206 ;; <method name="SetAlias">
|
|
207 ;; <arg name="name" type="s" direction="in"/>
|
|
208 ;; <arg name="collection" type="o" direction="in"/>
|
|
209 ;; </method>
|
|
210 ;; <signal name="CollectionCreated">
|
|
211 ;; <arg name="collection" type="o"/>
|
|
212 ;; </signal>
|
|
213 ;; <signal name="CollectionDeleted">
|
|
214 ;; <arg name="collection" type="o"/>
|
|
215 ;; </signal>
|
|
216 ;; </interface>
|
|
217
|
|
218 (defconst secrets-interface-collection "org.freedesktop.Secret.Collection"
|
|
219 "A collection of items containing secrets.")
|
|
220
|
|
221 ;; <interface name="org.freedesktop.Secret.Collection">
|
|
222 ;; <property name="Items" type="ao" access="read"/>
|
|
223 ;; <property name="Label" type="s" access="readwrite"/>
|
|
224 ;; <property name="Locked" type="s" access="read"/>
|
|
225 ;; <property name="Created" type="t" access="read"/>
|
|
226 ;; <property name="Modified" type="t" access="read"/>
|
|
227 ;; <method name="Delete">
|
|
228 ;; <arg name="prompt" type="o" direction="out"/>
|
|
229 ;; </method>
|
|
230 ;; <method name="SearchItems">
|
|
231 ;; <arg name="attributes" type="a{ss}" direction="in"/>
|
|
232 ;; <arg name="results" type="ao" direction="out"/>
|
|
233 ;; </method>
|
|
234 ;; <method name="CreateItem">
|
|
235 ;; <arg name="props" type="a{sv}" direction="in"/>
|
|
236 ;; <arg name="secret" type="(oayay)" direction="in"/>
|
|
237 ;; <arg name="replace" type="b" direction="in"/>
|
|
238 ;; <arg name="item" type="o" direction="out"/>
|
|
239 ;; <arg name="prompt" type="o" direction="out"/>
|
|
240 ;; </method>
|
|
241 ;; <signal name="ItemCreated">
|
|
242 ;; <arg name="item" type="o"/>
|
|
243 ;; </signal>
|
|
244 ;; <signal name="ItemDeleted">
|
|
245 ;; <arg name="item" type="o"/>
|
|
246 ;; </signal>
|
|
247 ;; <signal name="ItemChanged">
|
|
248 ;; <arg name="item" type="o"/>
|
|
249 ;; </signal>
|
|
250 ;; </interface>
|
|
251
|
|
252 (defconst secrets-session-collection-path
|
|
253 "/org/freedesktop/secrets/collection/session"
|
|
254 "The D-Bus temporary session collection object path.")
|
|
255
|
|
256 (defconst secrets-interface-prompt "org.freedesktop.Secret.Prompt"
|
|
257 "A session tracks state between the service and a client application.")
|
|
258
|
|
259 ;; <interface name="org.freedesktop.Secret.Prompt">
|
|
260 ;; <method name="Prompt">
|
|
261 ;; <arg name="window-id" type="s" direction="in"/>
|
|
262 ;; </method>
|
|
263 ;; <method name="Dismiss"></method>
|
|
264 ;; <signal name="Completed">
|
|
265 ;; <arg name="dismissed" type="b"/>
|
|
266 ;; <arg name="result" type="v"/>
|
|
267 ;; </signal>
|
|
268 ;; </interface>
|
|
269
|
|
270 (defconst secrets-interface-item "org.freedesktop.Secret.Item"
|
|
271 "A collection of items containing secrets.")
|
|
272
|
|
273 ;; <interface name="org.freedesktop.Secret.Item">
|
|
274 ;; <property name="Locked" type="b" access="read"/>
|
|
275 ;; <property name="Attributes" type="a{ss}" access="readwrite"/>
|
|
276 ;; <property name="Label" type="s" access="readwrite"/>
|
|
277 ;; <property name="Created" type="t" access="read"/>
|
|
278 ;; <property name="Modified" type="t" access="read"/>
|
|
279 ;; <method name="Delete">
|
|
280 ;; <arg name="prompt" type="o" direction="out"/>
|
|
281 ;; </method>
|
|
282 ;; <method name="GetSecret">
|
|
283 ;; <arg name="session" type="o" direction="in"/>
|
|
284 ;; <arg name="secret" type="(oayay)" direction="out"/>
|
|
285 ;; </method>
|
|
286 ;; <method name="SetSecret">
|
|
287 ;; <arg name="secret" type="(oayay)" direction="in"/>
|
|
288 ;; </method>
|
|
289 ;; </interface>
|
|
290 ;;
|
|
291 ;; STRUCT secret
|
|
292 ;; OBJECT PATH session
|
|
293 ;; ARRAY BYTE parameters
|
|
294 ;; ARRAY BYTE value
|
|
295
|
|
296 (defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic"
|
|
297 "The default item type we are using.")
|
|
298
|
|
299 (defconst secrets-interface-session "org.freedesktop.Secret.Session"
|
|
300 "A session tracks state between the service and a client application.")
|
|
301
|
|
302 ;; <interface name="org.freedesktop.Secret.Session">
|
|
303 ;; <method name="Close"></method>
|
|
304 ;; </interface>
|
|
305
|
|
306 ;;; Sessions.
|
|
307
|
|
308 (defvar secrets-session-path secrets-empty-path
|
|
309 "The D-Bus session path of the active session.
|
|
310 A session path `secrets-empty-path' indicates there is no open session.")
|
|
311
|
|
312 (defun secrets-close-session ()
|
|
313 "Close the secret service session, if any."
|
|
314 (dbus-ignore-errors
|
|
315 (dbus-call-method
|
|
316 :session secrets-service secrets-session-path
|
|
317 secrets-interface-session "Close"))
|
|
318 (setq secrets-session-path secrets-empty-path))
|
|
319
|
|
320 (defun secrets-open-session (&optional reopen)
|
|
321 "Open a new session with \"plain\" algorithm.
|
|
322 If there exists another active session, and REOPEN is nil, that
|
|
323 session will be used. The object path of the session will be
|
|
324 returned, and it will be stored in `secrets-session-path'."
|
|
325 (when reopen (secrets-close-session))
|
|
326 (when (secrets-empty-path secrets-session-path)
|
|
327 (setq secrets-session-path
|
|
328 (cadr
|
|
329 (dbus-call-method
|
|
330 :session secrets-service secrets-path
|
|
331 secrets-interface-service "OpenSession" "plain" '(:variant "")))))
|
|
332 (when secrets-debug
|
|
333 (message "Secret Service session: %s" secrets-session-path))
|
|
334 secrets-session-path)
|
|
335
|
|
336 ;;; Prompts.
|
|
337
|
|
338 (defvar secrets-prompt-signal nil
|
|
339 "Internal variable to catch signals from `secrets-interface-prompt'.")
|
|
340
|
|
341 (defun secrets-prompt (prompt)
|
|
342 "Handle the prompt identified by object path PROMPT."
|
|
343 (unless (secrets-empty-path prompt)
|
|
344 (let ((object
|
|
345 (dbus-register-signal
|
|
346 :session secrets-service prompt
|
|
347 secrets-interface-prompt "Completed" 'secrets-prompt-handler)))
|
|
348 (dbus-call-method
|
|
349 :session secrets-service prompt
|
|
350 secrets-interface-prompt "Prompt" (frame-parameter nil 'window-id))
|
|
351 (unwind-protect
|
|
352 (progn
|
|
353 ;; Wait until the returned prompt signal has put the
|
|
354 ;; result into `secrets-prompt-signal'.
|
|
355 (while (null secrets-prompt-signal)
|
|
356 (read-event nil nil 0.1))
|
|
357 ;; Return the object(s). It is a variant, so we must use a car.
|
|
358 (car secrets-prompt-signal))
|
|
359 ;; Cleanup.
|
|
360 (setq secrets-prompt-signal nil)
|
|
361 (dbus-unregister-object object)))))
|
|
362
|
|
363 (defun secrets-prompt-handler (&rest args)
|
|
364 "Handler for signals emitted by `secrets-interface-prompt'."
|
|
365 ;; An empty object path is always identified as `secrets-empty-path'
|
|
366 ;; or `nil'. Either we set it explicitely, or it is returned by the
|
|
367 ;; "Completed" signal.
|
|
368 (if (car args) ;; dismissed
|
|
369 (setq secrets-prompt-signal (list secrets-empty-path))
|
|
370 (setq secrets-prompt-signal (cadr args))))
|
|
371
|
|
372 ;;; Collections.
|
|
373
|
|
374 (defvar secrets-collection-paths nil
|
|
375 "Cached D-Bus object paths of available collections.")
|
|
376
|
|
377 (defun secrets-collection-handler (&rest args)
|
|
378 "Handler for signals emitted by `secrets-interface-service'."
|
|
379 (cond
|
|
380 ((string-equal (dbus-event-member-name last-input-event) "CollectionCreated")
|
|
381 (add-to-list 'secrets-collection-paths (car args)))
|
|
382 ((string-equal (dbus-event-member-name last-input-event) "CollectionDeleted")
|
|
383 (setq secrets-collection-paths
|
|
384 (delete (car args) secrets-collection-paths)))))
|
|
385
|
|
386 (dbus-register-signal
|
|
387 :session secrets-service secrets-path
|
|
388 secrets-interface-service "CollectionCreated" 'secrets-collection-handler)
|
|
389
|
|
390 (dbus-register-signal
|
|
391 :session secrets-service secrets-path
|
|
392 secrets-interface-service "CollectionDeleted" 'secrets-collection-handler)
|
|
393
|
|
394 (defun secrets-get-collections ()
|
|
395 "Return the object paths of all available collections."
|
|
396 (setq secrets-collection-paths
|
|
397 (or secrets-collection-paths
|
|
398 (dbus-get-property
|
|
399 :session secrets-service secrets-path
|
|
400 secrets-interface-service "Collections"))))
|
|
401
|
|
402 (defun secrets-get-collection-properties (collection-path)
|
|
403 "Return all properties of collection identified by COLLECTION-PATH."
|
|
404 (unless (secrets-empty-path collection-path)
|
|
405 (dbus-get-all-properties
|
|
406 :session secrets-service collection-path
|
|
407 secrets-interface-collection)))
|
|
408
|
|
409 (defun secrets-get-collection-property (collection-path property)
|
|
410 "Return property PROPERTY of collection identified by COLLECTION-PATH."
|
|
411 (unless (or (secrets-empty-path collection-path) (not (stringp property)))
|
|
412 (dbus-get-property
|
|
413 :session secrets-service collection-path
|
|
414 secrets-interface-collection property)))
|
|
415
|
|
416 (defun secrets-list-collections ()
|
|
417 "Return a list of collection names."
|
|
418 (mapcar
|
|
419 (lambda (collection-path)
|
|
420 (if (string-equal collection-path secrets-session-collection-path)
|
|
421 "session"
|
|
422 (secrets-get-collection-property collection-path "Label")))
|
|
423 (secrets-get-collections)))
|
|
424
|
|
425 (defun secrets-collection-path (collection)
|
|
426 "Return the object path of collection labelled COLLECTION.
|
|
427 If COLLECTION is nil, return the session collection path.
|
|
428 If there is no such COLLECTION, return nil."
|
|
429 (or
|
|
430 ;; The "session" collection.
|
|
431 (if (or (null collection) (string-equal "session" collection))
|
|
432 secrets-session-collection-path)
|
|
433 ;; Check for an alias.
|
|
434 (let ((collection-path
|
|
435 (dbus-call-method
|
|
436 :session secrets-service secrets-path
|
|
437 secrets-interface-service "ReadAlias" collection)))
|
|
438 (unless (secrets-empty-path collection-path)
|
|
439 collection-path))
|
|
440 ;; Check the collections.
|
|
441 (catch 'collection-found
|
|
442 (dolist (collection-path (secrets-get-collections) nil)
|
|
443 (when
|
|
444 (string-equal
|
|
445 collection
|
|
446 (secrets-get-collection-property collection-path "Label"))
|
|
447 (throw 'collection-found collection-path))))))
|
|
448
|
|
449 (defun secrets-create-collection (collection)
|
|
450 "Create collection labelled COLLECTION if it doesn't exist.
|
|
451 Return the D-Bus object path for collection."
|
|
452 (let ((collection-path (secrets-collection-path collection)))
|
|
453 ;; Create the collection.
|
|
454 (when (secrets-empty-path collection-path)
|
|
455 (setq collection-path
|
|
456 (secrets-prompt
|
|
457 (cadr
|
|
458 ;; "CreateCollection" returns the prompt path as second arg.
|
|
459 (dbus-call-method
|
|
460 :session secrets-service secrets-path
|
|
461 secrets-interface-service "CreateCollection"
|
|
462 `(:array (:dict-entry "Label" (:variant ,collection))))))))
|
|
463 ;; Return object path of the collection.
|
|
464 collection-path))
|
|
465
|
|
466 (defun secrets-get-alias (alias)
|
|
467 "Return the collection name ALIAS is referencing to.
|
|
468 For the time being, only the alias \"default\" is supported."
|
|
469 (secrets-get-collection-property
|
|
470 (dbus-call-method
|
|
471 :session secrets-service secrets-path
|
|
472 secrets-interface-service "ReadAlias" alias)
|
|
473 "Label"))
|
|
474
|
|
475 (defun secrets-set-alias (collection alias)
|
|
476 "Set ALIAS as alias of collection labelled COLLECTION.
|
|
477 For the time being, only the alias \"default\" is supported."
|
|
478 (let ((collection-path (secrets-collection-path collection)))
|
|
479 (unless (secrets-empty-path collection-path)
|
|
480 (dbus-call-method
|
|
481 :session secrets-service secrets-path
|
|
482 secrets-interface-service "SetAlias"
|
|
483 alias :object-path collection-path))))
|
|
484
|
|
485 (defun secrets-unlock-collection (collection)
|
|
486 "Unlock collection labelled COLLECTION.
|
|
487 If successful, return the object path of the collection."
|
|
488 (let ((collection-path (secrets-collection-path collection)))
|
|
489 (unless (secrets-empty-path collection-path)
|
|
490 (secrets-prompt
|
|
491 (cadr
|
|
492 (dbus-call-method
|
|
493 :session secrets-service secrets-path secrets-interface-service
|
|
494 "Unlock" `(:array :object-path ,collection-path)))))
|
|
495 collection-path))
|
|
496
|
|
497 (defun secrets-delete-collection (collection)
|
|
498 "Delete collection labelled COLLECTION."
|
|
499 (let ((collection-path (secrets-collection-path collection)))
|
|
500 (unless (secrets-empty-path collection-path)
|
|
501 (secrets-prompt
|
|
502 (dbus-call-method
|
|
503 :session secrets-service collection-path
|
|
504 secrets-interface-collection "Delete")))))
|
|
505
|
|
506 ;;; Items.
|
|
507
|
|
508 (defun secrets-get-items (collection-path)
|
|
509 "Return the object paths of all available items in COLLECTION-PATH."
|
|
510 (unless (secrets-empty-path collection-path)
|
|
511 (secrets-open-session)
|
|
512 (dbus-get-property
|
|
513 :session secrets-service collection-path
|
|
514 secrets-interface-collection "Items")))
|
|
515
|
|
516 (defun secrets-get-item-properties (item-path)
|
|
517 "Return all properties of item identified by ITEM-PATH."
|
|
518 (unless (secrets-empty-path item-path)
|
|
519 (dbus-get-all-properties
|
|
520 :session secrets-service item-path
|
|
521 secrets-interface-item)))
|
|
522
|
|
523 (defun secrets-get-item-property (item-path property)
|
|
524 "Return property PROPERTY of item identified by ITEM-PATH."
|
|
525 (unless (or (secrets-empty-path item-path) (not (stringp property)))
|
|
526 (dbus-get-property
|
|
527 :session secrets-service item-path
|
|
528 secrets-interface-item property)))
|
|
529
|
|
530 (defun secrets-list-items (collection)
|
|
531 "Return a list of all item labels of COLLECTION."
|
|
532 (let ((collection-path (secrets-unlock-collection collection)))
|
|
533 (unless (secrets-empty-path collection-path)
|
|
534 (mapcar
|
|
535 (lambda (item-path)
|
|
536 (secrets-get-item-property item-path "Label"))
|
|
537 (secrets-get-items collection-path)))))
|
|
538
|
|
539 (defun secrets-search-items (collection &rest attributes)
|
|
540 "Search items in COLLECTION with ATTRIBUTES.
|
|
541 ATTRIBUTES are key-value pairs. The keys are keyword symbols,
|
|
542 starting with a colon. Example:
|
|
543
|
|
544 \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
|
|
545 :method \"sudo\" :user \"joe\" :host \"remote-host\"\)
|
|
546
|
|
547 The object paths of the found items are returned as list."
|
|
548 (let ((collection-path (secrets-unlock-collection collection))
|
|
549 result props)
|
|
550 (unless (secrets-empty-path collection-path)
|
|
551 ;; Create attributes list.
|
|
552 (while (consp (cdr attributes))
|
|
553 (unless (keywordp (car attributes))
|
|
554 (error 'wrong-type-argument (car attributes)))
|
|
555 (setq props (add-to-list
|
|
556 'props
|
|
557 (list :dict-entry
|
|
558 (symbol-name (car attributes))
|
|
559 (cadr attributes))
|
|
560 'append)
|
|
561 attributes (cddr attributes)))
|
|
562 ;; Search. The result is a list of two lists, the object paths
|
|
563 ;; of the unlocked and the locked items.
|
|
564 (setq result
|
|
565 (dbus-call-method
|
|
566 :session secrets-service collection-path
|
|
567 secrets-interface-collection "SearchItems"
|
|
568 (if props
|
|
569 (cons :array props)
|
|
570 '(:array :signature "{ss}"))))
|
|
571 ;; Return the found items.
|
|
572 (mapcar
|
|
573 (lambda (item-path) (secrets-get-item-property item-path "Label"))
|
|
574 (append (car result) (cadr result))))))
|
|
575
|
|
576 (defun secrets-create-item (collection item password &rest attributes)
|
|
577 "Create a new item in COLLECTION with label ITEM and password PASSWORD.
|
|
578 ATTRIBUTES are key-value pairs set for the created item. The
|
|
579 keys are keyword symbols, starting with a colon. Example:
|
|
580
|
|
581 \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
|
|
582 :method \"sudo\" :user \"joe\" :host \"remote-host\"\)
|
|
583
|
|
584 The object path of the created item is returned."
|
|
585 (unless (member item (secrets-list-items collection))
|
|
586 (let ((collection-path (secrets-unlock-collection collection))
|
|
587 result props)
|
|
588 (unless (secrets-empty-path collection-path)
|
|
589 ;; Create attributes list.
|
|
590 (while (consp (cdr attributes))
|
|
591 (unless (keywordp (car attributes))
|
|
592 (error 'wrong-type-argument (car attributes)))
|
|
593 (setq props (add-to-list
|
|
594 'props
|
|
595 (list :dict-entry
|
|
596 (symbol-name (car attributes))
|
|
597 (cadr attributes))
|
|
598 'append)
|
|
599 attributes (cddr attributes)))
|
|
600 ;; Create the item.
|
|
601 (setq result
|
|
602 (dbus-call-method
|
|
603 :session secrets-service collection-path
|
|
604 secrets-interface-collection "CreateItem"
|
|
605 ;; Properties.
|
|
606 (append
|
|
607 `(:array
|
|
608 (:dict-entry "Label" (:variant ,item))
|
|
609 (:dict-entry
|
|
610 "Type" (:variant ,secrets-interface-item-type-generic)))
|
|
611 (when props
|
|
612 `((:dict-entry
|
|
613 "Attributes" (:variant ,(append '(:array) props))))))
|
|
614 ;; Secret.
|
|
615 `(:struct :object-path ,secrets-session-path
|
|
616 (:array :signature "y") ;; no parameters.
|
|
617 ,(dbus-string-to-byte-array password))
|
|
618 ;; Do not replace. Replace does not seem to work.
|
|
619 nil))
|
|
620 (secrets-prompt (cadr result))
|
|
621 ;; Return the object path.
|
|
622 (car result)))))
|
|
623
|
|
624 (defun secrets-item-path (collection item)
|
|
625 "Return the object path of item labelled ITEM in COLLECTION.
|
|
626 If there is no such item, return nil."
|
|
627 (let ((collection-path (secrets-unlock-collection collection)))
|
|
628 (catch 'item-found
|
|
629 (dolist (item-path (secrets-get-items collection-path))
|
|
630 (when (string-equal item (secrets-get-item-property item-path "Label"))
|
|
631 (throw 'item-found item-path))))))
|
|
632
|
|
633 (defun secrets-get-secret (collection item)
|
|
634 "Return the secret of item labelled ITEM in COLLECTION.
|
|
635 If there is no such item, return nil."
|
|
636 (let ((item-path (secrets-item-path collection item)))
|
|
637 (unless (secrets-empty-path item-path)
|
|
638 (dbus-byte-array-to-string
|
|
639 (caddr
|
|
640 (dbus-call-method
|
|
641 :session secrets-service item-path secrets-interface-item
|
|
642 "GetSecret" :object-path secrets-session-path))))))
|
|
643
|
|
644 (defun secrets-get-attributes (collection item)
|
|
645 "Return the lookup attributes of item labelled ITEM in COLLECTION.
|
|
646 If there is no such item, or the item has no attributes, return nil."
|
|
647 (unless (stringp collection) (setq collection "default"))
|
|
648 (let ((item-path (secrets-item-path collection item)))
|
|
649 (unless (secrets-empty-path item-path)
|
|
650 (mapcar
|
|
651 (lambda (attribute) (cons (intern (car attribute)) (cadr attribute)))
|
|
652 (dbus-get-property
|
|
653 :session secrets-service item-path
|
|
654 secrets-interface-item "Attributes")))))
|
|
655
|
|
656 (defun secrets-get-attribute (collection item attribute)
|
|
657 "Return the value of ATTRIBUTE of item labelled ITEM in COLLECTION.
|
|
658 If there is no such item, or the item doesn't own this attribute, return nil."
|
|
659 (cdr (assoc attribute (secrets-get-attributes collection item))))
|
|
660
|
|
661 (defun secrets-delete-item (collection item)
|
|
662 "Delete ITEM in COLLECTION."
|
|
663 (let ((item-path (secrets-item-path collection item)))
|
|
664 (unless (secrets-empty-path item-path)
|
|
665 (secrets-prompt
|
|
666 (dbus-call-method
|
|
667 :session secrets-service item-path
|
|
668 secrets-interface-item "Delete")))))
|
|
669
|
|
670 ;; We must reset all variables, when there is a new instance of the
|
|
671 ;; "org.freedesktop.secrets" service.
|
|
672
|
|
673 (dbus-register-signal
|
|
674 :session dbus-service-dbus dbus-path-dbus
|
|
675 dbus-interface-dbus "NameOwnerChanged"
|
|
676 (lambda (&rest args)
|
|
677 (when secrets-debug (message "Secret Service has changed: %S" args))
|
|
678 (setq secrets-session-path secrets-empty-path
|
|
679 secrets-prompt-signal nil
|
|
680 secrets-collection-paths nil))
|
|
681 secrets-service)
|
|
682
|
|
683 (provide 'secrets)
|
|
684
|
|
685 ;;; TODO:
|
|
686
|
|
687 ;; * secrets-debug should be structured like auth-source-debug to
|
|
688 ;; prevent leaking sensitive information. Right now I don't see
|
|
689 ;; anything sensitive though.
|
|
690 ;; * Check, whether the dh-ietf1024-aes128-cbc-pkcs7 algorithm can be
|
|
691 ;; used for the transfer of the secrets. Currently, we use the
|
|
692 ;; plain algorithm.
|