lisp/net/secrets.el

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