secrets.el 33.1 KB
Newer Older
Mark Oteiza's avatar
Mark Oteiza committed
1
;;; secrets.el --- Client interface to gnome-keyring and kwallet. -*- lexical-binding: t -*-
Michael Albinus's avatar
Michael Albinus committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2010-2018 Free Software Foundation, Inc.
Michael Albinus's avatar
Michael Albinus committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm password passphrase

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Michael Albinus's avatar
Michael Albinus committed
22 23 24 25 26 27 28 29 30 31 32 33 34

;;; Commentary:

;; This package provides an implementation of the Secret Service API
;; <http://www.freedesktop.org/wiki/Specifications/secret-storage-spec>.
;; This API is meant to make GNOME-Keyring- and KWallet-like daemons
;; available under a common D-BUS interface and thus increase
;; interoperability between GNOME, KDE and other applications having
;; the need to securely store passwords and other confidential
;; information.

;; In order to activate this package, you must add the following code
;; into your .emacs:
35
;;
Michael Albinus's avatar
Michael Albinus committed
36
;;   (require 'secrets)
37
;;
38 39
;; Afterwards, the variable `secrets-enabled' is non-nil when there is
;; a daemon providing this interface.
40

Michael Albinus's avatar
Michael Albinus committed
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
;; The atomic objects to be managed by the Secret Service API are
;; secret items, which are something an application wishes to store
;; securely.  A good example is a password that an application needs
;; to save and use at a later date.

;; Secret items are grouped in collections.  A collection is similar
;; in concept to the terms 'keyring' or 'wallet'.  A common collection
;; is called "login".  A collection is stored permanently under the
;; user's permissions, and can be accessed in a user session context.

;; A collection can have an alias name.  The use case for this is to
;; set the alias "default" for a given collection, making it
;; transparent for clients, which collection is used.  Other aliases
;; are not supported (yet).  Since an alias is visible to all
;; applications, this setting shall be performed with care.

;; A list of all available collections is available by
;;
;;   (secrets-list-collections)
;;    => ("session" "login" "ssh keys")

;; The "default" alias could be set to the "login" collection by
;;
;;   (secrets-set-alias "login" "default")

;; An alias can also be dereferenced
;;
;;   (secrets-get-alias "default")
;;    => "login"

;; Collections can be created and deleted.  As already said,
;; collections are used by different applications.  Therefore, those
;; operations shall also be performed with care.  Common collections,
;; like "login", shall not be changed except adding or deleting secret
;; items.
;;
;;   (secrets-delete-collection "my collection")
;;   (secrets-create-collection "my collection")

;; There exists a special collection called "session", which has the
81
;; lifetime of the corresponding client session (aka Emacs's
Michael Albinus's avatar
Michael Albinus committed
82 83 84 85 86 87
;; lifetime).  It is created automatically when Emacs uses the Secret
;; Service interface, and it is deleted when Emacs is killed.
;; Therefore, it can be used to store and retrieve secret items
;; temporarily.  This shall be preferred over creation of a persistent
;; collection, when the information shall not live longer than Emacs.
;; The session collection can be addressed either by the string
88
;; "session", or by nil, whenever a collection parameter is needed.
Michael Albinus's avatar
Michael Albinus committed
89 90 91 92 93 94 95 96 97 98 99 100 101

;; As already said, a collection is a group of secret items.  A secret
;; item has a label, the "secret" (which is a string), and a set of
;; lookup attributes.  The attributes can be used to search and
;; retrieve a secret item at a later date.

;; A list of all available secret items of a collection is available by
;;
;;   (secrets-list-items "my collection")
;;    => ("this item" "another item")

;; Secret items can be added or deleted to a collection.  In the
;; following examples, we use the special collection "session", which
102
;; is bound to Emacs's lifetime.
Michael Albinus's avatar
Michael Albinus committed
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
;;
;;   (secrets-delete-item "session" "my item")
;;   (secrets-create-item "session" "my item" "geheim"
;;                        :user "joe" :host "remote-host")

;; The string "geheim" is the secret of the secret item "my item".
;; The secret string can be retrieved from items:
;;
;;   (secrets-get-secret "session" "my item")
;;    => "geheim"

;; The lookup attributes, which are specified during creation of a
;; secret item, must be a key-value pair.  Keys are keyword symbols,
;; starting with a colon; values are strings.  They can be retrieved
;; from a given secret item:
;;
;;   (secrets-get-attribute "session" "my item" :host)
;;    => "remote-host"
;;
;;   (secrets-get-attributes "session" "my item")
;;    => ((:user . "joe") (:host ."remote-host"))

;; The lookup attributes can be used for searching of items.  If you,
;; for example, are looking for all secret items for the user "joe",
;; you would perform
;;
;;   (secrets-search-items "session" :user "joe")
;;    => ("my item" "another item")

132 133 134
;; Interactively, collections, items and their attributes could be
;; inspected by the command `secrets-show-secrets'.

Michael Albinus's avatar
Michael Albinus committed
135 136 137 138 139 140 141 142 143 144
;;; Code:

;; It has been tested with GNOME Keyring 2.29.92.  An implementation
;; for KWallet will be available at
;; svn://anonsvn.kde.org/home/kde/trunk/playground/base/ksecretservice;
;; not tested yet.

;; Pacify byte-compiler.  D-Bus support in the Emacs core can be
;; disabled with configuration option "--without-dbus".  Declare used
;; subroutines and variables of `dbus' therefore.
145
(eval-when-compile (require 'cl-lib))
Michael Albinus's avatar
Michael Albinus committed
146 147 148 149 150

(defvar dbus-debug)

(require 'dbus)

151 152 153 154 155
(autoload 'tree-widget-set-theme "tree-widget")
(autoload 'widget-create-child-and-convert "wid-edit")
(autoload 'widget-default-value-set "wid-edit")
(autoload 'widget-field-end "wid-edit")
(autoload 'widget-member "wid-edit")
156 157
(defvar tree-widget-after-toggle-functions)

158
(defvar secrets-enabled nil
159
  "Whether there is a daemon offering the Secret Service API.")
160

Michael Albinus's avatar
Michael Albinus committed
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
(defvar secrets-debug t
  "Write debug messages")

(defconst secrets-service "org.freedesktop.secrets"
  "The D-Bus name used to talk to Secret Service.")

(defconst secrets-path "/org/freedesktop/secrets"
  "The D-Bus root object path used to talk to Secret Service.")

(defconst secrets-empty-path "/"
  "The D-Bus object path representing an empty object.")

(defsubst secrets-empty-path (path)
  "Check, whether PATH is a valid object path.
It returns t if not."
  (or (not (stringp path))
      (string-equal path secrets-empty-path)))

(defconst secrets-interface-service "org.freedesktop.Secret.Service"
  "The D-Bus interface managing sessions and collections.")

;; <interface name="org.freedesktop.Secret.Service">
;;   <property name="Collections" type="ao" access="read"/>
;;   <method name="OpenSession">
;;     <arg name="algorithm" type="s" direction="in"/>
;;     <arg name="input"     type="v" direction="in"/>
;;     <arg name="output"    type="v" direction="out"/>
;;     <arg name="result"    type="o" direction="out"/>
;;   </method>
;;   <method name="CreateCollection">
;;     <arg name="props"      type="a{sv}" direction="in"/>
192
;;     <arg name="alias"      type="s"     direction="in"/>   ;; Added 2011/3/1
Michael Albinus's avatar
Michael Albinus committed
193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211
;;     <arg name="collection" type="o"     direction="out"/>
;;     <arg name="prompt"     type="o"     direction="out"/>
;;   </method>
;;   <method name="SearchItems">
;;     <arg name="attributes" type="a{ss}" direction="in"/>
;;     <arg name="unlocked"   type="ao"    direction="out"/>
;;     <arg name="locked"     type="ao"    direction="out"/>
;;   </method>
;;   <method name="Unlock">
;;     <arg name="objects"  type="ao" direction="in"/>
;;     <arg name="unlocked" type="ao" direction="out"/>
;;     <arg name="prompt"   type="o"  direction="out"/>
;;   </method>
;;   <method name="Lock">
;;     <arg name="objects" type="ao" direction="in"/>
;;     <arg name="locked"  type="ao" direction="out"/>
;;     <arg name="Prompt"  type="o"  direction="out"/>
;;   </method>
;;   <method name="GetSecrets">
212 213 214
;;     <arg name="items"   type="ao"           direction="in"/>
;;     <arg name="session" type="o"            direction="in"/>
;;     <arg name="secrets" type="a{o(oayays)}" direction="out"/>
Michael Albinus's avatar
Michael Albinus committed
215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
;;   </method>
;;   <method name="ReadAlias">
;;     <arg name="name"       type="s" direction="in"/>
;;     <arg name="collection" type="o" direction="out"/>
;;   </method>
;;   <method name="SetAlias">
;;     <arg name="name"       type="s" direction="in"/>
;;     <arg name="collection" type="o" direction="in"/>
;;   </method>
;;   <signal name="CollectionCreated">
;;     <arg name="collection" type="o"/>
;;   </signal>
;;   <signal name="CollectionDeleted">
;;     <arg name="collection" type="o"/>
;;   </signal>
;; </interface>

(defconst secrets-interface-collection "org.freedesktop.Secret.Collection"
  "A collection of items containing secrets.")

;; <interface name="org.freedesktop.Secret.Collection">
;;   <property name="Items"    type="ao" access="read"/>
;;   <property name="Label"    type="s"  access="readwrite"/>
238
;;   <property name="Locked"   type="b"  access="read"/>
Michael Albinus's avatar
Michael Albinus committed
239 240 241 242 243 244 245 246 247 248
;;   <property name="Created"  type="t"  access="read"/>
;;   <property name="Modified" type="t"  access="read"/>
;;   <method name="Delete">
;;     <arg name="prompt" type="o" direction="out"/>
;;   </method>
;;   <method name="SearchItems">
;;     <arg name="attributes" type="a{ss}" direction="in"/>
;;     <arg name="results"    type="ao"    direction="out"/>
;;   </method>
;;   <method name="CreateItem">
249 250 251 252 253
;;     <arg name="props"   type="a{sv}"    direction="in"/>
;;     <arg name="secret"  type="(oayays)" direction="in"/>
;;     <arg name="replace" type="b"        direction="in"/>
;;     <arg name="item"    type="o"        direction="out"/>
;;     <arg name="prompt"  type="o"        direction="out"/>
Michael Albinus's avatar
Michael Albinus committed
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
;;   </method>
;;   <signal name="ItemCreated">
;;     <arg name="item" type="o"/>
;;   </signal>
;;   <signal name="ItemDeleted">
;;     <arg name="item" type="o"/>
;;   </signal>
;;   <signal name="ItemChanged">
;;     <arg name="item" type="o"/>
;;   </signal>
;; </interface>

(defconst secrets-session-collection-path
  "/org/freedesktop/secrets/collection/session"
  "The D-Bus temporary session collection object path.")

(defconst secrets-interface-prompt "org.freedesktop.Secret.Prompt"
  "A session tracks state between the service and a client application.")

;; <interface name="org.freedesktop.Secret.Prompt">
;;   <method name="Prompt">
;;     <arg name="window-id" type="s" direction="in"/>
;;   </method>
;;   <method name="Dismiss"></method>
;;   <signal name="Completed">
;;     <arg name="dismissed" type="b"/>
;;     <arg name="result"    type="v"/>
;;   </signal>
;; </interface>

(defconst secrets-interface-item "org.freedesktop.Secret.Item"
  "A collection of items containing secrets.")

;; <interface name="org.freedesktop.Secret.Item">
;;   <property name="Locked"     type="b"     access="read"/>
;;   <property name="Attributes" type="a{ss}" access="readwrite"/>
;;   <property name="Label"      type="s"     access="readwrite"/>
;;   <property name="Created"    type="t"     access="read"/>
;;   <property name="Modified"   type="t"     access="read"/>
;;   <method name="Delete">
;;     <arg name="prompt" type="o" direction="out"/>
;;   </method>
;;   <method name="GetSecret">
297 298
;;     <arg name="session" type="o"        direction="in"/>
;;     <arg name="secret"  type="(oayays)" direction="out"/>
Michael Albinus's avatar
Michael Albinus committed
299 300
;;   </method>
;;   <method name="SetSecret">
301
;;     <arg name="secret" type="(oayays)" direction="in"/>
Michael Albinus's avatar
Michael Albinus committed
302 303 304 305 306 307 308
;;   </method>
;; </interface>
;;
;; STRUCT	secret
;;   OBJECT PATH  session
;;   ARRAY BYTE	  parameters
;;   ARRAY BYTE	  value
309
;;   STRING	  content_type     ;; Added 2011/2/9
Michael Albinus's avatar
Michael Albinus committed
310 311 312 313

(defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic"
  "The default item type we are using.")

314 315 316
;; We cannot use introspection, because some servers, like
;; mate-keyring-daemon, don't provide relevant data.  Once the dust
;; has settled, we shall assume the new interface, and get rid of the test.
317
(defconst secrets-struct-secret-content-type
318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
  (ignore-errors
    (let ((content-type "text/plain")
	  (path (cadr
		 (dbus-call-method
		  :session secrets-service secrets-path
		  secrets-interface-service
		  "OpenSession" "plain" '(:variant ""))))
	  result)
      ;; Create a dummy item.
      (setq result
	    (dbus-call-method
	     :session secrets-service secrets-session-collection-path
	     secrets-interface-collection "CreateItem"
	     ;; Properties.
	     `(:array
	       (:dict-entry ,(concat secrets-interface-item ".Label")
			    (:variant "dummy"))
	       (:dict-entry ,(concat secrets-interface-item ".Type")
			    (:variant ,secrets-interface-item-type-generic)))
	     ;; Secret.
	     `(:struct :object-path ,path
		       (:array :signature "y")
		       ,(dbus-string-to-byte-array " ")
		       :string ,content-type)
	     ;; Don't replace.
	     nil))
      ;; Remove it.
      (dbus-call-method
       :session secrets-service (car result)
       secrets-interface-item "Delete")
      ;; Result.
      `(,content-type)))
350 351 352 353
  "The content_type of a secret struct.
It must be wrapped as list, because we add it via `append'.  This
is an interface introduced in 2011.")

Michael Albinus's avatar
Michael Albinus committed
354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420
(defconst secrets-interface-session "org.freedesktop.Secret.Session"
  "A session tracks state between the service and a client application.")

;; <interface name="org.freedesktop.Secret.Session">
;;   <method name="Close"></method>
;; </interface>

;;; Sessions.

(defvar secrets-session-path secrets-empty-path
  "The D-Bus session path of the active session.
A session path `secrets-empty-path' indicates there is no open session.")

(defun secrets-close-session ()
  "Close the secret service session, if any."
  (dbus-ignore-errors
    (dbus-call-method
     :session secrets-service secrets-session-path
     secrets-interface-session "Close"))
  (setq secrets-session-path secrets-empty-path))

(defun secrets-open-session (&optional reopen)
  "Open a new session with \"plain\" algorithm.
If there exists another active session, and REOPEN is nil, that
session will be used.  The object path of the session will be
returned, and it will be stored in `secrets-session-path'."
  (when reopen (secrets-close-session))
  (when (secrets-empty-path secrets-session-path)
    (setq secrets-session-path
	  (cadr
	   (dbus-call-method
	    :session secrets-service secrets-path
	    secrets-interface-service "OpenSession" "plain" '(:variant "")))))
  (when secrets-debug
    (message "Secret Service session: %s" secrets-session-path))
  secrets-session-path)

;;; Prompts.

(defvar secrets-prompt-signal nil
  "Internal variable to catch signals from `secrets-interface-prompt'.")

(defun secrets-prompt (prompt)
  "Handle the prompt identified by object path PROMPT."
  (unless (secrets-empty-path prompt)
    (let ((object
	   (dbus-register-signal
	    :session secrets-service prompt
	    secrets-interface-prompt "Completed" 'secrets-prompt-handler)))
      (dbus-call-method
       :session secrets-service prompt
       secrets-interface-prompt "Prompt" (frame-parameter nil 'window-id))
      (unwind-protect
	  (progn
	    ;; Wait until the returned prompt signal has put the
	    ;; result into `secrets-prompt-signal'.
	    (while (null secrets-prompt-signal)
	      (read-event nil nil 0.1))
	    ;; Return the object(s).  It is a variant, so we must use a car.
	    (car secrets-prompt-signal))
	;; Cleanup.
	(setq secrets-prompt-signal nil)
	(dbus-unregister-object object)))))

(defun secrets-prompt-handler (&rest args)
  "Handler for signals emitted by `secrets-interface-prompt'."
  ;; 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
Michael Albinus's avatar
Michael Albinus committed
422 423 424 425 426 427 428 429 430 431 432 433 434 435
  ;; "Completed" signal.
  (if (car args) ;; dismissed
      (setq secrets-prompt-signal (list secrets-empty-path))
    (setq secrets-prompt-signal (cadr args))))

;;; Collections.

(defvar secrets-collection-paths nil
  "Cached D-Bus object paths of available collections.")

(defun secrets-collection-handler (&rest args)
  "Handler for signals emitted by `secrets-interface-service'."
  (cond
   ((string-equal (dbus-event-member-name last-input-event) "CollectionCreated")
Mark Oteiza's avatar
Mark Oteiza committed
436
    (cl-pushnew (car args) secrets-collection-paths))
Michael Albinus's avatar
Michael Albinus committed
437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472
   ((string-equal (dbus-event-member-name last-input-event) "CollectionDeleted")
    (setq secrets-collection-paths
	  (delete (car args) secrets-collection-paths)))))

(defun secrets-get-collections ()
  "Return the object paths of all available collections."
  (setq secrets-collection-paths
	(or secrets-collection-paths
	    (dbus-get-property
	     :session secrets-service secrets-path
	     secrets-interface-service "Collections"))))

(defun secrets-get-collection-properties (collection-path)
  "Return all properties of collection identified by COLLECTION-PATH."
  (unless (secrets-empty-path collection-path)
    (dbus-get-all-properties
     :session secrets-service collection-path
     secrets-interface-collection)))

(defun secrets-get-collection-property (collection-path property)
  "Return property PROPERTY of collection identified by COLLECTION-PATH."
  (unless (or (secrets-empty-path collection-path) (not (stringp property)))
    (dbus-get-property
     :session secrets-service collection-path
     secrets-interface-collection property)))

(defun secrets-list-collections ()
  "Return a list of collection names."
  (mapcar
   (lambda (collection-path)
     (if (string-equal collection-path secrets-session-collection-path)
	 "session"
       (secrets-get-collection-property collection-path "Label")))
   (secrets-get-collections)))

(defun secrets-collection-path (collection)
Paul Eggert's avatar
Paul Eggert committed
473
  "Return the object path of collection labeled COLLECTION.
Michael Albinus's avatar
Michael Albinus committed
474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489
If COLLECTION is nil, return the session collection path.
If there is no such COLLECTION, return nil."
  (or
   ;; The "session" collection.
   (if (or (null collection) (string-equal "session" collection))
       secrets-session-collection-path)
   ;; Check for an alias.
   (let ((collection-path
	  (dbus-call-method
	   :session secrets-service secrets-path
	   secrets-interface-service "ReadAlias" collection)))
     (unless (secrets-empty-path collection-path)
       collection-path))
   ;; Check the collections.
   (catch 'collection-found
     (dolist (collection-path (secrets-get-collections) nil)
490 491 492
       (when (string-equal
	      collection
	      (secrets-get-collection-property collection-path "Label"))
Michael Albinus's avatar
Michael Albinus committed
493 494
	 (throw 'collection-found collection-path))))))

495
(defun secrets-create-collection (collection &optional alias)
Paul Eggert's avatar
Paul Eggert committed
496
  "Create collection labeled COLLECTION if it doesn't exist.
497 498
Set ALIAS as alias of the collection.  Return the D-Bus object
path for collection."
Michael Albinus's avatar
Michael Albinus committed
499 500 501 502 503 504 505 506 507 508
  (let ((collection-path (secrets-collection-path collection)))
    ;; Create the collection.
    (when (secrets-empty-path collection-path)
      (setq collection-path
	    (secrets-prompt
	     (cadr
	      ;; "CreateCollection" returns the prompt path as second arg.
	      (dbus-call-method
	       :session secrets-service secrets-path
	       secrets-interface-service "CreateCollection"
509 510 511 512
	       `(:array
		 (:dict-entry ,(concat secrets-interface-collection ".Label")
			      (:variant ,collection)))
	       (or alias ""))))))
Michael Albinus's avatar
Michael Albinus committed
513 514 515 516 517 518 519 520 521 522 523 524 525
    ;; Return object path of the collection.
    collection-path))

(defun secrets-get-alias (alias)
  "Return the collection name ALIAS is referencing to.
For the time being, only the alias \"default\" is supported."
  (secrets-get-collection-property
   (dbus-call-method
    :session secrets-service secrets-path
    secrets-interface-service "ReadAlias" alias)
   "Label"))

(defun secrets-set-alias (collection alias)
Paul Eggert's avatar
Paul Eggert committed
526
  "Set ALIAS as alias of collection labeled COLLECTION.
Michael Albinus's avatar
Michael Albinus committed
527 528 529 530 531 532 533 534
For the time being, only the alias \"default\" is supported."
  (let ((collection-path (secrets-collection-path collection)))
    (unless (secrets-empty-path collection-path)
      (dbus-call-method
       :session secrets-service secrets-path
       secrets-interface-service "SetAlias"
       alias :object-path collection-path))))

535 536 537 538 539 540 541
(defun secrets-delete-alias (alias)
  "Delete ALIAS, referencing to a collection."
  (dbus-call-method
   :session secrets-service secrets-path
   secrets-interface-service "SetAlias"
   alias :object-path secrets-empty-path))

Michael Albinus's avatar
Michael Albinus committed
542
(defun secrets-unlock-collection (collection)
Paul Eggert's avatar
Paul Eggert committed
543
  "Unlock collection labeled COLLECTION.
Michael Albinus's avatar
Michael Albinus committed
544 545 546 547 548 549 550 551 552 553 554
If successful, return the object path of the collection."
  (let ((collection-path (secrets-collection-path collection)))
    (unless (secrets-empty-path collection-path)
      (secrets-prompt
       (cadr
	(dbus-call-method
	 :session secrets-service secrets-path secrets-interface-service
	 "Unlock" `(:array :object-path ,collection-path)))))
    collection-path))

(defun secrets-delete-collection (collection)
Paul Eggert's avatar
Paul Eggert committed
555
  "Delete collection labeled COLLECTION."
Michael Albinus's avatar
Michael Albinus committed
556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600
  (let ((collection-path (secrets-collection-path collection)))
    (unless (secrets-empty-path collection-path)
      (secrets-prompt
       (dbus-call-method
	:session secrets-service collection-path
	secrets-interface-collection "Delete")))))

;;; Items.

(defun secrets-get-items (collection-path)
  "Return the object paths of all available items in COLLECTION-PATH."
  (unless (secrets-empty-path collection-path)
    (secrets-open-session)
    (dbus-get-property
     :session secrets-service collection-path
     secrets-interface-collection "Items")))

(defun secrets-get-item-properties (item-path)
  "Return all properties of item identified by ITEM-PATH."
  (unless (secrets-empty-path item-path)
    (dbus-get-all-properties
     :session secrets-service item-path
     secrets-interface-item)))

(defun secrets-get-item-property (item-path property)
  "Return property PROPERTY of item identified by ITEM-PATH."
  (unless (or (secrets-empty-path item-path) (not (stringp property)))
    (dbus-get-property
     :session secrets-service item-path
     secrets-interface-item property)))

(defun secrets-list-items (collection)
  "Return a list of all item labels of COLLECTION."
  (let ((collection-path (secrets-unlock-collection collection)))
    (unless (secrets-empty-path collection-path)
      (mapcar
       (lambda (item-path)
	 (secrets-get-item-property item-path "Label"))
       (secrets-get-items collection-path)))))

(defun secrets-search-items (collection &rest attributes)
  "Search items in COLLECTION with ATTRIBUTES.
ATTRIBUTES are key-value pairs.  The keys are keyword symbols,
starting with a colon.  Example:

601
  (secrets-search-items \"Tramp collection\" :user \"joe\")
Michael Albinus's avatar
Michael Albinus committed
602

603
The object labels of the found items are returned as list."
Michael Albinus's avatar
Michael Albinus committed
604 605 606 607 608 609 610
  (let ((collection-path (secrets-unlock-collection collection))
	result props)
    (unless (secrets-empty-path collection-path)
      ;; Create attributes list.
      (while (consp (cdr attributes))
	(unless (keywordp (car attributes))
	  (error 'wrong-type-argument (car attributes)))
611 612
        (unless (stringp (cadr attributes))
          (error 'wrong-type-argument (cadr attributes)))
Mark Oteiza's avatar
Mark Oteiza committed
613 614
	(setq props (append
		     props
615 616 617
		     `((:dict-entry
			,(substring (symbol-name (car attributes)) 1)
			,(cadr attributes))))
Michael Albinus's avatar
Michael Albinus committed
618
	      attributes (cddr attributes)))
619
      ;; Search.  The result is a list of object paths.
Michael Albinus's avatar
Michael Albinus committed
620 621 622 623 624 625 626 627 628 629
      (setq result
	    (dbus-call-method
	     :session secrets-service collection-path
	     secrets-interface-collection "SearchItems"
	     (if props
		 (cons :array props)
	       '(:array :signature "{ss}"))))
      ;; Return the found items.
      (mapcar
       (lambda (item-path) (secrets-get-item-property item-path "Label"))
630
       result))))
Michael Albinus's avatar
Michael Albinus committed
631 632 633 634 635 636

(defun secrets-create-item (collection item password &rest attributes)
  "Create a new item in COLLECTION with label ITEM and password PASSWORD.
ATTRIBUTES are key-value pairs set for the created item.  The
keys are keyword symbols, starting with a colon.  Example:

637 638
  (secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
   :method \"sudo\" :user \"joe\" :host \"remote-host\")
Michael Albinus's avatar
Michael Albinus committed
639 640 641 642 643 644 645 646 647 648

The object path of the created item is returned."
  (unless (member item (secrets-list-items collection))
    (let ((collection-path (secrets-unlock-collection collection))
	  result props)
      (unless (secrets-empty-path collection-path)
	;; Create attributes list.
	(while (consp (cdr attributes))
	  (unless (keywordp (car attributes))
	    (error 'wrong-type-argument (car attributes)))
649 650
          (unless (stringp (cadr attributes))
            (error 'wrong-type-argument (cadr attributes)))
Mark Oteiza's avatar
Mark Oteiza committed
651 652
	  (setq props (append
		       props
653 654 655
		       `((:dict-entry
			  ,(substring (symbol-name (car attributes)) 1)
			  ,(cadr attributes))))
Michael Albinus's avatar
Michael Albinus committed
656 657 658 659 660 661 662 663 664
		attributes (cddr attributes)))
	;; Create the item.
	(setq result
	      (dbus-call-method
	       :session secrets-service collection-path
	       secrets-interface-collection "CreateItem"
	       ;; Properties.
	       (append
		`(:array
665 666 667 668
		  (:dict-entry ,(concat secrets-interface-item ".Label")
			       (:variant ,item))
		  (:dict-entry ,(concat secrets-interface-item ".Type")
			       (:variant ,secrets-interface-item-type-generic)))
Michael Albinus's avatar
Michael Albinus committed
669
		(when props
670 671
		  `((:dict-entry ,(concat secrets-interface-item ".Attributes")
				 (:variant ,(append '(:array) props))))))
Michael Albinus's avatar
Michael Albinus committed
672
	       ;; Secret.
673 674 675 676 677 678 679
	       (append
		`(:struct :object-path ,secrets-session-path
			  (:array :signature "y") ;; No parameters.
			  ,(dbus-string-to-byte-array password))
		;; We add the content_type.  In backward compatibility
		;; mode, nil is appended, which means nothing.
		secrets-struct-secret-content-type)
Michael Albinus's avatar
Michael Albinus committed
680 681 682 683 684 685 686
	       ;; Do not replace. Replace does not seem to work.
	       nil))
	(secrets-prompt (cadr result))
	;; Return the object path.
	(car result)))))

(defun secrets-item-path (collection item)
Paul Eggert's avatar
Paul Eggert committed
687
  "Return the object path of item labeled ITEM in COLLECTION.
Michael Albinus's avatar
Michael Albinus committed
688 689 690 691 692 693 694 695
If there is no such item, return nil."
  (let ((collection-path (secrets-unlock-collection collection)))
    (catch 'item-found
      (dolist (item-path (secrets-get-items collection-path))
	(when (string-equal item (secrets-get-item-property item-path "Label"))
	  (throw 'item-found item-path))))))

(defun secrets-get-secret (collection item)
Paul Eggert's avatar
Paul Eggert committed
696
  "Return the secret of item labeled ITEM in COLLECTION.
Michael Albinus's avatar
Michael Albinus committed
697 698 699 700
If there is no such item, return nil."
  (let ((item-path (secrets-item-path collection item)))
    (unless (secrets-empty-path item-path)
      (dbus-byte-array-to-string
701
       (nth 2
Michael Albinus's avatar
Michael Albinus committed
702 703 704 705 706
	(dbus-call-method
	 :session secrets-service item-path secrets-interface-item
	 "GetSecret" :object-path secrets-session-path))))))

(defun secrets-get-attributes (collection item)
Paul Eggert's avatar
Paul Eggert committed
707
  "Return the lookup attributes of item labeled ITEM in COLLECTION.
Michael Albinus's avatar
Michael Albinus committed
708 709 710 711 712
If there is no such item, or the item has no attributes, return nil."
  (unless (stringp collection) (setq collection "default"))
  (let ((item-path (secrets-item-path collection item)))
    (unless (secrets-empty-path item-path)
      (mapcar
713 714
       (lambda (attribute)
	 (cons (intern (concat ":" (car attribute))) (cadr attribute)))
Michael Albinus's avatar
Michael Albinus committed
715 716 717 718 719
       (dbus-get-property
	:session secrets-service item-path
	secrets-interface-item "Attributes")))))

(defun secrets-get-attribute (collection item attribute)
Paul Eggert's avatar
Paul Eggert committed
720
  "Return the value of ATTRIBUTE of item labeled ITEM in COLLECTION.
Michael Albinus's avatar
Michael Albinus committed
721 722 723 724 725 726 727 728 729 730 731 732
If there is no such item, or the item doesn't own this attribute, return nil."
  (cdr (assoc attribute (secrets-get-attributes collection item))))

(defun secrets-delete-item (collection item)
  "Delete ITEM in COLLECTION."
  (let ((item-path (secrets-item-path collection item)))
    (unless (secrets-empty-path item-path)
      (secrets-prompt
       (dbus-call-method
	:session secrets-service item-path
	secrets-interface-item "Delete")))))

733 734
;;; Visualization.

735 736 737 738 739
(defvar secrets-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map (make-composed-keymap special-mode-map widget-keymap))
    (define-key map "n" 'next-line)
    (define-key map "p" 'previous-line)
740
    (define-key map "z" 'kill-current-buffer)
741 742 743 744
    map)
  "Keymap used in `secrets-mode' buffers.")

(define-derived-mode secrets-mode special-mode "Secrets"
745
  "Major mode for presenting password entries retrieved by Security Service.
746 747
In this mode, widgets represent the search results.

748
\\{secrets-mode-map}"
749 750 751
  (setq buffer-undo-list t)
  (set (make-local-variable 'revert-buffer-function)
       #'secrets-show-collections)
752 753
  ;; When we toggle, we must set temporary widgets.
  (set (make-local-variable 'tree-widget-after-toggle-functions)
754
       '(secrets-tree-widget-after-toggle-function)))
755 756 757 758

;; It doesn't make sense to call it interactively.
(put 'secrets-mode 'disabled t)

759 760 761 762
;; We autoload `secrets-show-secrets' only on systems with D-Bus support.
;;;###autoload(when (featurep 'dbusbind)
;;;###autoload  (autoload 'secrets-show-secrets "secrets" nil t))

763 764 765 766 767 768
(defun secrets-show-secrets ()
  "Display a list of collections from the Secret Service API.
The collections are in tree view, that means they can be expanded
to the corresponding secret items, which could also be expanded
to their attributes."
  (interactive)
769 770 771 772 773 774 775 776

  ;; Check, whether the Secret Service API is enabled.
  (if (null secrets-enabled)
      (message "Secret Service not available")

    ;; Create the search buffer.
    (with-current-buffer (get-buffer-create "*Secrets*")
      (switch-to-buffer-other-window (current-buffer))
Paul Eggert's avatar
Paul Eggert committed
777
      ;; Initialize buffer with `secrets-mode'.
778 779
      (secrets-mode)
      (secrets-show-collections))))
780

781
(defun secrets-show-collections (&optional _ignore _noconfirm)
782
  "Show all available collections."
Mark Oteiza's avatar
Mark Oteiza committed
783
  (let ((inhibit-read-only t))
784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815
    (erase-buffer)
    (tree-widget-set-theme "folder")
    (dolist (coll (secrets-list-collections))
      (widget-create
     `(tree-widget
       :tag ,coll
       :collection ,coll
       :open nil
       :sample-face bold
       :expander secrets-expand-collection)))))

(defun secrets-expand-collection (widget)
  "Expand items of collection shown as WIDGET."
  (let ((coll (widget-get widget :collection)))
    (mapcar
     (lambda (item)
       `(tree-widget
	 :tag ,item
	 :collection ,coll
	 :item ,item
	 :open nil
	 :sample-face bold
	 :expander secrets-expand-item))
     (secrets-list-items coll))))

(defun secrets-expand-item (widget)
  "Expand password and attributes of item shown as WIDGET."
  (let* ((coll (widget-get widget :collection))
	 (item (widget-get widget :item))
	 (attributes (secrets-get-attributes coll item))
	 ;; padding is needed to format attribute names.
	 (padding
816 817 818 819 820
	  (apply
	   'max
	   (cons
	    (1+ (length "password"))
	    (mapcar
Paul Eggert's avatar
Paul Eggert committed
821
	     ;; Attribute names have a leading ":", which will be suppressed.
822 823
	     (lambda (attribute) (length (symbol-name (car attribute))))
	     attributes)))))
824 825 826 827 828 829 830 831 832 833 834 835 836 837
    (cons
     ;; The password widget.
     `(editable-field :tag "password"
		      :secret ?*
		      :value ,(secrets-get-secret coll item)
		      :sample-face widget-button-pressed
		      ;; We specify :size in order to limit the field.
		      :size 0
		      :format ,(concat
				"%{%t%}:"
				(make-string (- padding (length "password")) ? )
				"%v\n"))
     (mapcar
      (lambda (attribute)
838
	(let ((name (substring (symbol-name (car attribute)) 1))
839 840 841 842 843 844 845 846 847 848 849 850 851
	      (value (cdr attribute)))
	  ;; The attribute widget.
	  `(editable-field :tag ,name
			   :value ,value
			   :sample-face widget-documentation
			   ;; We specify :size in order to limit the field.
			   :size 0
			   :format ,(concat
				     "%{%t%}:"
				     (make-string (- padding (length name)) ? )
				     "%v\n"))))
      attributes))))

Mark Oteiza's avatar
Mark Oteiza committed
852
(defun secrets-tree-widget-after-toggle-function (widget &rest _ignore)
853 854 855 856 857 858 859 860 861 862 863
  "Add a temporary widget to show the password."
  (dolist (child (widget-get widget :children))
    (when (widget-member child :secret)
      (goto-char (widget-field-end child))
      (widget-insert " ")
      (widget-create-child-and-convert
       child 'push-button
       :notify 'secrets-tree-widget-show-password
       "Show password")))
  (widget-setup))

Mark Oteiza's avatar
Mark Oteiza committed
864
(defun secrets-tree-widget-show-password (widget &rest _ignore)
865 866 867 868 869 870 871 872
  "Show password, and remove temporary widget."
  (let ((parent (widget-get widget :parent)))
    (widget-put parent :secret nil)
    (widget-default-value-set parent (widget-get parent :value))
    (widget-setup)))

;;; Initialization.

873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900
(when (dbus-ping :session secrets-service 100)

  ;; We must reset all variables, when there is a new instance of the
  ;; "org.freedesktop.secrets" service.
  (dbus-register-signal
   :session dbus-service-dbus dbus-path-dbus
   dbus-interface-dbus "NameOwnerChanged"
   (lambda (&rest args)
     (when secrets-debug (message "Secret Service has changed: %S" args))
     (setq secrets-session-path secrets-empty-path
	   secrets-prompt-signal nil
	   secrets-collection-paths nil))
   secrets-service)

  ;; We want to refresh our cache, when there is a change in
  ;; collections.
  (dbus-register-signal
   :session secrets-service secrets-path
   secrets-interface-service "CollectionCreated"
   'secrets-collection-handler)

  (dbus-register-signal
   :session secrets-service secrets-path
   secrets-interface-service "CollectionDeleted"
   'secrets-collection-handler)

  ;; We shall inform, whether the secret service is enabled on this
  ;; machine.
901
  (setq secrets-enabled t))
902 903

(provide 'secrets)
Michael Albinus's avatar
Michael Albinus committed
904 905 906 907 908 909 910 911 912

;;; TODO:

;; * secrets-debug should be structured like auth-source-debug to
;;   prevent leaking sensitive information.  Right now I don't see
;;   anything sensitive though.
;; * Check, whether the dh-ietf1024-aes128-cbc-pkcs7 algorithm can be
;;   used for the transfer of the secrets.  Currently, we use the
;;   plain algorithm.