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