Commit | Line | Data |
---|---|---|
7725ebb7 MA |
1 | ;;; secrets.el --- Client interface to gnome-keyring and kwallet. |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2010-2014 Free Software Foundation, Inc. |
7725ebb7 MA |
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: | |
7c75524e | 35 | ;; |
7725ebb7 | 36 | ;; (require 'secrets) |
7c75524e | 37 | ;; |
ae84eb97 MA |
38 | ;; Afterwards, the variable `secrets-enabled' is non-nil when there is |
39 | ;; a daemon providing this interface. | |
7c75524e | 40 | |
7725ebb7 MA |
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 | |
44e97401 | 81 | ;; lifetime of the corresponding client session (aka Emacs's |
7725ebb7 MA |
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 | |
44e97401 | 102 | ;; is bound to Emacs's lifetime. |
7725ebb7 MA |
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 | ||
3a8e7cbd MA |
132 | ;; Interactively, collections, items and their attributes could be |
133 | ;; inspected by the command `secrets-show-secrets'. | |
134 | ||
7725ebb7 MA |
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. | |
a464a6c7 | 145 | (eval-when-compile (require 'cl-lib)) |
7725ebb7 | 146 | |
7725ebb7 MA |
147 | (defvar dbus-debug) |
148 | ||
149 | (require 'dbus) | |
150 | ||
8d9181c7 MA |
151 | (autoload 'tree-widget-set-theme "tree-widget") |
152 | (autoload 'widget-create-child-and-convert "wid-edit") | |
153 | (autoload 'widget-default-value-set "wid-edit") | |
154 | (autoload 'widget-field-end "wid-edit") | |
155 | (autoload 'widget-member "wid-edit") | |
3a8e7cbd MA |
156 | (defvar tree-widget-after-toggle-functions) |
157 | ||
ae84eb97 | 158 | (defvar secrets-enabled nil |
f05e1b94 | 159 | "Whether there is a daemon offering the Secret Service API.") |
ae84eb97 | 160 | |
7725ebb7 MA |
161 | (defvar secrets-debug t |
162 | "Write debug messages") | |
163 | ||
164 | (defconst secrets-service "org.freedesktop.secrets" | |
165 | "The D-Bus name used to talk to Secret Service.") | |
166 | ||
167 | (defconst secrets-path "/org/freedesktop/secrets" | |
168 | "The D-Bus root object path used to talk to Secret Service.") | |
169 | ||
170 | (defconst secrets-empty-path "/" | |
171 | "The D-Bus object path representing an empty object.") | |
172 | ||
173 | (defsubst secrets-empty-path (path) | |
174 | "Check, whether PATH is a valid object path. | |
175 | It returns t if not." | |
176 | (or (not (stringp path)) | |
177 | (string-equal path secrets-empty-path))) | |
178 | ||
179 | (defconst secrets-interface-service "org.freedesktop.Secret.Service" | |
180 | "The D-Bus interface managing sessions and collections.") | |
181 | ||
182 | ;; <interface name="org.freedesktop.Secret.Service"> | |
183 | ;; <property name="Collections" type="ao" access="read"/> | |
184 | ;; <method name="OpenSession"> | |
185 | ;; <arg name="algorithm" type="s" direction="in"/> | |
186 | ;; <arg name="input" type="v" direction="in"/> | |
187 | ;; <arg name="output" type="v" direction="out"/> | |
188 | ;; <arg name="result" type="o" direction="out"/> | |
189 | ;; </method> | |
190 | ;; <method name="CreateCollection"> | |
191 | ;; <arg name="props" type="a{sv}" direction="in"/> | |
9e6229fa | 192 | ;; <arg name="alias" type="s" direction="in"/> ;; Added 2011/3/1 |
7725ebb7 MA |
193 | ;; <arg name="collection" type="o" direction="out"/> |
194 | ;; <arg name="prompt" type="o" direction="out"/> | |
195 | ;; </method> | |
196 | ;; <method name="SearchItems"> | |
197 | ;; <arg name="attributes" type="a{ss}" direction="in"/> | |
198 | ;; <arg name="unlocked" type="ao" direction="out"/> | |
199 | ;; <arg name="locked" type="ao" direction="out"/> | |
200 | ;; </method> | |
201 | ;; <method name="Unlock"> | |
202 | ;; <arg name="objects" type="ao" direction="in"/> | |
203 | ;; <arg name="unlocked" type="ao" direction="out"/> | |
204 | ;; <arg name="prompt" type="o" direction="out"/> | |
205 | ;; </method> | |
206 | ;; <method name="Lock"> | |
207 | ;; <arg name="objects" type="ao" direction="in"/> | |
208 | ;; <arg name="locked" type="ao" direction="out"/> | |
209 | ;; <arg name="Prompt" type="o" direction="out"/> | |
210 | ;; </method> | |
211 | ;; <method name="GetSecrets"> | |
9abefce4 MA |
212 | ;; <arg name="items" type="ao" direction="in"/> |
213 | ;; <arg name="session" type="o" direction="in"/> | |
214 | ;; <arg name="secrets" type="a{o(oayays)}" direction="out"/> | |
7725ebb7 MA |
215 | ;; </method> |
216 | ;; <method name="ReadAlias"> | |
217 | ;; <arg name="name" type="s" direction="in"/> | |
218 | ;; <arg name="collection" type="o" direction="out"/> | |
219 | ;; </method> | |
220 | ;; <method name="SetAlias"> | |
221 | ;; <arg name="name" type="s" direction="in"/> | |
222 | ;; <arg name="collection" type="o" direction="in"/> | |
223 | ;; </method> | |
224 | ;; <signal name="CollectionCreated"> | |
225 | ;; <arg name="collection" type="o"/> | |
226 | ;; </signal> | |
227 | ;; <signal name="CollectionDeleted"> | |
228 | ;; <arg name="collection" type="o"/> | |
229 | ;; </signal> | |
230 | ;; </interface> | |
231 | ||
232 | (defconst secrets-interface-collection "org.freedesktop.Secret.Collection" | |
233 | "A collection of items containing secrets.") | |
234 | ||
235 | ;; <interface name="org.freedesktop.Secret.Collection"> | |
236 | ;; <property name="Items" type="ao" access="read"/> | |
237 | ;; <property name="Label" type="s" access="readwrite"/> | |
9abefce4 | 238 | ;; <property name="Locked" type="b" access="read"/> |
7725ebb7 MA |
239 | ;; <property name="Created" type="t" access="read"/> |
240 | ;; <property name="Modified" type="t" access="read"/> | |
241 | ;; <method name="Delete"> | |
242 | ;; <arg name="prompt" type="o" direction="out"/> | |
243 | ;; </method> | |
244 | ;; <method name="SearchItems"> | |
245 | ;; <arg name="attributes" type="a{ss}" direction="in"/> | |
246 | ;; <arg name="results" type="ao" direction="out"/> | |
247 | ;; </method> | |
248 | ;; <method name="CreateItem"> | |
9abefce4 MA |
249 | ;; <arg name="props" type="a{sv}" direction="in"/> |
250 | ;; <arg name="secret" type="(oayays)" direction="in"/> | |
251 | ;; <arg name="replace" type="b" direction="in"/> | |
252 | ;; <arg name="item" type="o" direction="out"/> | |
253 | ;; <arg name="prompt" type="o" direction="out"/> | |
7725ebb7 MA |
254 | ;; </method> |
255 | ;; <signal name="ItemCreated"> | |
256 | ;; <arg name="item" type="o"/> | |
257 | ;; </signal> | |
258 | ;; <signal name="ItemDeleted"> | |
259 | ;; <arg name="item" type="o"/> | |
260 | ;; </signal> | |
261 | ;; <signal name="ItemChanged"> | |
262 | ;; <arg name="item" type="o"/> | |
263 | ;; </signal> | |
264 | ;; </interface> | |
265 | ||
266 | (defconst secrets-session-collection-path | |
267 | "/org/freedesktop/secrets/collection/session" | |
268 | "The D-Bus temporary session collection object path.") | |
269 | ||
270 | (defconst secrets-interface-prompt "org.freedesktop.Secret.Prompt" | |
271 | "A session tracks state between the service and a client application.") | |
272 | ||
273 | ;; <interface name="org.freedesktop.Secret.Prompt"> | |
274 | ;; <method name="Prompt"> | |
275 | ;; <arg name="window-id" type="s" direction="in"/> | |
276 | ;; </method> | |
277 | ;; <method name="Dismiss"></method> | |
278 | ;; <signal name="Completed"> | |
279 | ;; <arg name="dismissed" type="b"/> | |
280 | ;; <arg name="result" type="v"/> | |
281 | ;; </signal> | |
282 | ;; </interface> | |
283 | ||
284 | (defconst secrets-interface-item "org.freedesktop.Secret.Item" | |
285 | "A collection of items containing secrets.") | |
286 | ||
287 | ;; <interface name="org.freedesktop.Secret.Item"> | |
288 | ;; <property name="Locked" type="b" access="read"/> | |
289 | ;; <property name="Attributes" type="a{ss}" access="readwrite"/> | |
290 | ;; <property name="Label" type="s" access="readwrite"/> | |
291 | ;; <property name="Created" type="t" access="read"/> | |
292 | ;; <property name="Modified" type="t" access="read"/> | |
293 | ;; <method name="Delete"> | |
294 | ;; <arg name="prompt" type="o" direction="out"/> | |
295 | ;; </method> | |
296 | ;; <method name="GetSecret"> | |
9abefce4 MA |
297 | ;; <arg name="session" type="o" direction="in"/> |
298 | ;; <arg name="secret" type="(oayays)" direction="out"/> | |
7725ebb7 MA |
299 | ;; </method> |
300 | ;; <method name="SetSecret"> | |
9abefce4 | 301 | ;; <arg name="secret" type="(oayays)" direction="in"/> |
7725ebb7 MA |
302 | ;; </method> |
303 | ;; </interface> | |
304 | ;; | |
305 | ;; STRUCT secret | |
306 | ;; OBJECT PATH session | |
307 | ;; ARRAY BYTE parameters | |
308 | ;; ARRAY BYTE value | |
9abefce4 | 309 | ;; STRING content_type ;; Added 2011/2/9 |
7725ebb7 MA |
310 | |
311 | (defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic" | |
312 | "The default item type we are using.") | |
313 | ||
e59dfb0e MA |
314 | ;; We cannot use introspection, because some servers, like |
315 | ;; mate-keyring-daemon, don't provide relevant data. Once the dust | |
316 | ;; has settled, we shall assume the new interface, and get rid of the test. | |
9abefce4 | 317 | (defconst secrets-struct-secret-content-type |
e59dfb0e MA |
318 | (ignore-errors |
319 | (let ((content-type "text/plain") | |
320 | (path (cadr | |
321 | (dbus-call-method | |
322 | :session secrets-service secrets-path | |
323 | secrets-interface-service | |
324 | "OpenSession" "plain" '(:variant "")))) | |
325 | result) | |
326 | ;; Create a dummy item. | |
327 | (setq result | |
328 | (dbus-call-method | |
329 | :session secrets-service secrets-session-collection-path | |
330 | secrets-interface-collection "CreateItem" | |
331 | ;; Properties. | |
332 | `(:array | |
333 | (:dict-entry ,(concat secrets-interface-item ".Label") | |
334 | (:variant "dummy")) | |
335 | (:dict-entry ,(concat secrets-interface-item ".Type") | |
336 | (:variant ,secrets-interface-item-type-generic))) | |
337 | ;; Secret. | |
338 | `(:struct :object-path ,path | |
339 | (:array :signature "y") | |
340 | ,(dbus-string-to-byte-array " ") | |
341 | :string ,content-type) | |
342 | ;; Don't replace. | |
343 | nil)) | |
344 | ;; Remove it. | |
345 | (dbus-call-method | |
346 | :session secrets-service (car result) | |
347 | secrets-interface-item "Delete") | |
348 | ;; Result. | |
349 | `(,content-type))) | |
9abefce4 MA |
350 | "The content_type of a secret struct. |
351 | It must be wrapped as list, because we add it via `append'. This | |
352 | is an interface introduced in 2011.") | |
353 | ||
7725ebb7 MA |
354 | (defconst secrets-interface-session "org.freedesktop.Secret.Session" |
355 | "A session tracks state between the service and a client application.") | |
356 | ||
357 | ;; <interface name="org.freedesktop.Secret.Session"> | |
358 | ;; <method name="Close"></method> | |
359 | ;; </interface> | |
360 | ||
361 | ;;; Sessions. | |
362 | ||
363 | (defvar secrets-session-path secrets-empty-path | |
364 | "The D-Bus session path of the active session. | |
365 | A session path `secrets-empty-path' indicates there is no open session.") | |
366 | ||
367 | (defun secrets-close-session () | |
368 | "Close the secret service session, if any." | |
369 | (dbus-ignore-errors | |
370 | (dbus-call-method | |
371 | :session secrets-service secrets-session-path | |
372 | secrets-interface-session "Close")) | |
373 | (setq secrets-session-path secrets-empty-path)) | |
374 | ||
375 | (defun secrets-open-session (&optional reopen) | |
376 | "Open a new session with \"plain\" algorithm. | |
377 | If there exists another active session, and REOPEN is nil, that | |
378 | session will be used. The object path of the session will be | |
379 | returned, and it will be stored in `secrets-session-path'." | |
380 | (when reopen (secrets-close-session)) | |
381 | (when (secrets-empty-path secrets-session-path) | |
382 | (setq secrets-session-path | |
383 | (cadr | |
384 | (dbus-call-method | |
385 | :session secrets-service secrets-path | |
386 | secrets-interface-service "OpenSession" "plain" '(:variant ""))))) | |
387 | (when secrets-debug | |
388 | (message "Secret Service session: %s" secrets-session-path)) | |
389 | secrets-session-path) | |
390 | ||
391 | ;;; Prompts. | |
392 | ||
393 | (defvar secrets-prompt-signal nil | |
394 | "Internal variable to catch signals from `secrets-interface-prompt'.") | |
395 | ||
396 | (defun secrets-prompt (prompt) | |
397 | "Handle the prompt identified by object path PROMPT." | |
398 | (unless (secrets-empty-path prompt) | |
399 | (let ((object | |
400 | (dbus-register-signal | |
401 | :session secrets-service prompt | |
402 | secrets-interface-prompt "Completed" 'secrets-prompt-handler))) | |
403 | (dbus-call-method | |
404 | :session secrets-service prompt | |
405 | secrets-interface-prompt "Prompt" (frame-parameter nil 'window-id)) | |
406 | (unwind-protect | |
407 | (progn | |
408 | ;; Wait until the returned prompt signal has put the | |
409 | ;; result into `secrets-prompt-signal'. | |
410 | (while (null secrets-prompt-signal) | |
411 | (read-event nil nil 0.1)) | |
412 | ;; Return the object(s). It is a variant, so we must use a car. | |
413 | (car secrets-prompt-signal)) | |
414 | ;; Cleanup. | |
415 | (setq secrets-prompt-signal nil) | |
416 | (dbus-unregister-object object))))) | |
417 | ||
418 | (defun secrets-prompt-handler (&rest args) | |
419 | "Handler for signals emitted by `secrets-interface-prompt'." | |
420 | ;; An empty object path is always identified as `secrets-empty-path' | |
c7015153 | 421 | ;; or `nil'. Either we set it explicitly, or it is returned by the |
7725ebb7 MA |
422 | ;; "Completed" signal. |
423 | (if (car args) ;; dismissed | |
424 | (setq secrets-prompt-signal (list secrets-empty-path)) | |
425 | (setq secrets-prompt-signal (cadr args)))) | |
426 | ||
427 | ;;; Collections. | |
428 | ||
429 | (defvar secrets-collection-paths nil | |
430 | "Cached D-Bus object paths of available collections.") | |
431 | ||
432 | (defun secrets-collection-handler (&rest args) | |
433 | "Handler for signals emitted by `secrets-interface-service'." | |
434 | (cond | |
435 | ((string-equal (dbus-event-member-name last-input-event) "CollectionCreated") | |
436 | (add-to-list 'secrets-collection-paths (car args))) | |
437 | ((string-equal (dbus-event-member-name last-input-event) "CollectionDeleted") | |
438 | (setq secrets-collection-paths | |
439 | (delete (car args) secrets-collection-paths))))) | |
440 | ||
7725ebb7 MA |
441 | (defun secrets-get-collections () |
442 | "Return the object paths of all available collections." | |
443 | (setq secrets-collection-paths | |
444 | (or secrets-collection-paths | |
445 | (dbus-get-property | |
446 | :session secrets-service secrets-path | |
447 | secrets-interface-service "Collections")))) | |
448 | ||
449 | (defun secrets-get-collection-properties (collection-path) | |
450 | "Return all properties of collection identified by COLLECTION-PATH." | |
451 | (unless (secrets-empty-path collection-path) | |
452 | (dbus-get-all-properties | |
453 | :session secrets-service collection-path | |
454 | secrets-interface-collection))) | |
455 | ||
456 | (defun secrets-get-collection-property (collection-path property) | |
457 | "Return property PROPERTY of collection identified by COLLECTION-PATH." | |
458 | (unless (or (secrets-empty-path collection-path) (not (stringp property))) | |
459 | (dbus-get-property | |
460 | :session secrets-service collection-path | |
461 | secrets-interface-collection property))) | |
462 | ||
463 | (defun secrets-list-collections () | |
464 | "Return a list of collection names." | |
465 | (mapcar | |
466 | (lambda (collection-path) | |
467 | (if (string-equal collection-path secrets-session-collection-path) | |
468 | "session" | |
469 | (secrets-get-collection-property collection-path "Label"))) | |
470 | (secrets-get-collections))) | |
471 | ||
472 | (defun secrets-collection-path (collection) | |
09e80d9f | 473 | "Return the object path of collection labeled COLLECTION. |
7725ebb7 MA |
474 | If COLLECTION is nil, return the session collection path. |
475 | If there is no such COLLECTION, return nil." | |
476 | (or | |
477 | ;; The "session" collection. | |
478 | (if (or (null collection) (string-equal "session" collection)) | |
479 | secrets-session-collection-path) | |
480 | ;; Check for an alias. | |
481 | (let ((collection-path | |
482 | (dbus-call-method | |
483 | :session secrets-service secrets-path | |
484 | secrets-interface-service "ReadAlias" collection))) | |
485 | (unless (secrets-empty-path collection-path) | |
486 | collection-path)) | |
487 | ;; Check the collections. | |
488 | (catch 'collection-found | |
489 | (dolist (collection-path (secrets-get-collections) nil) | |
4c145d5d MA |
490 | (when (string-equal |
491 | collection | |
492 | (secrets-get-collection-property collection-path "Label")) | |
7725ebb7 MA |
493 | (throw 'collection-found collection-path)))))) |
494 | ||
9e6229fa | 495 | (defun secrets-create-collection (collection &optional alias) |
09e80d9f | 496 | "Create collection labeled COLLECTION if it doesn't exist. |
9e6229fa MA |
497 | Set ALIAS as alias of the collection. Return the D-Bus object |
498 | path for collection." | |
7725ebb7 MA |
499 | (let ((collection-path (secrets-collection-path collection))) |
500 | ;; Create the collection. | |
501 | (when (secrets-empty-path collection-path) | |
502 | (setq collection-path | |
503 | (secrets-prompt | |
504 | (cadr | |
505 | ;; "CreateCollection" returns the prompt path as second arg. | |
506 | (dbus-call-method | |
507 | :session secrets-service secrets-path | |
508 | secrets-interface-service "CreateCollection" | |
9e6229fa MA |
509 | `(:array |
510 | (:dict-entry ,(concat secrets-interface-collection ".Label") | |
511 | (:variant ,collection))) | |
512 | (or alias "")))))) | |
7725ebb7 MA |
513 | ;; Return object path of the collection. |
514 | collection-path)) | |
515 | ||
516 | (defun secrets-get-alias (alias) | |
517 | "Return the collection name ALIAS is referencing to. | |
518 | For the time being, only the alias \"default\" is supported." | |
519 | (secrets-get-collection-property | |
520 | (dbus-call-method | |
521 | :session secrets-service secrets-path | |
522 | secrets-interface-service "ReadAlias" alias) | |
523 | "Label")) | |
524 | ||
525 | (defun secrets-set-alias (collection alias) | |
09e80d9f | 526 | "Set ALIAS as alias of collection labeled COLLECTION. |
7725ebb7 MA |
527 | For the time being, only the alias \"default\" is supported." |
528 | (let ((collection-path (secrets-collection-path collection))) | |
529 | (unless (secrets-empty-path collection-path) | |
530 | (dbus-call-method | |
531 | :session secrets-service secrets-path | |
532 | secrets-interface-service "SetAlias" | |
533 | alias :object-path collection-path)))) | |
534 | ||
4c145d5d MA |
535 | (defun secrets-delete-alias (alias) |
536 | "Delete ALIAS, referencing to a collection." | |
537 | (dbus-call-method | |
538 | :session secrets-service secrets-path | |
539 | secrets-interface-service "SetAlias" | |
540 | alias :object-path secrets-empty-path)) | |
541 | ||
7725ebb7 | 542 | (defun secrets-unlock-collection (collection) |
09e80d9f | 543 | "Unlock collection labeled COLLECTION. |
7725ebb7 MA |
544 | If successful, return the object path of the collection." |
545 | (let ((collection-path (secrets-collection-path collection))) | |
546 | (unless (secrets-empty-path collection-path) | |
547 | (secrets-prompt | |
548 | (cadr | |
549 | (dbus-call-method | |
550 | :session secrets-service secrets-path secrets-interface-service | |
551 | "Unlock" `(:array :object-path ,collection-path))))) | |
552 | collection-path)) | |
553 | ||
554 | (defun secrets-delete-collection (collection) | |
09e80d9f | 555 | "Delete collection labeled COLLECTION." |
7725ebb7 MA |
556 | (let ((collection-path (secrets-collection-path collection))) |
557 | (unless (secrets-empty-path collection-path) | |
558 | (secrets-prompt | |
559 | (dbus-call-method | |
560 | :session secrets-service collection-path | |
561 | secrets-interface-collection "Delete"))))) | |
562 | ||
563 | ;;; Items. | |
564 | ||
565 | (defun secrets-get-items (collection-path) | |
566 | "Return the object paths of all available items in COLLECTION-PATH." | |
567 | (unless (secrets-empty-path collection-path) | |
568 | (secrets-open-session) | |
569 | (dbus-get-property | |
570 | :session secrets-service collection-path | |
571 | secrets-interface-collection "Items"))) | |
572 | ||
573 | (defun secrets-get-item-properties (item-path) | |
574 | "Return all properties of item identified by ITEM-PATH." | |
575 | (unless (secrets-empty-path item-path) | |
576 | (dbus-get-all-properties | |
577 | :session secrets-service item-path | |
578 | secrets-interface-item))) | |
579 | ||
580 | (defun secrets-get-item-property (item-path property) | |
581 | "Return property PROPERTY of item identified by ITEM-PATH." | |
582 | (unless (or (secrets-empty-path item-path) (not (stringp property))) | |
583 | (dbus-get-property | |
584 | :session secrets-service item-path | |
585 | secrets-interface-item property))) | |
586 | ||
587 | (defun secrets-list-items (collection) | |
588 | "Return a list of all item labels of COLLECTION." | |
589 | (let ((collection-path (secrets-unlock-collection collection))) | |
590 | (unless (secrets-empty-path collection-path) | |
591 | (mapcar | |
592 | (lambda (item-path) | |
593 | (secrets-get-item-property item-path "Label")) | |
594 | (secrets-get-items collection-path))))) | |
595 | ||
596 | (defun secrets-search-items (collection &rest attributes) | |
597 | "Search items in COLLECTION with ATTRIBUTES. | |
598 | ATTRIBUTES are key-value pairs. The keys are keyword symbols, | |
599 | starting with a colon. Example: | |
600 | ||
601 | \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\" | |
602 | :method \"sudo\" :user \"joe\" :host \"remote-host\"\) | |
603 | ||
604 | The object paths of the found items are returned as list." | |
605 | (let ((collection-path (secrets-unlock-collection collection)) | |
606 | result props) | |
607 | (unless (secrets-empty-path collection-path) | |
608 | ;; Create attributes list. | |
609 | (while (consp (cdr attributes)) | |
610 | (unless (keywordp (car attributes)) | |
611 | (error 'wrong-type-argument (car attributes))) | |
4e652634 DC |
612 | (unless (stringp (cadr attributes)) |
613 | (error 'wrong-type-argument (cadr attributes))) | |
7725ebb7 MA |
614 | (setq props (add-to-list |
615 | 'props | |
616 | (list :dict-entry | |
8d9181c7 | 617 | (substring (symbol-name (car attributes)) 1) |
7725ebb7 MA |
618 | (cadr attributes)) |
619 | 'append) | |
620 | attributes (cddr attributes))) | |
621 | ;; Search. The result is a list of two lists, the object paths | |
622 | ;; of the unlocked and the locked items. | |
623 | (setq result | |
624 | (dbus-call-method | |
625 | :session secrets-service collection-path | |
626 | secrets-interface-collection "SearchItems" | |
627 | (if props | |
628 | (cons :array props) | |
629 | '(:array :signature "{ss}")))) | |
630 | ;; Return the found items. | |
631 | (mapcar | |
632 | (lambda (item-path) (secrets-get-item-property item-path "Label")) | |
633 | (append (car result) (cadr result)))))) | |
634 | ||
635 | (defun secrets-create-item (collection item password &rest attributes) | |
636 | "Create a new item in COLLECTION with label ITEM and password PASSWORD. | |
637 | ATTRIBUTES are key-value pairs set for the created item. The | |
638 | keys are keyword symbols, starting with a colon. Example: | |
639 | ||
640 | \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\" | |
641 | :method \"sudo\" :user \"joe\" :host \"remote-host\"\) | |
642 | ||
643 | The object path of the created item is returned." | |
644 | (unless (member item (secrets-list-items collection)) | |
645 | (let ((collection-path (secrets-unlock-collection collection)) | |
646 | result props) | |
647 | (unless (secrets-empty-path collection-path) | |
648 | ;; Create attributes list. | |
649 | (while (consp (cdr attributes)) | |
650 | (unless (keywordp (car attributes)) | |
651 | (error 'wrong-type-argument (car attributes))) | |
4e652634 DC |
652 | (unless (stringp (cadr attributes)) |
653 | (error 'wrong-type-argument (cadr attributes))) | |
7725ebb7 MA |
654 | (setq props (add-to-list |
655 | 'props | |
656 | (list :dict-entry | |
8d9181c7 | 657 | (substring (symbol-name (car attributes)) 1) |
7725ebb7 MA |
658 | (cadr attributes)) |
659 | 'append) | |
660 | attributes (cddr attributes))) | |
661 | ;; Create the item. | |
662 | (setq result | |
663 | (dbus-call-method | |
664 | :session secrets-service collection-path | |
665 | secrets-interface-collection "CreateItem" | |
666 | ;; Properties. | |
667 | (append | |
668 | `(:array | |
9abefce4 MA |
669 | (:dict-entry ,(concat secrets-interface-item ".Label") |
670 | (:variant ,item)) | |
671 | (:dict-entry ,(concat secrets-interface-item ".Type") | |
672 | (:variant ,secrets-interface-item-type-generic))) | |
7725ebb7 | 673 | (when props |
9abefce4 MA |
674 | `((:dict-entry ,(concat secrets-interface-item ".Attributes") |
675 | (:variant ,(append '(:array) props)))))) | |
7725ebb7 | 676 | ;; Secret. |
9abefce4 MA |
677 | (append |
678 | `(:struct :object-path ,secrets-session-path | |
679 | (:array :signature "y") ;; No parameters. | |
680 | ,(dbus-string-to-byte-array password)) | |
681 | ;; We add the content_type. In backward compatibility | |
682 | ;; mode, nil is appended, which means nothing. | |
683 | secrets-struct-secret-content-type) | |
7725ebb7 MA |
684 | ;; Do not replace. Replace does not seem to work. |
685 | nil)) | |
686 | (secrets-prompt (cadr result)) | |
687 | ;; Return the object path. | |
688 | (car result))))) | |
689 | ||
690 | (defun secrets-item-path (collection item) | |
09e80d9f | 691 | "Return the object path of item labeled ITEM in COLLECTION. |
7725ebb7 MA |
692 | If there is no such item, return nil." |
693 | (let ((collection-path (secrets-unlock-collection collection))) | |
694 | (catch 'item-found | |
695 | (dolist (item-path (secrets-get-items collection-path)) | |
696 | (when (string-equal item (secrets-get-item-property item-path "Label")) | |
697 | (throw 'item-found item-path)))))) | |
698 | ||
699 | (defun secrets-get-secret (collection item) | |
09e80d9f | 700 | "Return the secret of item labeled ITEM in COLLECTION. |
7725ebb7 MA |
701 | If there is no such item, return nil." |
702 | (let ((item-path (secrets-item-path collection item))) | |
703 | (unless (secrets-empty-path item-path) | |
704 | (dbus-byte-array-to-string | |
a464a6c7 | 705 | (cl-caddr |
7725ebb7 MA |
706 | (dbus-call-method |
707 | :session secrets-service item-path secrets-interface-item | |
708 | "GetSecret" :object-path secrets-session-path)))))) | |
709 | ||
710 | (defun secrets-get-attributes (collection item) | |
09e80d9f | 711 | "Return the lookup attributes of item labeled ITEM in COLLECTION. |
7725ebb7 MA |
712 | If there is no such item, or the item has no attributes, return nil." |
713 | (unless (stringp collection) (setq collection "default")) | |
714 | (let ((item-path (secrets-item-path collection item))) | |
715 | (unless (secrets-empty-path item-path) | |
716 | (mapcar | |
8d9181c7 MA |
717 | (lambda (attribute) |
718 | (cons (intern (concat ":" (car attribute))) (cadr attribute))) | |
7725ebb7 MA |
719 | (dbus-get-property |
720 | :session secrets-service item-path | |
721 | secrets-interface-item "Attributes"))))) | |
722 | ||
723 | (defun secrets-get-attribute (collection item attribute) | |
09e80d9f | 724 | "Return the value of ATTRIBUTE of item labeled ITEM in COLLECTION. |
7725ebb7 MA |
725 | If there is no such item, or the item doesn't own this attribute, return nil." |
726 | (cdr (assoc attribute (secrets-get-attributes collection item)))) | |
727 | ||
728 | (defun secrets-delete-item (collection item) | |
729 | "Delete ITEM in COLLECTION." | |
730 | (let ((item-path (secrets-item-path collection item))) | |
731 | (unless (secrets-empty-path item-path) | |
732 | (secrets-prompt | |
733 | (dbus-call-method | |
734 | :session secrets-service item-path | |
735 | secrets-interface-item "Delete"))))) | |
736 | ||
3a8e7cbd MA |
737 | ;;; Visualization. |
738 | ||
739 | (define-derived-mode secrets-mode nil "Secrets" | |
8d9181c7 | 740 | "Major mode for presenting password entries retrieved by Security Service. |
3a8e7cbd MA |
741 | In this mode, widgets represent the search results. |
742 | ||
8d9181c7 | 743 | \\{secrets-mode-map}" |
3a8e7cbd MA |
744 | ;; Keymap. |
745 | (setq secrets-mode-map (copy-keymap special-mode-map)) | |
746 | (set-keymap-parent secrets-mode-map widget-keymap) | |
747 | (define-key secrets-mode-map "z" 'kill-this-buffer) | |
748 | ||
749 | ;; When we toggle, we must set temporary widgets. | |
750 | (set (make-local-variable 'tree-widget-after-toggle-functions) | |
751 | '(secrets-tree-widget-after-toggle-function)) | |
752 | ||
753 | (when (not (called-interactively-p 'interactive)) | |
754 | ;; Initialize buffer. | |
755 | (setq buffer-read-only t) | |
756 | (let ((inhibit-read-only t)) | |
757 | (erase-buffer)))) | |
758 | ||
759 | ;; It doesn't make sense to call it interactively. | |
760 | (put 'secrets-mode 'disabled t) | |
761 | ||
762 | ;; The very first buffer created with `secrets-mode' does not have the | |
763 | ;; keymap etc. So we create a dummy buffer. Stupid. | |
764 | (with-temp-buffer (secrets-mode)) | |
765 | ||
8d9181c7 MA |
766 | ;; We autoload `secrets-show-secrets' only on systems with D-Bus support. |
767 | ;;;###autoload(when (featurep 'dbusbind) | |
768 | ;;;###autoload (autoload 'secrets-show-secrets "secrets" nil t)) | |
769 | ||
3a8e7cbd MA |
770 | (defun secrets-show-secrets () |
771 | "Display a list of collections from the Secret Service API. | |
772 | The collections are in tree view, that means they can be expanded | |
773 | to the corresponding secret items, which could also be expanded | |
774 | to their attributes." | |
775 | (interactive) | |
8d9181c7 MA |
776 | |
777 | ;; Check, whether the Secret Service API is enabled. | |
778 | (if (null secrets-enabled) | |
779 | (message "Secret Service not available") | |
780 | ||
781 | ;; Create the search buffer. | |
782 | (with-current-buffer (get-buffer-create "*Secrets*") | |
783 | (switch-to-buffer-other-window (current-buffer)) | |
e4920bc9 | 784 | ;; Initialize buffer with `secrets-mode'. |
8d9181c7 MA |
785 | (secrets-mode) |
786 | (secrets-show-collections)))) | |
3a8e7cbd MA |
787 | |
788 | (defun secrets-show-collections () | |
789 | "Show all available collections." | |
790 | (let ((inhibit-read-only t) | |
791 | (alias (secrets-get-alias "default"))) | |
792 | (erase-buffer) | |
793 | (tree-widget-set-theme "folder") | |
794 | (dolist (coll (secrets-list-collections)) | |
795 | (widget-create | |
796 | `(tree-widget | |
797 | :tag ,coll | |
798 | :collection ,coll | |
799 | :open nil | |
800 | :sample-face bold | |
801 | :expander secrets-expand-collection))))) | |
802 | ||
803 | (defun secrets-expand-collection (widget) | |
804 | "Expand items of collection shown as WIDGET." | |
805 | (let ((coll (widget-get widget :collection))) | |
806 | (mapcar | |
807 | (lambda (item) | |
808 | `(tree-widget | |
809 | :tag ,item | |
810 | :collection ,coll | |
811 | :item ,item | |
812 | :open nil | |
813 | :sample-face bold | |
814 | :expander secrets-expand-item)) | |
815 | (secrets-list-items coll)))) | |
816 | ||
817 | (defun secrets-expand-item (widget) | |
818 | "Expand password and attributes of item shown as WIDGET." | |
819 | (let* ((coll (widget-get widget :collection)) | |
820 | (item (widget-get widget :item)) | |
821 | (attributes (secrets-get-attributes coll item)) | |
822 | ;; padding is needed to format attribute names. | |
823 | (padding | |
8d9181c7 MA |
824 | (apply |
825 | 'max | |
826 | (cons | |
827 | (1+ (length "password")) | |
828 | (mapcar | |
fe3c5669 | 829 | ;; Attribute names have a leading ":", which will be suppressed. |
8d9181c7 MA |
830 | (lambda (attribute) (length (symbol-name (car attribute)))) |
831 | attributes))))) | |
3a8e7cbd MA |
832 | (cons |
833 | ;; The password widget. | |
834 | `(editable-field :tag "password" | |
835 | :secret ?* | |
836 | :value ,(secrets-get-secret coll item) | |
837 | :sample-face widget-button-pressed | |
838 | ;; We specify :size in order to limit the field. | |
839 | :size 0 | |
840 | :format ,(concat | |
841 | "%{%t%}:" | |
842 | (make-string (- padding (length "password")) ? ) | |
843 | "%v\n")) | |
844 | (mapcar | |
845 | (lambda (attribute) | |
8d9181c7 | 846 | (let ((name (substring (symbol-name (car attribute)) 1)) |
3a8e7cbd MA |
847 | (value (cdr attribute))) |
848 | ;; The attribute widget. | |
849 | `(editable-field :tag ,name | |
850 | :value ,value | |
851 | :sample-face widget-documentation | |
852 | ;; We specify :size in order to limit the field. | |
853 | :size 0 | |
854 | :format ,(concat | |
855 | "%{%t%}:" | |
856 | (make-string (- padding (length name)) ? ) | |
857 | "%v\n")))) | |
858 | attributes)))) | |
859 | ||
860 | (defun secrets-tree-widget-after-toggle-function (widget &rest ignore) | |
861 | "Add a temporary widget to show the password." | |
862 | (dolist (child (widget-get widget :children)) | |
863 | (when (widget-member child :secret) | |
864 | (goto-char (widget-field-end child)) | |
865 | (widget-insert " ") | |
866 | (widget-create-child-and-convert | |
867 | child 'push-button | |
868 | :notify 'secrets-tree-widget-show-password | |
869 | "Show password"))) | |
870 | (widget-setup)) | |
871 | ||
872 | (defun secrets-tree-widget-show-password (widget &rest ignore) | |
873 | "Show password, and remove temporary widget." | |
874 | (let ((parent (widget-get widget :parent))) | |
875 | (widget-put parent :secret nil) | |
876 | (widget-default-value-set parent (widget-get parent :value)) | |
877 | (widget-setup))) | |
878 | ||
879 | ;;; Initialization. | |
880 | ||
ae84eb97 MA |
881 | (when (dbus-ping :session secrets-service 100) |
882 | ||
883 | ;; We must reset all variables, when there is a new instance of the | |
884 | ;; "org.freedesktop.secrets" service. | |
885 | (dbus-register-signal | |
886 | :session dbus-service-dbus dbus-path-dbus | |
887 | dbus-interface-dbus "NameOwnerChanged" | |
888 | (lambda (&rest args) | |
889 | (when secrets-debug (message "Secret Service has changed: %S" args)) | |
890 | (setq secrets-session-path secrets-empty-path | |
891 | secrets-prompt-signal nil | |
892 | secrets-collection-paths nil)) | |
893 | secrets-service) | |
894 | ||
895 | ;; We want to refresh our cache, when there is a change in | |
896 | ;; collections. | |
897 | (dbus-register-signal | |
898 | :session secrets-service secrets-path | |
899 | secrets-interface-service "CollectionCreated" | |
900 | 'secrets-collection-handler) | |
901 | ||
902 | (dbus-register-signal | |
903 | :session secrets-service secrets-path | |
904 | secrets-interface-service "CollectionDeleted" | |
905 | 'secrets-collection-handler) | |
906 | ||
907 | ;; We shall inform, whether the secret service is enabled on this | |
908 | ;; machine. | |
f05e1b94 | 909 | (setq secrets-enabled t)) |
ae84eb97 MA |
910 | |
911 | (provide 'secrets) | |
7725ebb7 MA |
912 | |
913 | ;;; TODO: | |
914 | ||
915 | ;; * secrets-debug should be structured like auth-source-debug to | |
916 | ;; prevent leaking sensitive information. Right now I don't see | |
917 | ;; anything sensitive though. | |
918 | ;; * Check, whether the dh-ietf1024-aes128-cbc-pkcs7 algorithm can be | |
919 | ;; used for the transfer of the secrets. Currently, we use the | |
920 | ;; plain algorithm. |