;;; secrets.el --- Client interface to gnome-keyring and kwallet.
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm password passphrase
;; (secrets-create-collection "my collection")
;; There exists a special collection called "session", which has the
-;; lifetime of the corrresponding client session (aka Emacs'
+;; lifetime of the corresponding client session (aka Emacs's
;; 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
-;; "session", or by `nil', whenever a collection parameter is needed.
+;; "session", or by nil, whenever a collection parameter is needed.
;; 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
;; Secret items can be added or deleted to a collection. In the
;; following examples, we use the special collection "session", which
-;; is bound to Emacs' lifetime.
+;; is bound to Emacs's lifetime.
;;
;; (secrets-delete-item "session" "my item")
;; (secrets-create-item "session" "my item" "geheim"
;; 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.
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
(defvar dbus-debug)
(require 'dbus)
;; </method>
;; <method name="CreateCollection">
;; <arg name="props" type="a{sv}" direction="in"/>
+;; <arg name="alias" type="s" direction="in"/> ;; Added 2011/3/1
;; <arg name="collection" type="o" direction="out"/>
;; <arg name="prompt" type="o" direction="out"/>
;; </method>
;; <arg name="Prompt" type="o" direction="out"/>
;; </method>
;; <method name="GetSecrets">
-;; <arg name="items" type="ao" direction="in"/>
-;; <arg name="session" type="o" direction="in"/>
-;; <arg name="secrets" type="a{o(oayay)}" direction="out"/>
+;; <arg name="items" type="ao" direction="in"/>
+;; <arg name="session" type="o" direction="in"/>
+;; <arg name="secrets" type="a{o(oayays)}" direction="out"/>
;; </method>
;; <method name="ReadAlias">
;; <arg name="name" type="s" direction="in"/>
;; <interface name="org.freedesktop.Secret.Collection">
;; <property name="Items" type="ao" access="read"/>
;; <property name="Label" type="s" access="readwrite"/>
-;; <property name="Locked" type="s" access="read"/>
+;; <property name="Locked" type="b" access="read"/>
;; <property name="Created" type="t" access="read"/>
;; <property name="Modified" type="t" access="read"/>
;; <method name="Delete">
;; <arg name="results" type="ao" direction="out"/>
;; </method>
;; <method name="CreateItem">
-;; <arg name="props" type="a{sv}" direction="in"/>
-;; <arg name="secret" type="(oayay)" direction="in"/>
-;; <arg name="replace" type="b" direction="in"/>
-;; <arg name="item" type="o" direction="out"/>
-;; <arg name="prompt" type="o" direction="out"/>
+;; <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"/>
;; </method>
;; <signal name="ItemCreated">
;; <arg name="item" type="o"/>
;; <arg name="prompt" type="o" direction="out"/>
;; </method>
;; <method name="GetSecret">
-;; <arg name="session" type="o" direction="in"/>
-;; <arg name="secret" type="(oayay)" direction="out"/>
+;; <arg name="session" type="o" direction="in"/>
+;; <arg name="secret" type="(oayays)" direction="out"/>
;; </method>
;; <method name="SetSecret">
-;; <arg name="secret" type="(oayay)" direction="in"/>
+;; <arg name="secret" type="(oayays)" direction="in"/>
;; </method>
;; </interface>
;;
;; OBJECT PATH session
;; ARRAY BYTE parameters
;; ARRAY BYTE value
+;; STRING content_type ;; Added 2011/2/9
(defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic"
"The default item type we are using.")
+;; 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.
+(defconst secrets-struct-secret-content-type
+ (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)))
+ "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.")
+
(defconst secrets-interface-session "org.freedesktop.Secret.Session"
"A session tracks state between the service and a client application.")
(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'
- ;; or `nil'. Either we set it explicitely, or it is returned by the
+ ;; or nil. Either we set it explicitly, or it is returned by the
;; "Completed" signal.
(if (car args) ;; dismissed
(setq secrets-prompt-signal (list secrets-empty-path))
(secrets-get-collections)))
(defun secrets-collection-path (collection)
- "Return the object path of collection labelled COLLECTION.
+ "Return the object path of collection labeled COLLECTION.
If COLLECTION is nil, return the session collection path.
If there is no such COLLECTION, return nil."
(or
(secrets-get-collection-property collection-path "Label"))
(throw 'collection-found collection-path))))))
-(defun secrets-create-collection (collection)
- "Create collection labelled COLLECTION if it doesn't exist.
-Return the D-Bus object path for collection."
+(defun secrets-create-collection (collection &optional alias)
+ "Create collection labeled COLLECTION if it doesn't exist.
+Set ALIAS as alias of the collection. Return the D-Bus object
+path for collection."
(let ((collection-path (secrets-collection-path collection)))
;; Create the collection.
(when (secrets-empty-path collection-path)
(dbus-call-method
:session secrets-service secrets-path
secrets-interface-service "CreateCollection"
- `(:array (:dict-entry "Label" (:variant ,collection))))))))
+ `(:array
+ (:dict-entry ,(concat secrets-interface-collection ".Label")
+ (:variant ,collection)))
+ (or alias ""))))))
;; Return object path of the collection.
collection-path))
"Label"))
(defun secrets-set-alias (collection alias)
- "Set ALIAS as alias of collection labelled COLLECTION.
+ "Set ALIAS as alias of collection labeled COLLECTION.
For the time being, only the alias \"default\" is supported."
(let ((collection-path (secrets-collection-path collection)))
(unless (secrets-empty-path collection-path)
alias :object-path secrets-empty-path))
(defun secrets-unlock-collection (collection)
- "Unlock collection labelled COLLECTION.
+ "Unlock collection labeled COLLECTION.
If successful, return the object path of the collection."
(let ((collection-path (secrets-collection-path collection)))
(unless (secrets-empty-path collection-path)
collection-path))
(defun secrets-delete-collection (collection)
- "Delete collection labelled COLLECTION."
+ "Delete collection labeled COLLECTION."
(let ((collection-path (secrets-collection-path collection)))
(unless (secrets-empty-path collection-path)
(secrets-prompt
ATTRIBUTES are key-value pairs. The keys are keyword symbols,
starting with a colon. Example:
- \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
- :method \"sudo\" :user \"joe\" :host \"remote-host\"\)
+ (secrets-search-items \"Tramp collection\" :user \"joe\")
-The object paths of the found items are returned as list."
+The object labels of the found items are returned as list."
(let ((collection-path (secrets-unlock-collection collection))
result props)
(unless (secrets-empty-path collection-path)
(while (consp (cdr attributes))
(unless (keywordp (car attributes))
(error 'wrong-type-argument (car attributes)))
+ (unless (stringp (cadr attributes))
+ (error 'wrong-type-argument (cadr attributes)))
(setq props (add-to-list
'props
(list :dict-entry
(cadr attributes))
'append)
attributes (cddr attributes)))
- ;; Search. The result is a list of two lists, the object paths
- ;; of the unlocked and the locked items.
+ ;; Search. The result is a list of object paths.
(setq result
(dbus-call-method
:session secrets-service collection-path
;; Return the found items.
(mapcar
(lambda (item-path) (secrets-get-item-property item-path "Label"))
- (append (car result) (cadr result))))))
+ result))))
(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:
- \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
- :method \"sudo\" :user \"joe\" :host \"remote-host\"\)
+ (secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
+ :method \"sudo\" :user \"joe\" :host \"remote-host\")
The object path of the created item is returned."
(unless (member item (secrets-list-items collection))
(while (consp (cdr attributes))
(unless (keywordp (car attributes))
(error 'wrong-type-argument (car attributes)))
+ (unless (stringp (cadr attributes))
+ (error 'wrong-type-argument (cadr attributes)))
(setq props (add-to-list
'props
(list :dict-entry
;; Properties.
(append
`(:array
- (:dict-entry "Label" (:variant ,item))
- (:dict-entry
- "Type" (:variant ,secrets-interface-item-type-generic)))
+ (:dict-entry ,(concat secrets-interface-item ".Label")
+ (:variant ,item))
+ (:dict-entry ,(concat secrets-interface-item ".Type")
+ (:variant ,secrets-interface-item-type-generic)))
(when props
- `((:dict-entry
- "Attributes" (:variant ,(append '(:array) props))))))
+ `((:dict-entry ,(concat secrets-interface-item ".Attributes")
+ (:variant ,(append '(:array) props))))))
;; Secret.
- `(:struct :object-path ,secrets-session-path
- (:array :signature "y") ;; no parameters.
- ,(dbus-string-to-byte-array password))
+ (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)
;; Do not replace. Replace does not seem to work.
nil))
(secrets-prompt (cadr result))
(car result)))))
(defun secrets-item-path (collection item)
- "Return the object path of item labelled ITEM in COLLECTION.
+ "Return the object path of item labeled ITEM in COLLECTION.
If there is no such item, return nil."
(let ((collection-path (secrets-unlock-collection collection)))
(catch 'item-found
(throw 'item-found item-path))))))
(defun secrets-get-secret (collection item)
- "Return the secret of item labelled ITEM in COLLECTION.
+ "Return the secret of item labeled ITEM in COLLECTION.
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
- (caddr
+ (nth 2
(dbus-call-method
:session secrets-service item-path secrets-interface-item
"GetSecret" :object-path secrets-session-path))))))
(defun secrets-get-attributes (collection item)
- "Return the lookup attributes of item labelled ITEM in COLLECTION.
+ "Return the lookup attributes of item labeled ITEM in COLLECTION.
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)))
secrets-interface-item "Attributes")))))
(defun secrets-get-attribute (collection item attribute)
- "Return the value of ATTRIBUTE of item labelled ITEM in COLLECTION.
+ "Return the value of ATTRIBUTE of item labeled ITEM in COLLECTION.
If there is no such item, or the item doesn't own this attribute, return nil."
(cdr (assoc attribute (secrets-get-attributes collection item))))
;; Create the search buffer.
(with-current-buffer (get-buffer-create "*Secrets*")
(switch-to-buffer-other-window (current-buffer))
- ;; Inialize buffer with `secrets-mode'.
+ ;; Initialize buffer with `secrets-mode'.
(secrets-mode)
(secrets-show-collections))))
(cons
(1+ (length "password"))
(mapcar
- ;; Atribute names have a leading ":", which will be suppressed.
+ ;; Attribute names have a leading ":", which will be suppressed.
(lambda (attribute) (length (symbol-name (car attribute))))
attributes)))))
(cons