lisp/net/secrets.el

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