code.delx.au - gnu-emacs/blob - lisp/net/secrets.el

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