;;; secrets.el --- Client interface to gnome-keyring and kwallet.
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm password passphrase
;; 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
;; </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 explicitly, 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-collection-property collection-path "Label"))
(throw 'collection-found collection-path))))))
-(defun secrets-create-collection (collection)
+(defun secrets-create-collection (collection &optional alias)
"Create collection labeled COLLECTION if it doesn't exist.
-Return the D-Bus object path for collection."
+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))
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))
(let ((item-path (secrets-item-path collection item)))
(unless (secrets-empty-path item-path)
(dbus-byte-array-to-string
- (cl-caddr
+ (nth 2
(dbus-call-method
:session secrets-service item-path secrets-interface-item
"GetSecret" :object-path secrets-session-path))))))