lisp/net/secrets.el

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