lisp/net/secrets.el

   1 ;;; secrets.el --- Client interface to gnome-keyring and kwallet.
   2
   3 ;; Copyright (C) 2010 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm password passphrase
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This package provides an implementation of the Secret Service API
  26 ;; <http://www.freedesktop.org/wiki/Specifications/secret-storage-spec>.
  27 ;; This API is meant to make GNOME-Keyring- and KWallet-like daemons
  28 ;; available under a common D-BUS interface and thus increase
  29 ;; interoperability between GNOME, KDE and other applications having
  30 ;; the need to securely store passwords and other confidential
  31 ;; information.
  32
  33 ;; In order to activate this package, you must add the following code
  34 ;; into your .emacs:
  35 ;;
  36 ;;   (require 'secrets)
  37 ;;
  38 ;; 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 corrresponding client session (aka Emacs'
  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' 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 ;;; Code:
 133
 134 ;; It has been tested with GNOME Keyring 2.29.92.  An implementation
 135 ;; for KWallet will be available at
 136 ;; svn://anonsvn.kde.org/home/kde/trunk/playground/base/ksecretservice;
 137 ;; not tested yet.
 138
 139 ;; Pacify byte-compiler.  D-Bus support in the Emacs core can be
 140 ;; disabled with configuration option "--without-dbus".  Declare used
 141 ;; subroutines and variables of `dbus' therefore.
 142 (eval-when-compile
 143   (require 'cl))
 144
 145 (declare-function dbus-call-method "dbusbind.c")
 146 (declare-function dbus-register-signal "dbusbind.c")
 147 (defvar dbus-debug)
 148
 149 (require 'dbus)
 150
 151 (defvar secrets-enabled nil
 152   "Whether there is a daemon offering the Secret Service API.")
 153
 154 (defvar secrets-debug t
 155   "Write debug messages")
 156
 157 (defconst secrets-service "org.freedesktop.secrets"
 158   "The D-Bus name used to talk to Secret Service.")
 159
 160 (defconst secrets-path "/org/freedesktop/secrets"
 161   "The D-Bus root object path used to talk to Secret Service.")
 162
 163 (defconst secrets-empty-path "/"
 164   "The D-Bus object path representing an empty object.")
 165
 166 (defsubst secrets-empty-path (path)
 167   "Check, whether PATH is a valid object path.
 168 It returns t if not."
 169   (or (not (stringp path))
 170       (string-equal path secrets-empty-path)))
 171
 172 (defconst secrets-interface-service "org.freedesktop.Secret.Service"
 173   "The D-Bus interface managing sessions and collections.")
 174
 175 ;; <interface name="org.freedesktop.Secret.Service">
 176 ;;   <property name="Collections" type="ao" access="read"/>
 177 ;;   <method name="OpenSession">
 178 ;;     <arg name="algorithm" type="s" direction="in"/>
 179 ;;     <arg name="input"     type="v" direction="in"/>
 180 ;;     <arg name="output"    type="v" direction="out"/>
 181 ;;     <arg name="result"    type="o" direction="out"/>
 182 ;;   </method>
 183 ;;   <method name="CreateCollection">
 184 ;;     <arg name="props"      type="a{sv}" direction="in"/>
 185 ;;     <arg name="collection" type="o"     direction="out"/>
 186 ;;     <arg name="prompt"     type="o"     direction="out"/>
 187 ;;   </method>
 188 ;;   <method name="SearchItems">
 189 ;;     <arg name="attributes" type="a{ss}" direction="in"/>
 190 ;;     <arg name="unlocked"   type="ao"    direction="out"/>
 191 ;;     <arg name="locked"     type="ao"    direction="out"/>
 192 ;;   </method>
 193 ;;   <method name="Unlock">
 194 ;;     <arg name="objects"  type="ao" direction="in"/>
 195 ;;     <arg name="unlocked" type="ao" direction="out"/>
 196 ;;     <arg name="prompt"   type="o"  direction="out"/>
 197 ;;   </method>
 198 ;;   <method name="Lock">
 199 ;;     <arg name="objects" type="ao" direction="in"/>
 200 ;;     <arg name="locked"  type="ao" direction="out"/>
 201 ;;     <arg name="Prompt"  type="o"  direction="out"/>
 202 ;;   </method>
 203 ;;   <method name="GetSecrets">
 204 ;;     <arg name="items"   type="ao"          direction="in"/>
 205 ;;     <arg name="session" type="o"           direction="in"/>
 206 ;;     <arg name="secrets" type="a{o(oayay)}" direction="out"/>
 207 ;;   </method>
 208 ;;   <method name="ReadAlias">
 209 ;;     <arg name="name"       type="s" direction="in"/>
 210 ;;     <arg name="collection" type="o" direction="out"/>
 211 ;;   </method>
 212 ;;   <method name="SetAlias">
 213 ;;     <arg name="name"       type="s" direction="in"/>
 214 ;;     <arg name="collection" type="o" direction="in"/>
 215 ;;   </method>
 216 ;;   <signal name="CollectionCreated">
 217 ;;     <arg name="collection" type="o"/>
 218 ;;   </signal>
 219 ;;   <signal name="CollectionDeleted">
 220 ;;     <arg name="collection" type="o"/>
 221 ;;   </signal>
 222 ;; </interface>
 223
 224 (defconst secrets-interface-collection "org.freedesktop.Secret.Collection"
 225   "A collection of items containing secrets.")
 226
 227 ;; <interface name="org.freedesktop.Secret.Collection">
 228 ;;   <property name="Items"    type="ao" access="read"/>
 229 ;;   <property name="Label"    type="s"  access="readwrite"/>
 230 ;;   <property name="Locked"   type="s"  access="read"/>
 231 ;;   <property name="Created"  type="t"  access="read"/>
 232 ;;   <property name="Modified" type="t"  access="read"/>
 233 ;;   <method name="Delete">
 234 ;;     <arg name="prompt" type="o" direction="out"/>
 235 ;;   </method>
 236 ;;   <method name="SearchItems">
 237 ;;     <arg name="attributes" type="a{ss}" direction="in"/>
 238 ;;     <arg name="results"    type="ao"    direction="out"/>
 239 ;;   </method>
 240 ;;   <method name="CreateItem">
 241 ;;     <arg name="props"   type="a{sv}"   direction="in"/>
 242 ;;     <arg name="secret"  type="(oayay)" direction="in"/>
 243 ;;     <arg name="replace" type="b"       direction="in"/>
 244 ;;     <arg name="item"    type="o"       direction="out"/>
 245 ;;     <arg name="prompt"  type="o"       direction="out"/>
 246 ;;   </method>
 247 ;;   <signal name="ItemCreated">
 248 ;;     <arg name="item" type="o"/>
 249 ;;   </signal>
 250 ;;   <signal name="ItemDeleted">
 251 ;;     <arg name="item" type="o"/>
 252 ;;   </signal>
 253 ;;   <signal name="ItemChanged">
 254 ;;     <arg name="item" type="o"/>
 255 ;;   </signal>
 256 ;; </interface>
 257
 258 (defconst secrets-session-collection-path
 259   "/org/freedesktop/secrets/collection/session"
 260   "The D-Bus temporary session collection object path.")
 261
 262 (defconst secrets-interface-prompt "org.freedesktop.Secret.Prompt"
 263   "A session tracks state between the service and a client application.")
 264
 265 ;; <interface name="org.freedesktop.Secret.Prompt">
 266 ;;   <method name="Prompt">
 267 ;;     <arg name="window-id" type="s" direction="in"/>
 268 ;;   </method>
 269 ;;   <method name="Dismiss"></method>
 270 ;;   <signal name="Completed">
 271 ;;     <arg name="dismissed" type="b"/>
 272 ;;     <arg name="result"    type="v"/>
 273 ;;   </signal>
 274 ;; </interface>
 275
 276 (defconst secrets-interface-item "org.freedesktop.Secret.Item"
 277   "A collection of items containing secrets.")
 278
 279 ;; <interface name="org.freedesktop.Secret.Item">
 280 ;;   <property name="Locked"     type="b"     access="read"/>
 281 ;;   <property name="Attributes" type="a{ss}" access="readwrite"/>
 282 ;;   <property name="Label"      type="s"     access="readwrite"/>
 283 ;;   <property name="Created"    type="t"     access="read"/>
 284 ;;   <property name="Modified"   type="t"     access="read"/>
 285 ;;   <method name="Delete">
 286 ;;     <arg name="prompt" type="o" direction="out"/>
 287 ;;   </method>
 288 ;;   <method name="GetSecret">
 289 ;;     <arg name="session" type="o"       direction="in"/>
 290 ;;     <arg name="secret"  type="(oayay)" direction="out"/>
 291 ;;   </method>
 292 ;;   <method name="SetSecret">
 293 ;;     <arg name="secret" type="(oayay)" direction="in"/>
 294 ;;   </method>
 295 ;; </interface>
 296 ;;
 297 ;; STRUCT       secret
 298 ;;   OBJECT PATH  session
 299 ;;   ARRAY BYTE   parameters
 300 ;;   ARRAY BYTE   value
 301
 302 (defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic"
 303   "The default item type we are using.")
 304
 305 (defconst secrets-interface-session "org.freedesktop.Secret.Session"
 306   "A session tracks state between the service and a client application.")
 307
 308 ;; <interface name="org.freedesktop.Secret.Session">
 309 ;;   <method name="Close"></method>
 310 ;; </interface>
 311
 312 ;;; Sessions.
 313
 314 (defvar secrets-session-path secrets-empty-path
 315   "The D-Bus session path of the active session.
 316 A session path `secrets-empty-path' indicates there is no open session.")
 317
 318 (defun secrets-close-session ()
 319   "Close the secret service session, if any."
 320   (dbus-ignore-errors
 321     (dbus-call-method
 322      :session secrets-service secrets-session-path
 323      secrets-interface-session "Close"))
 324   (setq secrets-session-path secrets-empty-path))
 325
 326 (defun secrets-open-session (&optional reopen)
 327   "Open a new session with \"plain\" algorithm.
 328 If there exists another active session, and REOPEN is nil, that
 329 session will be used.  The object path of the session will be
 330 returned, and it will be stored in `secrets-session-path'."
 331   (when reopen (secrets-close-session))
 332   (when (secrets-empty-path secrets-session-path)
 333     (setq secrets-session-path
 334           (cadr
 335            (dbus-call-method
 336             :session secrets-service secrets-path
 337             secrets-interface-service "OpenSession" "plain" '(:variant "")))))
 338   (when secrets-debug
 339     (message "Secret Service session: %s" secrets-session-path))
 340   secrets-session-path)
 341
 342 ;;; Prompts.
 343
 344 (defvar secrets-prompt-signal nil
 345   "Internal variable to catch signals from `secrets-interface-prompt'.")
 346
 347 (defun secrets-prompt (prompt)
 348   "Handle the prompt identified by object path PROMPT."
 349   (unless (secrets-empty-path prompt)
 350     (let ((object
 351            (dbus-register-signal
 352             :session secrets-service prompt
 353             secrets-interface-prompt "Completed" 'secrets-prompt-handler)))
 354       (dbus-call-method
 355        :session secrets-service prompt
 356        secrets-interface-prompt "Prompt" (frame-parameter nil 'window-id))
 357       (unwind-protect
 358           (progn
 359             ;; Wait until the returned prompt signal has put the
 360             ;; result into `secrets-prompt-signal'.
 361             (while (null secrets-prompt-signal)
 362               (read-event nil nil 0.1))
 363             ;; Return the object(s).  It is a variant, so we must use a car.
 364             (car secrets-prompt-signal))
 365         ;; Cleanup.
 366         (setq secrets-prompt-signal nil)
 367         (dbus-unregister-object object)))))
 368
 369 (defun secrets-prompt-handler (&rest args)
 370   "Handler for signals emitted by `secrets-interface-prompt'."
 371   ;; An empty object path is always identified as `secrets-empty-path'
 372   ;; or `nil'.  Either we set it explicitely, or it is returned by the
 373   ;; "Completed" signal.
 374   (if (car args) ;; dismissed
 375       (setq secrets-prompt-signal (list secrets-empty-path))
 376     (setq secrets-prompt-signal (cadr args))))
 377
 378 ;;; Collections.
 379
 380 (defvar secrets-collection-paths nil
 381   "Cached D-Bus object paths of available collections.")
 382
 383 (defun secrets-collection-handler (&rest args)
 384   "Handler for signals emitted by `secrets-interface-service'."
 385   (cond
 386    ((string-equal (dbus-event-member-name last-input-event) "CollectionCreated")
 387     (add-to-list 'secrets-collection-paths (car args)))
 388    ((string-equal (dbus-event-member-name last-input-event) "CollectionDeleted")
 389     (setq secrets-collection-paths
 390           (delete (car args) secrets-collection-paths)))))
 391
 392 (defun secrets-get-collections ()
 393   "Return the object paths of all available collections."
 394   (setq secrets-collection-paths
 395         (or secrets-collection-paths
 396             (dbus-get-property
 397              :session secrets-service secrets-path
 398              secrets-interface-service "Collections"))))
 399
 400 (defun secrets-get-collection-properties (collection-path)
 401   "Return all properties of collection identified by COLLECTION-PATH."
 402   (unless (secrets-empty-path collection-path)
 403     (dbus-get-all-properties
 404      :session secrets-service collection-path
 405      secrets-interface-collection)))
 406
 407 (defun secrets-get-collection-property (collection-path property)
 408   "Return property PROPERTY of collection identified by COLLECTION-PATH."
 409   (unless (or (secrets-empty-path collection-path) (not (stringp property)))
 410     (dbus-get-property
 411      :session secrets-service collection-path
 412      secrets-interface-collection property)))
 413
 414 (defun secrets-list-collections ()
 415   "Return a list of collection names."
 416   (mapcar
 417    (lambda (collection-path)
 418      (if (string-equal collection-path secrets-session-collection-path)
 419          "session"
 420        (secrets-get-collection-property collection-path "Label")))
 421    (secrets-get-collections)))
 422
 423 (defun secrets-collection-path (collection)
 424   "Return the object path of collection labelled COLLECTION.
 425 If COLLECTION is nil, return the session collection path.
 426 If there is no such COLLECTION, return nil."
 427   (or
 428    ;; The "session" collection.
 429    (if (or (null collection) (string-equal "session" collection))
 430        secrets-session-collection-path)
 431    ;; Check for an alias.
 432    (let ((collection-path
 433           (dbus-call-method
 434            :session secrets-service secrets-path
 435            secrets-interface-service "ReadAlias" collection)))
 436      (unless (secrets-empty-path collection-path)
 437        collection-path))
 438    ;; Check the collections.
 439    (catch 'collection-found
 440      (dolist (collection-path (secrets-get-collections) nil)
 441        (when
 442            (string-equal
 443             collection
 444             (secrets-get-collection-property collection-path "Label"))
 445          (throw 'collection-found collection-path))))))
 446
 447 (defun secrets-create-collection (collection)
 448   "Create collection labelled COLLECTION if it doesn't exist.
 449 Return the D-Bus object path for collection."
 450   (let ((collection-path (secrets-collection-path collection)))
 451     ;; Create the collection.
 452     (when (secrets-empty-path collection-path)
 453       (setq collection-path
 454             (secrets-prompt
 455              (cadr
 456               ;; "CreateCollection" returns the prompt path as second arg.
 457               (dbus-call-method
 458                :session secrets-service secrets-path
 459                secrets-interface-service "CreateCollection"
 460                `(:array (:dict-entry "Label" (:variant ,collection))))))))
 461     ;; Return object path of the collection.
 462     collection-path))
 463
 464 (defun secrets-get-alias (alias)
 465   "Return the collection name ALIAS is referencing to.
 466 For the time being, only the alias \"default\" is supported."
 467   (secrets-get-collection-property
 468    (dbus-call-method
 469     :session secrets-service secrets-path
 470     secrets-interface-service "ReadAlias" alias)
 471    "Label"))
 472
 473 (defun secrets-set-alias (collection alias)
 474   "Set ALIAS as alias of collection labelled COLLECTION.
 475 For the time being, only the alias \"default\" is supported."
 476   (let ((collection-path (secrets-collection-path collection)))
 477     (unless (secrets-empty-path collection-path)
 478       (dbus-call-method
 479        :session secrets-service secrets-path
 480        secrets-interface-service "SetAlias"
 481        alias :object-path collection-path))))
 482
 483 (defun secrets-unlock-collection (collection)
 484   "Unlock collection labelled COLLECTION.
 485 If successful, return the object path of the collection."
 486   (let ((collection-path (secrets-collection-path collection)))
 487     (unless (secrets-empty-path collection-path)
 488       (secrets-prompt
 489        (cadr
 490         (dbus-call-method
 491          :session secrets-service secrets-path secrets-interface-service
 492          "Unlock" `(:array :object-path ,collection-path)))))
 493     collection-path))
 494
 495 (defun secrets-delete-collection (collection)
 496   "Delete collection labelled COLLECTION."
 497   (let ((collection-path (secrets-collection-path collection)))
 498     (unless (secrets-empty-path collection-path)
 499       (secrets-prompt
 500        (dbus-call-method
 501         :session secrets-service collection-path
 502         secrets-interface-collection "Delete")))))
 503
 504 ;;; Items.
 505
 506 (defun secrets-get-items (collection-path)
 507   "Return the object paths of all available items in COLLECTION-PATH."
 508   (unless (secrets-empty-path collection-path)
 509     (secrets-open-session)
 510     (dbus-get-property
 511      :session secrets-service collection-path
 512      secrets-interface-collection "Items")))
 513
 514 (defun secrets-get-item-properties (item-path)
 515   "Return all properties of item identified by ITEM-PATH."
 516   (unless (secrets-empty-path item-path)
 517     (dbus-get-all-properties
 518      :session secrets-service item-path
 519      secrets-interface-item)))
 520
 521 (defun secrets-get-item-property (item-path property)
 522   "Return property PROPERTY of item identified by ITEM-PATH."
 523   (unless (or (secrets-empty-path item-path) (not (stringp property)))
 524     (dbus-get-property
 525      :session secrets-service item-path
 526      secrets-interface-item property)))
 527
 528 (defun secrets-list-items (collection)
 529   "Return a list of all item labels of COLLECTION."
 530   (let ((collection-path (secrets-unlock-collection collection)))
 531     (unless (secrets-empty-path collection-path)
 532       (mapcar
 533        (lambda (item-path)
 534          (secrets-get-item-property item-path "Label"))
 535        (secrets-get-items collection-path)))))
 536
 537 (defun secrets-search-items (collection &rest attributes)
 538   "Search items in COLLECTION with ATTRIBUTES.
 539 ATTRIBUTES are key-value pairs.  The keys are keyword symbols,
 540 starting with a colon.  Example:
 541
 542   \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
 543    :method \"sudo\" :user \"joe\" :host \"remote-host\"\)
 544
 545 The object paths of the found items are returned as list."
 546   (let ((collection-path (secrets-unlock-collection collection))
 547         result props)
 548     (unless (secrets-empty-path collection-path)
 549       ;; Create attributes list.
 550       (while (consp (cdr attributes))
 551         (unless (keywordp (car attributes))
 552           (error 'wrong-type-argument (car attributes)))
 553         (setq props (add-to-list
 554                      'props
 555                      (list :dict-entry
 556                            (symbol-name (car attributes))
 557                            (cadr attributes))
 558                      'append)
 559               attributes (cddr attributes)))
 560       ;; Search.  The result is a list of two lists, the object paths
 561       ;; of the unlocked and the locked items.
 562       (setq result
 563             (dbus-call-method
 564              :session secrets-service collection-path
 565              secrets-interface-collection "SearchItems"
 566              (if props
 567                  (cons :array props)
 568                '(:array :signature "{ss}"))))
 569       ;; Return the found items.
 570       (mapcar
 571        (lambda (item-path) (secrets-get-item-property item-path "Label"))
 572        (append (car result) (cadr result))))))
 573
 574 (defun secrets-create-item (collection item password &rest attributes)
 575   "Create a new item in COLLECTION with label ITEM and password PASSWORD.
 576 ATTRIBUTES are key-value pairs set for the created item.  The
 577 keys are keyword symbols, starting with a colon.  Example:
 578
 579   \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
 580    :method \"sudo\" :user \"joe\" :host \"remote-host\"\)
 581
 582 The object path of the created item is returned."
 583   (unless (member item (secrets-list-items collection))
 584     (let ((collection-path (secrets-unlock-collection collection))
 585           result props)
 586       (unless (secrets-empty-path collection-path)
 587         ;; Create attributes list.
 588         (while (consp (cdr attributes))
 589           (unless (keywordp (car attributes))
 590             (error 'wrong-type-argument (car attributes)))
 591           (setq props (add-to-list
 592                        'props
 593                        (list :dict-entry
 594                              (symbol-name (car attributes))
 595                              (cadr attributes))
 596                        'append)
 597                 attributes (cddr attributes)))
 598         ;; Create the item.
 599         (setq result
 600               (dbus-call-method
 601                :session secrets-service collection-path
 602                secrets-interface-collection "CreateItem"
 603                ;; Properties.
 604                (append
 605                 `(:array
 606                   (:dict-entry "Label" (:variant ,item))
 607                   (:dict-entry
 608                    "Type" (:variant ,secrets-interface-item-type-generic)))
 609                 (when props
 610                   `((:dict-entry
 611                      "Attributes" (:variant ,(append '(:array) props))))))
 612                ;; Secret.
 613                `(:struct :object-path ,secrets-session-path
 614                          (:array :signature "y") ;; no parameters.
 615                          ,(dbus-string-to-byte-array password))
 616                ;; Do not replace. Replace does not seem to work.
 617                nil))
 618         (secrets-prompt (cadr result))
 619         ;; Return the object path.
 620         (car result)))))
 621
 622 (defun secrets-item-path (collection item)
 623   "Return the object path of item labelled ITEM in COLLECTION.
 624 If there is no such item, return nil."
 625   (let ((collection-path (secrets-unlock-collection collection)))
 626     (catch 'item-found
 627       (dolist (item-path (secrets-get-items collection-path))
 628         (when (string-equal item (secrets-get-item-property item-path "Label"))
 629           (throw 'item-found item-path))))))
 630
 631 (defun secrets-get-secret (collection item)
 632   "Return the secret of item labelled ITEM in COLLECTION.
 633 If there is no such item, return nil."
 634   (let ((item-path (secrets-item-path collection item)))
 635     (unless (secrets-empty-path item-path)
 636       (dbus-byte-array-to-string
 637        (caddr
 638         (dbus-call-method
 639          :session secrets-service item-path secrets-interface-item
 640          "GetSecret" :object-path secrets-session-path))))))
 641
 642 (defun secrets-get-attributes (collection item)
 643   "Return the lookup attributes of item labelled ITEM in COLLECTION.
 644 If there is no such item, or the item has no attributes, return nil."
 645   (unless (stringp collection) (setq collection "default"))
 646   (let ((item-path (secrets-item-path collection item)))
 647     (unless (secrets-empty-path item-path)
 648       (mapcar
 649        (lambda (attribute) (cons (intern (car attribute)) (cadr attribute)))
 650        (dbus-get-property
 651         :session secrets-service item-path
 652         secrets-interface-item "Attributes")))))
 653
 654 (defun secrets-get-attribute (collection item attribute)
 655   "Return the value of ATTRIBUTE of item labelled ITEM in COLLECTION.
 656 If there is no such item, or the item doesn't own this attribute, return nil."
 657   (cdr (assoc attribute (secrets-get-attributes collection item))))
 658
 659 (defun secrets-delete-item (collection item)
 660   "Delete ITEM in COLLECTION."
 661   (let ((item-path (secrets-item-path collection item)))
 662     (unless (secrets-empty-path item-path)
 663       (secrets-prompt
 664        (dbus-call-method
 665         :session secrets-service item-path
 666         secrets-interface-item "Delete")))))
 667
 668 (when (dbus-ping :session secrets-service 100)
 669
 670   ;; We must reset all variables, when there is a new instance of the
 671   ;; "org.freedesktop.secrets" service.
 672   (dbus-register-signal
 673    :session dbus-service-dbus dbus-path-dbus
 674    dbus-interface-dbus "NameOwnerChanged"
 675    (lambda (&rest args)
 676      (when secrets-debug (message "Secret Service has changed: %S" args))
 677      (setq secrets-session-path secrets-empty-path
 678            secrets-prompt-signal nil
 679            secrets-collection-paths nil))
 680    secrets-service)
 681
 682   ;; We want to refresh our cache, when there is a change in
 683   ;; collections.
 684   (dbus-register-signal
 685    :session secrets-service secrets-path
 686    secrets-interface-service "CollectionCreated"
 687    'secrets-collection-handler)
 688
 689   (dbus-register-signal
 690    :session secrets-service secrets-path
 691    secrets-interface-service "CollectionDeleted"
 692    'secrets-collection-handler)
 693
 694   ;; We shall inform, whether the secret service is enabled on this
 695   ;; machine.
 696   (setq secrets-enabled t))
 697
 698 (provide 'secrets)
 699
 700 ;;; TODO:
 701
 702 ;; * secrets-debug should be structured like auth-source-debug to
 703 ;;   prevent leaking sensitive information.  Right now I don't see
 704 ;;   anything sensitive though.
 705 ;; * Check, whether the dh-ietf1024-aes128-cbc-pkcs7 algorithm can be
 706 ;;   used for the transfer of the secrets.  Currently, we use the
 707 ;;   plain algorithm.