Mercurial > emacs
annotate lisp/net/secrets.el @ 110858:a6ae19bc27ec
* net/browse-url.el (browse-url-xdg-open): Remove use of /bin/sh.
author | Andreas Schwab <schwab@linux-m68k.org> |
---|---|
date | Fri, 08 Oct 2010 19:32:14 +0200 |
parents | 69ac0d220a1c |
children | 68a3b6b312ee |
rev | line source |
---|---|
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: | |
107396
d5de7ba3f80f
* net/secrets.el (top): Register the D-Bus signals only when the
Michael Albinus <albinus@detlef>
parents:
107389
diff
changeset
|
35 ;; |
d5de7ba3f80f
* net/secrets.el (top): Register the D-Bus signals only when the
Michael Albinus <albinus@detlef>
parents:
107389
diff
changeset
|
36 ;; (require 'secrets) |
d5de7ba3f80f
* net/secrets.el (top): Register the D-Bus signals only when the
Michael Albinus <albinus@detlef>
parents:
107389
diff
changeset
|
37 ;; |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
38 ;; Afterwards, the variable `secrets-enabled' is non-nil when there is |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
39 ;; a daemon providing this interface. |
107389 | 40 |
41 ;; The atomic objects to be managed by the Secret Service API are | |
42 ;; secret items, which are something an application wishes to store | |
43 ;; securely. A good example is a password that an application needs | |
44 ;; to save and use at a later date. | |
45 | |
46 ;; Secret items are grouped in collections. A collection is similar | |
47 ;; in concept to the terms 'keyring' or 'wallet'. A common collection | |
48 ;; is called "login". A collection is stored permanently under the | |
49 ;; user's permissions, and can be accessed in a user session context. | |
50 | |
51 ;; A collection can have an alias name. The use case for this is to | |
52 ;; set the alias "default" for a given collection, making it | |
53 ;; transparent for clients, which collection is used. Other aliases | |
54 ;; are not supported (yet). Since an alias is visible to all | |
55 ;; applications, this setting shall be performed with care. | |
56 | |
57 ;; A list of all available collections is available by | |
58 ;; | |
59 ;; (secrets-list-collections) | |
60 ;; => ("session" "login" "ssh keys") | |
61 | |
62 ;; The "default" alias could be set to the "login" collection by | |
63 ;; | |
64 ;; (secrets-set-alias "login" "default") | |
65 | |
66 ;; An alias can also be dereferenced | |
67 ;; | |
68 ;; (secrets-get-alias "default") | |
69 ;; => "login" | |
70 | |
71 ;; Collections can be created and deleted. As already said, | |
72 ;; collections are used by different applications. Therefore, those | |
73 ;; operations shall also be performed with care. Common collections, | |
74 ;; like "login", shall not be changed except adding or deleting secret | |
75 ;; items. | |
76 ;; | |
77 ;; (secrets-delete-collection "my collection") | |
78 ;; (secrets-create-collection "my collection") | |
79 | |
80 ;; There exists a special collection called "session", which has the | |
81 ;; lifetime of the corrresponding client session (aka Emacs' | |
82 ;; lifetime). It is created automatically when Emacs uses the Secret | |
83 ;; Service interface, and it is deleted when Emacs is killed. | |
84 ;; Therefore, it can be used to store and retrieve secret items | |
85 ;; temporarily. This shall be preferred over creation of a persistent | |
86 ;; collection, when the information shall not live longer than Emacs. | |
87 ;; The session collection can be addressed either by the string | |
88 ;; "session", or by `nil', whenever a collection parameter is needed. | |
89 | |
90 ;; As already said, a collection is a group of secret items. A secret | |
91 ;; item has a label, the "secret" (which is a string), and a set of | |
92 ;; lookup attributes. The attributes can be used to search and | |
93 ;; retrieve a secret item at a later date. | |
94 | |
95 ;; A list of all available secret items of a collection is available by | |
96 ;; | |
97 ;; (secrets-list-items "my collection") | |
98 ;; => ("this item" "another item") | |
99 | |
100 ;; Secret items can be added or deleted to a collection. In the | |
101 ;; following examples, we use the special collection "session", which | |
102 ;; is bound to Emacs' lifetime. | |
103 ;; | |
104 ;; (secrets-delete-item "session" "my item") | |
105 ;; (secrets-create-item "session" "my item" "geheim" | |
106 ;; :user "joe" :host "remote-host") | |
107 | |
108 ;; The string "geheim" is the secret of the secret item "my item". | |
109 ;; The secret string can be retrieved from items: | |
110 ;; | |
111 ;; (secrets-get-secret "session" "my item") | |
112 ;; => "geheim" | |
113 | |
114 ;; The lookup attributes, which are specified during creation of a | |
115 ;; secret item, must be a key-value pair. Keys are keyword symbols, | |
116 ;; starting with a colon; values are strings. They can be retrieved | |
117 ;; from a given secret item: | |
118 ;; | |
119 ;; (secrets-get-attribute "session" "my item" :host) | |
120 ;; => "remote-host" | |
121 ;; | |
122 ;; (secrets-get-attributes "session" "my item") | |
123 ;; => ((:user . "joe") (:host ."remote-host")) | |
124 | |
125 ;; The lookup attributes can be used for searching of items. If you, | |
126 ;; for example, are looking for all secret items for the user "joe", | |
127 ;; you would perform | |
128 ;; | |
129 ;; (secrets-search-items "session" :user "joe") | |
130 ;; => ("my item" "another item") | |
131 | |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
132 ;; Interactively, collections, items and their attributes could be |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
133 ;; inspected by the command `secrets-show-secrets'. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
134 |
107389 | 135 ;;; Code: |
136 | |
137 ;; It has been tested with GNOME Keyring 2.29.92. An implementation | |
138 ;; for KWallet will be available at | |
139 ;; svn://anonsvn.kde.org/home/kde/trunk/playground/base/ksecretservice; | |
140 ;; not tested yet. | |
141 | |
142 ;; Pacify byte-compiler. D-Bus support in the Emacs core can be | |
143 ;; disabled with configuration option "--without-dbus". Declare used | |
144 ;; subroutines and variables of `dbus' therefore. | |
145 (eval-when-compile | |
146 (require 'cl)) | |
147 | |
148 (declare-function dbus-call-method "dbusbind.c") | |
149 (declare-function dbus-register-signal "dbusbind.c") | |
150 (defvar dbus-debug) | |
151 | |
152 (require 'dbus) | |
153 | |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
154 (autoload 'tree-widget-set-theme "tree-widget") |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
155 (autoload 'widget-create-child-and-convert "wid-edit") |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
156 (autoload 'widget-default-value-set "wid-edit") |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
157 (autoload 'widget-field-end "wid-edit") |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
158 (autoload 'widget-member "wid-edit") |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
159 (defvar tree-widget-after-toggle-functions) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
160 |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
161 (defvar secrets-enabled nil |
107447
9d443ad80849
Fix unbalanced parenthesis in secrets.el.
Ted Zlatanov <tzz@lifelogs.com>
parents:
107397
diff
changeset
|
162 "Whether there is a daemon offering the Secret Service API.") |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
163 |
107389 | 164 (defvar secrets-debug t |
165 "Write debug messages") | |
166 | |
167 (defconst secrets-service "org.freedesktop.secrets" | |
168 "The D-Bus name used to talk to Secret Service.") | |
169 | |
170 (defconst secrets-path "/org/freedesktop/secrets" | |
171 "The D-Bus root object path used to talk to Secret Service.") | |
172 | |
173 (defconst secrets-empty-path "/" | |
174 "The D-Bus object path representing an empty object.") | |
175 | |
176 (defsubst secrets-empty-path (path) | |
177 "Check, whether PATH is a valid object path. | |
178 It returns t if not." | |
179 (or (not (stringp path)) | |
180 (string-equal path secrets-empty-path))) | |
181 | |
182 (defconst secrets-interface-service "org.freedesktop.Secret.Service" | |
183 "The D-Bus interface managing sessions and collections.") | |
184 | |
185 ;; <interface name="org.freedesktop.Secret.Service"> | |
186 ;; <property name="Collections" type="ao" access="read"/> | |
187 ;; <method name="OpenSession"> | |
188 ;; <arg name="algorithm" type="s" direction="in"/> | |
189 ;; <arg name="input" type="v" direction="in"/> | |
190 ;; <arg name="output" type="v" direction="out"/> | |
191 ;; <arg name="result" type="o" direction="out"/> | |
192 ;; </method> | |
193 ;; <method name="CreateCollection"> | |
194 ;; <arg name="props" type="a{sv}" direction="in"/> | |
195 ;; <arg name="collection" type="o" direction="out"/> | |
196 ;; <arg name="prompt" type="o" direction="out"/> | |
197 ;; </method> | |
198 ;; <method name="SearchItems"> | |
199 ;; <arg name="attributes" type="a{ss}" direction="in"/> | |
200 ;; <arg name="unlocked" type="ao" direction="out"/> | |
201 ;; <arg name="locked" type="ao" direction="out"/> | |
202 ;; </method> | |
203 ;; <method name="Unlock"> | |
204 ;; <arg name="objects" type="ao" direction="in"/> | |
205 ;; <arg name="unlocked" type="ao" direction="out"/> | |
206 ;; <arg name="prompt" type="o" direction="out"/> | |
207 ;; </method> | |
208 ;; <method name="Lock"> | |
209 ;; <arg name="objects" type="ao" direction="in"/> | |
210 ;; <arg name="locked" type="ao" direction="out"/> | |
211 ;; <arg name="Prompt" type="o" direction="out"/> | |
212 ;; </method> | |
213 ;; <method name="GetSecrets"> | |
214 ;; <arg name="items" type="ao" direction="in"/> | |
215 ;; <arg name="session" type="o" direction="in"/> | |
216 ;; <arg name="secrets" type="a{o(oayay)}" direction="out"/> | |
217 ;; </method> | |
218 ;; <method name="ReadAlias"> | |
219 ;; <arg name="name" type="s" direction="in"/> | |
220 ;; <arg name="collection" type="o" direction="out"/> | |
221 ;; </method> | |
222 ;; <method name="SetAlias"> | |
223 ;; <arg name="name" type="s" direction="in"/> | |
224 ;; <arg name="collection" type="o" direction="in"/> | |
225 ;; </method> | |
226 ;; <signal name="CollectionCreated"> | |
227 ;; <arg name="collection" type="o"/> | |
228 ;; </signal> | |
229 ;; <signal name="CollectionDeleted"> | |
230 ;; <arg name="collection" type="o"/> | |
231 ;; </signal> | |
232 ;; </interface> | |
233 | |
234 (defconst secrets-interface-collection "org.freedesktop.Secret.Collection" | |
235 "A collection of items containing secrets.") | |
236 | |
237 ;; <interface name="org.freedesktop.Secret.Collection"> | |
238 ;; <property name="Items" type="ao" access="read"/> | |
239 ;; <property name="Label" type="s" access="readwrite"/> | |
240 ;; <property name="Locked" type="s" access="read"/> | |
241 ;; <property name="Created" type="t" access="read"/> | |
242 ;; <property name="Modified" type="t" access="read"/> | |
243 ;; <method name="Delete"> | |
244 ;; <arg name="prompt" type="o" direction="out"/> | |
245 ;; </method> | |
246 ;; <method name="SearchItems"> | |
247 ;; <arg name="attributes" type="a{ss}" direction="in"/> | |
248 ;; <arg name="results" type="ao" direction="out"/> | |
249 ;; </method> | |
250 ;; <method name="CreateItem"> | |
251 ;; <arg name="props" type="a{sv}" direction="in"/> | |
252 ;; <arg name="secret" type="(oayay)" direction="in"/> | |
253 ;; <arg name="replace" type="b" direction="in"/> | |
254 ;; <arg name="item" type="o" direction="out"/> | |
255 ;; <arg name="prompt" type="o" direction="out"/> | |
256 ;; </method> | |
257 ;; <signal name="ItemCreated"> | |
258 ;; <arg name="item" type="o"/> | |
259 ;; </signal> | |
260 ;; <signal name="ItemDeleted"> | |
261 ;; <arg name="item" type="o"/> | |
262 ;; </signal> | |
263 ;; <signal name="ItemChanged"> | |
264 ;; <arg name="item" type="o"/> | |
265 ;; </signal> | |
266 ;; </interface> | |
267 | |
268 (defconst secrets-session-collection-path | |
269 "/org/freedesktop/secrets/collection/session" | |
270 "The D-Bus temporary session collection object path.") | |
271 | |
272 (defconst secrets-interface-prompt "org.freedesktop.Secret.Prompt" | |
273 "A session tracks state between the service and a client application.") | |
274 | |
275 ;; <interface name="org.freedesktop.Secret.Prompt"> | |
276 ;; <method name="Prompt"> | |
277 ;; <arg name="window-id" type="s" direction="in"/> | |
278 ;; </method> | |
279 ;; <method name="Dismiss"></method> | |
280 ;; <signal name="Completed"> | |
281 ;; <arg name="dismissed" type="b"/> | |
282 ;; <arg name="result" type="v"/> | |
283 ;; </signal> | |
284 ;; </interface> | |
285 | |
286 (defconst secrets-interface-item "org.freedesktop.Secret.Item" | |
287 "A collection of items containing secrets.") | |
288 | |
289 ;; <interface name="org.freedesktop.Secret.Item"> | |
290 ;; <property name="Locked" type="b" access="read"/> | |
291 ;; <property name="Attributes" type="a{ss}" access="readwrite"/> | |
292 ;; <property name="Label" type="s" access="readwrite"/> | |
293 ;; <property name="Created" type="t" access="read"/> | |
294 ;; <property name="Modified" type="t" access="read"/> | |
295 ;; <method name="Delete"> | |
296 ;; <arg name="prompt" type="o" direction="out"/> | |
297 ;; </method> | |
298 ;; <method name="GetSecret"> | |
299 ;; <arg name="session" type="o" direction="in"/> | |
300 ;; <arg name="secret" type="(oayay)" direction="out"/> | |
301 ;; </method> | |
302 ;; <method name="SetSecret"> | |
303 ;; <arg name="secret" type="(oayay)" direction="in"/> | |
304 ;; </method> | |
305 ;; </interface> | |
306 ;; | |
307 ;; STRUCT secret | |
308 ;; OBJECT PATH session | |
309 ;; ARRAY BYTE parameters | |
310 ;; ARRAY BYTE value | |
311 | |
312 (defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic" | |
313 "The default item type we are using.") | |
314 | |
315 (defconst secrets-interface-session "org.freedesktop.Secret.Session" | |
316 "A session tracks state between the service and a client application.") | |
317 | |
318 ;; <interface name="org.freedesktop.Secret.Session"> | |
319 ;; <method name="Close"></method> | |
320 ;; </interface> | |
321 | |
322 ;;; Sessions. | |
323 | |
324 (defvar secrets-session-path secrets-empty-path | |
325 "The D-Bus session path of the active session. | |
326 A session path `secrets-empty-path' indicates there is no open session.") | |
327 | |
328 (defun secrets-close-session () | |
329 "Close the secret service session, if any." | |
330 (dbus-ignore-errors | |
331 (dbus-call-method | |
332 :session secrets-service secrets-session-path | |
333 secrets-interface-session "Close")) | |
334 (setq secrets-session-path secrets-empty-path)) | |
335 | |
336 (defun secrets-open-session (&optional reopen) | |
337 "Open a new session with \"plain\" algorithm. | |
338 If there exists another active session, and REOPEN is nil, that | |
339 session will be used. The object path of the session will be | |
340 returned, and it will be stored in `secrets-session-path'." | |
341 (when reopen (secrets-close-session)) | |
342 (when (secrets-empty-path secrets-session-path) | |
343 (setq secrets-session-path | |
344 (cadr | |
345 (dbus-call-method | |
346 :session secrets-service secrets-path | |
347 secrets-interface-service "OpenSession" "plain" '(:variant ""))))) | |
348 (when secrets-debug | |
349 (message "Secret Service session: %s" secrets-session-path)) | |
350 secrets-session-path) | |
351 | |
352 ;;; Prompts. | |
353 | |
354 (defvar secrets-prompt-signal nil | |
355 "Internal variable to catch signals from `secrets-interface-prompt'.") | |
356 | |
357 (defun secrets-prompt (prompt) | |
358 "Handle the prompt identified by object path PROMPT." | |
359 (unless (secrets-empty-path prompt) | |
360 (let ((object | |
361 (dbus-register-signal | |
362 :session secrets-service prompt | |
363 secrets-interface-prompt "Completed" 'secrets-prompt-handler))) | |
364 (dbus-call-method | |
365 :session secrets-service prompt | |
366 secrets-interface-prompt "Prompt" (frame-parameter nil 'window-id)) | |
367 (unwind-protect | |
368 (progn | |
369 ;; Wait until the returned prompt signal has put the | |
370 ;; result into `secrets-prompt-signal'. | |
371 (while (null secrets-prompt-signal) | |
372 (read-event nil nil 0.1)) | |
373 ;; Return the object(s). It is a variant, so we must use a car. | |
374 (car secrets-prompt-signal)) | |
375 ;; Cleanup. | |
376 (setq secrets-prompt-signal nil) | |
377 (dbus-unregister-object object))))) | |
378 | |
379 (defun secrets-prompt-handler (&rest args) | |
380 "Handler for signals emitted by `secrets-interface-prompt'." | |
381 ;; An empty object path is always identified as `secrets-empty-path' | |
382 ;; or `nil'. Either we set it explicitely, or it is returned by the | |
383 ;; "Completed" signal. | |
384 (if (car args) ;; dismissed | |
385 (setq secrets-prompt-signal (list secrets-empty-path)) | |
386 (setq secrets-prompt-signal (cadr args)))) | |
387 | |
388 ;;; Collections. | |
389 | |
390 (defvar secrets-collection-paths nil | |
391 "Cached D-Bus object paths of available collections.") | |
392 | |
393 (defun secrets-collection-handler (&rest args) | |
394 "Handler for signals emitted by `secrets-interface-service'." | |
395 (cond | |
396 ((string-equal (dbus-event-member-name last-input-event) "CollectionCreated") | |
397 (add-to-list 'secrets-collection-paths (car args))) | |
398 ((string-equal (dbus-event-member-name last-input-event) "CollectionDeleted") | |
399 (setq secrets-collection-paths | |
400 (delete (car args) secrets-collection-paths))))) | |
401 | |
402 (defun secrets-get-collections () | |
403 "Return the object paths of all available collections." | |
404 (setq secrets-collection-paths | |
405 (or secrets-collection-paths | |
406 (dbus-get-property | |
407 :session secrets-service secrets-path | |
408 secrets-interface-service "Collections")))) | |
409 | |
410 (defun secrets-get-collection-properties (collection-path) | |
411 "Return all properties of collection identified by COLLECTION-PATH." | |
412 (unless (secrets-empty-path collection-path) | |
413 (dbus-get-all-properties | |
414 :session secrets-service collection-path | |
415 secrets-interface-collection))) | |
416 | |
417 (defun secrets-get-collection-property (collection-path property) | |
418 "Return property PROPERTY of collection identified by COLLECTION-PATH." | |
419 (unless (or (secrets-empty-path collection-path) (not (stringp property))) | |
420 (dbus-get-property | |
421 :session secrets-service collection-path | |
422 secrets-interface-collection property))) | |
423 | |
424 (defun secrets-list-collections () | |
425 "Return a list of collection names." | |
426 (mapcar | |
427 (lambda (collection-path) | |
428 (if (string-equal collection-path secrets-session-collection-path) | |
429 "session" | |
430 (secrets-get-collection-property collection-path "Label"))) | |
431 (secrets-get-collections))) | |
432 | |
433 (defun secrets-collection-path (collection) | |
434 "Return the object path of collection labelled COLLECTION. | |
435 If COLLECTION is nil, return the session collection path. | |
436 If there is no such COLLECTION, return nil." | |
437 (or | |
438 ;; The "session" collection. | |
439 (if (or (null collection) (string-equal "session" collection)) | |
440 secrets-session-collection-path) | |
441 ;; Check for an alias. | |
442 (let ((collection-path | |
443 (dbus-call-method | |
444 :session secrets-service secrets-path | |
445 secrets-interface-service "ReadAlias" collection))) | |
446 (unless (secrets-empty-path collection-path) | |
447 collection-path)) | |
448 ;; Check the collections. | |
449 (catch 'collection-found | |
450 (dolist (collection-path (secrets-get-collections) nil) | |
451 (when | |
452 (string-equal | |
453 collection | |
454 (secrets-get-collection-property collection-path "Label")) | |
455 (throw 'collection-found collection-path)))))) | |
456 | |
457 (defun secrets-create-collection (collection) | |
458 "Create collection labelled COLLECTION if it doesn't exist. | |
459 Return the D-Bus object path for collection." | |
460 (let ((collection-path (secrets-collection-path collection))) | |
461 ;; Create the collection. | |
462 (when (secrets-empty-path collection-path) | |
463 (setq collection-path | |
464 (secrets-prompt | |
465 (cadr | |
466 ;; "CreateCollection" returns the prompt path as second arg. | |
467 (dbus-call-method | |
468 :session secrets-service secrets-path | |
469 secrets-interface-service "CreateCollection" | |
470 `(:array (:dict-entry "Label" (:variant ,collection)))))))) | |
471 ;; Return object path of the collection. | |
472 collection-path)) | |
473 | |
474 (defun secrets-get-alias (alias) | |
475 "Return the collection name ALIAS is referencing to. | |
476 For the time being, only the alias \"default\" is supported." | |
477 (secrets-get-collection-property | |
478 (dbus-call-method | |
479 :session secrets-service secrets-path | |
480 secrets-interface-service "ReadAlias" alias) | |
481 "Label")) | |
482 | |
483 (defun secrets-set-alias (collection alias) | |
484 "Set ALIAS as alias of collection labelled COLLECTION. | |
485 For the time being, only the alias \"default\" is supported." | |
486 (let ((collection-path (secrets-collection-path collection))) | |
487 (unless (secrets-empty-path collection-path) | |
488 (dbus-call-method | |
489 :session secrets-service secrets-path | |
490 secrets-interface-service "SetAlias" | |
491 alias :object-path collection-path)))) | |
492 | |
493 (defun secrets-unlock-collection (collection) | |
494 "Unlock collection labelled COLLECTION. | |
495 If successful, return the object path of the collection." | |
496 (let ((collection-path (secrets-collection-path collection))) | |
497 (unless (secrets-empty-path collection-path) | |
498 (secrets-prompt | |
499 (cadr | |
500 (dbus-call-method | |
501 :session secrets-service secrets-path secrets-interface-service | |
502 "Unlock" `(:array :object-path ,collection-path))))) | |
503 collection-path)) | |
504 | |
505 (defun secrets-delete-collection (collection) | |
506 "Delete collection labelled COLLECTION." | |
507 (let ((collection-path (secrets-collection-path collection))) | |
508 (unless (secrets-empty-path collection-path) | |
509 (secrets-prompt | |
510 (dbus-call-method | |
511 :session secrets-service collection-path | |
512 secrets-interface-collection "Delete"))))) | |
513 | |
514 ;;; Items. | |
515 | |
516 (defun secrets-get-items (collection-path) | |
517 "Return the object paths of all available items in COLLECTION-PATH." | |
518 (unless (secrets-empty-path collection-path) | |
519 (secrets-open-session) | |
520 (dbus-get-property | |
521 :session secrets-service collection-path | |
522 secrets-interface-collection "Items"))) | |
523 | |
524 (defun secrets-get-item-properties (item-path) | |
525 "Return all properties of item identified by ITEM-PATH." | |
526 (unless (secrets-empty-path item-path) | |
527 (dbus-get-all-properties | |
528 :session secrets-service item-path | |
529 secrets-interface-item))) | |
530 | |
531 (defun secrets-get-item-property (item-path property) | |
532 "Return property PROPERTY of item identified by ITEM-PATH." | |
533 (unless (or (secrets-empty-path item-path) (not (stringp property))) | |
534 (dbus-get-property | |
535 :session secrets-service item-path | |
536 secrets-interface-item property))) | |
537 | |
538 (defun secrets-list-items (collection) | |
539 "Return a list of all item labels of COLLECTION." | |
540 (let ((collection-path (secrets-unlock-collection collection))) | |
541 (unless (secrets-empty-path collection-path) | |
542 (mapcar | |
543 (lambda (item-path) | |
544 (secrets-get-item-property item-path "Label")) | |
545 (secrets-get-items collection-path))))) | |
546 | |
547 (defun secrets-search-items (collection &rest attributes) | |
548 "Search items in COLLECTION with ATTRIBUTES. | |
549 ATTRIBUTES are key-value pairs. The keys are keyword symbols, | |
550 starting with a colon. Example: | |
551 | |
552 \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\" | |
553 :method \"sudo\" :user \"joe\" :host \"remote-host\"\) | |
554 | |
555 The object paths of the found items are returned as list." | |
556 (let ((collection-path (secrets-unlock-collection collection)) | |
557 result props) | |
558 (unless (secrets-empty-path collection-path) | |
559 ;; Create attributes list. | |
560 (while (consp (cdr attributes)) | |
561 (unless (keywordp (car attributes)) | |
562 (error 'wrong-type-argument (car attributes))) | |
563 (setq props (add-to-list | |
564 'props | |
565 (list :dict-entry | |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
566 (substring (symbol-name (car attributes)) 1) |
107389 | 567 (cadr attributes)) |
568 'append) | |
569 attributes (cddr attributes))) | |
570 ;; Search. The result is a list of two lists, the object paths | |
571 ;; of the unlocked and the locked items. | |
572 (setq result | |
573 (dbus-call-method | |
574 :session secrets-service collection-path | |
575 secrets-interface-collection "SearchItems" | |
576 (if props | |
577 (cons :array props) | |
578 '(:array :signature "{ss}")))) | |
579 ;; Return the found items. | |
580 (mapcar | |
581 (lambda (item-path) (secrets-get-item-property item-path "Label")) | |
582 (append (car result) (cadr result)))))) | |
583 | |
584 (defun secrets-create-item (collection item password &rest attributes) | |
585 "Create a new item in COLLECTION with label ITEM and password PASSWORD. | |
586 ATTRIBUTES are key-value pairs set for the created item. The | |
587 keys are keyword symbols, starting with a colon. Example: | |
588 | |
589 \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\" | |
590 :method \"sudo\" :user \"joe\" :host \"remote-host\"\) | |
591 | |
592 The object path of the created item is returned." | |
593 (unless (member item (secrets-list-items collection)) | |
594 (let ((collection-path (secrets-unlock-collection collection)) | |
595 result props) | |
596 (unless (secrets-empty-path collection-path) | |
597 ;; Create attributes list. | |
598 (while (consp (cdr attributes)) | |
599 (unless (keywordp (car attributes)) | |
600 (error 'wrong-type-argument (car attributes))) | |
601 (setq props (add-to-list | |
602 'props | |
603 (list :dict-entry | |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
604 (substring (symbol-name (car attributes)) 1) |
107389 | 605 (cadr attributes)) |
606 'append) | |
607 attributes (cddr attributes))) | |
608 ;; Create the item. | |
609 (setq result | |
610 (dbus-call-method | |
611 :session secrets-service collection-path | |
612 secrets-interface-collection "CreateItem" | |
613 ;; Properties. | |
614 (append | |
615 `(:array | |
616 (:dict-entry "Label" (:variant ,item)) | |
617 (:dict-entry | |
618 "Type" (:variant ,secrets-interface-item-type-generic))) | |
619 (when props | |
620 `((:dict-entry | |
621 "Attributes" (:variant ,(append '(:array) props)))))) | |
622 ;; Secret. | |
623 `(:struct :object-path ,secrets-session-path | |
624 (:array :signature "y") ;; no parameters. | |
625 ,(dbus-string-to-byte-array password)) | |
626 ;; Do not replace. Replace does not seem to work. | |
627 nil)) | |
628 (secrets-prompt (cadr result)) | |
629 ;; Return the object path. | |
630 (car result))))) | |
631 | |
632 (defun secrets-item-path (collection item) | |
633 "Return the object path of item labelled ITEM in COLLECTION. | |
634 If there is no such item, return nil." | |
635 (let ((collection-path (secrets-unlock-collection collection))) | |
636 (catch 'item-found | |
637 (dolist (item-path (secrets-get-items collection-path)) | |
638 (when (string-equal item (secrets-get-item-property item-path "Label")) | |
639 (throw 'item-found item-path)))))) | |
640 | |
641 (defun secrets-get-secret (collection item) | |
642 "Return the secret of item labelled ITEM in COLLECTION. | |
643 If there is no such item, return nil." | |
644 (let ((item-path (secrets-item-path collection item))) | |
645 (unless (secrets-empty-path item-path) | |
646 (dbus-byte-array-to-string | |
647 (caddr | |
648 (dbus-call-method | |
649 :session secrets-service item-path secrets-interface-item | |
650 "GetSecret" :object-path secrets-session-path)))))) | |
651 | |
652 (defun secrets-get-attributes (collection item) | |
653 "Return the lookup attributes of item labelled ITEM in COLLECTION. | |
654 If there is no such item, or the item has no attributes, return nil." | |
655 (unless (stringp collection) (setq collection "default")) | |
656 (let ((item-path (secrets-item-path collection item))) | |
657 (unless (secrets-empty-path item-path) | |
658 (mapcar | |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
659 (lambda (attribute) |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
660 (cons (intern (concat ":" (car attribute))) (cadr attribute))) |
107389 | 661 (dbus-get-property |
662 :session secrets-service item-path | |
663 secrets-interface-item "Attributes"))))) | |
664 | |
665 (defun secrets-get-attribute (collection item attribute) | |
666 "Return the value of ATTRIBUTE of item labelled ITEM in COLLECTION. | |
667 If there is no such item, or the item doesn't own this attribute, return nil." | |
668 (cdr (assoc attribute (secrets-get-attributes collection item)))) | |
669 | |
670 (defun secrets-delete-item (collection item) | |
671 "Delete ITEM in COLLECTION." | |
672 (let ((item-path (secrets-item-path collection item))) | |
673 (unless (secrets-empty-path item-path) | |
674 (secrets-prompt | |
675 (dbus-call-method | |
676 :session secrets-service item-path | |
677 secrets-interface-item "Delete"))))) | |
678 | |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
679 ;;; Visualization. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
680 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
681 (define-derived-mode secrets-mode nil "Secrets" |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
682 "Major mode for presenting password entries retrieved by Security Service. |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
683 In this mode, widgets represent the search results. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
684 |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
685 \\{secrets-mode-map}" |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
686 ;; Keymap. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
687 (setq secrets-mode-map (copy-keymap special-mode-map)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
688 (set-keymap-parent secrets-mode-map widget-keymap) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
689 (define-key secrets-mode-map "z" 'kill-this-buffer) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
690 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
691 ;; When we toggle, we must set temporary widgets. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
692 (set (make-local-variable 'tree-widget-after-toggle-functions) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
693 '(secrets-tree-widget-after-toggle-function)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
694 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
695 (when (not (called-interactively-p 'interactive)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
696 ;; Initialize buffer. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
697 (setq buffer-read-only t) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
698 (let ((inhibit-read-only t)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
699 (erase-buffer)))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
700 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
701 ;; It doesn't make sense to call it interactively. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
702 (put 'secrets-mode 'disabled t) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
703 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
704 ;; The very first buffer created with `secrets-mode' does not have the |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
705 ;; keymap etc. So we create a dummy buffer. Stupid. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
706 (with-temp-buffer (secrets-mode)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
707 |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
708 ;; We autoload `secrets-show-secrets' only on systems with D-Bus support. |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
709 ;;;###autoload(when (featurep 'dbusbind) |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
710 ;;;###autoload (autoload 'secrets-show-secrets "secrets" nil t)) |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
711 |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
712 (defun secrets-show-secrets () |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
713 "Display a list of collections from the Secret Service API. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
714 The collections are in tree view, that means they can be expanded |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
715 to the corresponding secret items, which could also be expanded |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
716 to their attributes." |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
717 (interactive) |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
718 |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
719 ;; Check, whether the Secret Service API is enabled. |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
720 (if (null secrets-enabled) |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
721 (message "Secret Service not available") |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
722 |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
723 ;; Create the search buffer. |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
724 (with-current-buffer (get-buffer-create "*Secrets*") |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
725 (switch-to-buffer-other-window (current-buffer)) |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
726 ;; Inialize buffer with `secrets-mode'. |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
727 (secrets-mode) |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
728 (secrets-show-collections)))) |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
729 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
730 (defun secrets-show-collections () |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
731 "Show all available collections." |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
732 (let ((inhibit-read-only t) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
733 (alias (secrets-get-alias "default"))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
734 (erase-buffer) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
735 (tree-widget-set-theme "folder") |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
736 (dolist (coll (secrets-list-collections)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
737 (widget-create |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
738 `(tree-widget |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
739 :tag ,coll |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
740 :collection ,coll |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
741 :open nil |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
742 :sample-face bold |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
743 :expander secrets-expand-collection))))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
744 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
745 (defun secrets-expand-collection (widget) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
746 "Expand items of collection shown as WIDGET." |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
747 (let ((coll (widget-get widget :collection))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
748 (mapcar |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
749 (lambda (item) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
750 `(tree-widget |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
751 :tag ,item |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
752 :collection ,coll |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
753 :item ,item |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
754 :open nil |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
755 :sample-face bold |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
756 :expander secrets-expand-item)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
757 (secrets-list-items coll)))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
758 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
759 (defun secrets-expand-item (widget) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
760 "Expand password and attributes of item shown as WIDGET." |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
761 (let* ((coll (widget-get widget :collection)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
762 (item (widget-get widget :item)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
763 (attributes (secrets-get-attributes coll item)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
764 ;; padding is needed to format attribute names. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
765 (padding |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
766 (apply |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
767 'max |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
768 (cons |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
769 (1+ (length "password")) |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
770 (mapcar |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
771 ;; Atribute names have a leading ":", which will be suppressed. |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
772 (lambda (attribute) (length (symbol-name (car attribute)))) |
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
773 attributes))))) |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
774 (cons |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
775 ;; The password widget. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
776 `(editable-field :tag "password" |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
777 :secret ?* |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
778 :value ,(secrets-get-secret coll item) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
779 :sample-face widget-button-pressed |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
780 ;; We specify :size in order to limit the field. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
781 :size 0 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
782 :format ,(concat |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
783 "%{%t%}:" |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
784 (make-string (- padding (length "password")) ? ) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
785 "%v\n")) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
786 (mapcar |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
787 (lambda (attribute) |
108699
69ac0d220a1c
* net/secrets.el: Autoload the widget functions.
Michael Albinus <michael.albinus@gmx.de>
parents:
108653
diff
changeset
|
788 (let ((name (substring (symbol-name (car attribute)) 1)) |
108653
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
789 (value (cdr attribute))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
790 ;; The attribute widget. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
791 `(editable-field :tag ,name |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
792 :value ,value |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
793 :sample-face widget-documentation |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
794 ;; We specify :size in order to limit the field. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
795 :size 0 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
796 :format ,(concat |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
797 "%{%t%}:" |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
798 (make-string (- padding (length name)) ? ) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
799 "%v\n")))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
800 attributes)))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
801 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
802 (defun secrets-tree-widget-after-toggle-function (widget &rest ignore) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
803 "Add a temporary widget to show the password." |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
804 (dolist (child (widget-get widget :children)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
805 (when (widget-member child :secret) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
806 (goto-char (widget-field-end child)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
807 (widget-insert " ") |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
808 (widget-create-child-and-convert |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
809 child 'push-button |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
810 :notify 'secrets-tree-widget-show-password |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
811 "Show password"))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
812 (widget-setup)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
813 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
814 (defun secrets-tree-widget-show-password (widget &rest ignore) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
815 "Show password, and remove temporary widget." |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
816 (let ((parent (widget-get widget :parent))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
817 (widget-put parent :secret nil) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
818 (widget-default-value-set parent (widget-get parent :value)) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
819 (widget-setup))) |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
820 |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
821 ;;; Initialization. |
feaedf49cc07
Add visualization code for secrets.
Michael Albinus <albinus@detlef>
parents:
107447
diff
changeset
|
822 |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
823 (when (dbus-ping :session secrets-service 100) |
107396
d5de7ba3f80f
* net/secrets.el (top): Register the D-Bus signals only when the
Michael Albinus <albinus@detlef>
parents:
107389
diff
changeset
|
824 |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
825 ;; We must reset all variables, when there is a new instance of the |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
826 ;; "org.freedesktop.secrets" service. |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
827 (dbus-register-signal |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
828 :session dbus-service-dbus dbus-path-dbus |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
829 dbus-interface-dbus "NameOwnerChanged" |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
830 (lambda (&rest args) |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
831 (when secrets-debug (message "Secret Service has changed: %S" args)) |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
832 (setq secrets-session-path secrets-empty-path |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
833 secrets-prompt-signal nil |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
834 secrets-collection-paths nil)) |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
835 secrets-service) |
107389 | 836 |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
837 ;; We want to refresh our cache, when there is a change in |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
838 ;; collections. |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
839 (dbus-register-signal |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
840 :session secrets-service secrets-path |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
841 secrets-interface-service "CollectionCreated" |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
842 'secrets-collection-handler) |
107389 | 843 |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
844 (dbus-register-signal |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
845 :session secrets-service secrets-path |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
846 secrets-interface-service "CollectionDeleted" |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
847 'secrets-collection-handler) |
107396
d5de7ba3f80f
* net/secrets.el (top): Register the D-Bus signals only when the
Michael Albinus <albinus@detlef>
parents:
107389
diff
changeset
|
848 |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
849 ;; We shall inform, whether the secret service is enabled on this |
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
850 ;; machine. |
107447
9d443ad80849
Fix unbalanced parenthesis in secrets.el.
Ted Zlatanov <tzz@lifelogs.com>
parents:
107397
diff
changeset
|
851 (setq secrets-enabled t)) |
107396
d5de7ba3f80f
* net/secrets.el (top): Register the D-Bus signals only when the
Michael Albinus <albinus@detlef>
parents:
107389
diff
changeset
|
852 |
107397
6c48d0b283da
* net/secrets.el (secrets-enabled): New variable. Use it instead
Michael Albinus <albinus@detlef>
parents:
107396
diff
changeset
|
853 (provide 'secrets) |
107389 | 854 |
855 ;;; TODO: | |
856 | |
857 ;; * secrets-debug should be structured like auth-source-debug to | |
858 ;; prevent leaking sensitive information. Right now I don't see | |
859 ;; anything sensitive though. | |
860 ;; * Check, whether the dh-ietf1024-aes128-cbc-pkcs7 algorithm can be | |
861 ;; used for the transfer of the secrets. Currently, we use the | |
862 ;; plain algorithm. |