From b3956d85c71c30af732a8bc035ed39421bafe11d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 15 May 2018 14:48:11 +0200 Subject: [PATCH] Fix Bug#29575 * lisp/net/secrets.el (secrets-create-item): The new item does not need a unique label. (secrets-item-path, secrets-get-secret, secrets-get-attributes) (secrets-get-attribute, secrets-delete-item): ITEM can also be an object path. (Bug#29575) * test/lisp/net/secrets-tests.el (secrets-test03-items): Test also creation of two items with same label. Test `secrets-get-secret', `secrets-get-attribute' and `secrets-get-attributes' with object path. (secrets-test04-search): Harden test. --- lisp/net/secrets.el | 138 +++++++++++++++++++-------------- test/lisp/net/secrets-tests.el | 70 ++++++++++------- 2 files changed, 120 insertions(+), 88 deletions(-) diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index f7cc011615e..22a4e8c7b0a 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -641,8 +641,9 @@ The object labels of the found items are returned as list." (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: +The label ITEM must not be unique in COLLECTION. 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\") @@ -655,67 +656,73 @@ determined by this. If no `:xdg:schema' is given, \"org.freedesktop.Secret.Generic\" is used by default. 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) - ;; Set default type if needed. - (unless (member :xdg:schema attributes) - (setq attributes - (append - attributes - `(:xdg:schema ,secrets-interface-item-type-generic)))) - ;; Create attributes list. - (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 (append - props - `((:dict-entry - ,(substring (symbol-name (car attributes)) 1) - ,(cadr attributes)))) - attributes (cddr attributes))) - ;; Create the item. - (setq result - (dbus-call-method - :session secrets-service collection-path - secrets-interface-collection "CreateItem" - ;; Properties. - (append - `(:array - (:dict-entry ,(concat secrets-interface-item ".Label") - (:variant ,item))) - (when props - `((:dict-entry ,(concat secrets-interface-item ".Attributes") - (:variant ,(append '(:array) props)))))) - ;; Secret. - (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)) - ;; Return the object path. - (car result))))) + (let ((collection-path (secrets-unlock-collection collection)) + result props) + (unless (secrets-empty-path collection-path) + ;; Set default type if needed. + (unless (member :xdg:schema attributes) + (setq attributes + (append + attributes `(:xdg:schema ,secrets-interface-item-type-generic)))) + ;; Create attributes list. + (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 (append + props + `((:dict-entry + ,(substring (symbol-name (car attributes)) 1) + ,(cadr attributes)))) + attributes (cddr attributes))) + ;; Create the item. + (setq result + (dbus-call-method + :session secrets-service collection-path + secrets-interface-collection "CreateItem" + ;; Properties. + (append + `(:array + (:dict-entry ,(concat secrets-interface-item ".Label") + (:variant ,item))) + (when props + `((:dict-entry ,(concat secrets-interface-item ".Attributes") + (:variant ,(append '(:array) props)))))) + ;; Secret. + (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)) + ;; Return the object path. + (car result)))) (defun secrets-item-path (collection item) "Return the object path of item labeled ITEM in COLLECTION. -If there is no such item, return nil." +If there are several items labeled ITEM, it is undefined which +one is returned. If there is no such item, return nil. + +ITEM can also be an object path, which is returned if contained in COLLECTION." (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)))))) + (or (and (member item (secrets-get-items collection-path)) item) + (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) "Return the secret of item labeled ITEM in COLLECTION. -If there is no such item, return nil." +If there are several items labeled ITEM, it is undefined which +one is returned. If there is no such item, return nil. + +ITEM can also be an object path, which is used if contained in COLLECTION." (let ((item-path (secrets-item-path collection item))) (unless (secrets-empty-path item-path) (dbus-byte-array-to-string @@ -726,8 +733,11 @@ If there is no such item, return nil." (defun secrets-get-attributes (collection item) "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")) +If there are several items labeled ITEM, it is undefined which +one is returned. If there is no such item, or the item has no +attributes, return nil. + +ITEM can also be an object path, which is used if contained in COLLECTION." (let ((item-path (secrets-item-path collection item))) (unless (secrets-empty-path item-path) (mapcar @@ -739,11 +749,19 @@ If there is no such item, or the item has no attributes, return nil." (defun secrets-get-attribute (collection item attribute) "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." +If there are several items labeled ITEM, it is undefined which +one is returned. If there is no such item, or the item doesn't +own this attribute, return nil. + +ITEM can also be an object path, which is used if contained in COLLECTION." (cdr (assoc attribute (secrets-get-attributes collection item)))) (defun secrets-delete-item (collection item) - "Delete ITEM in COLLECTION." + "Delete item labeled ITEM in COLLECTION. +If there are several items labeled ITEM, it is undefined which +one is deleted. + +ITEM can also be an object path, which is used if contained in COLLECTION." (let ((item-path (secrets-item-path collection item))) (unless (secrets-empty-path item-path) (secrets-prompt diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index 23512d48ee5..fcc3a2d3e6e 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -148,37 +148,48 @@ (skip-unless (secrets-empty-path secrets-session-path)) (unwind-protect - (progn + (let (item-path) ;; There shall be no items in the "session" collection. (should-not (secrets-list-items "session")) ;; There shall be items in the "Login" collection. (should (secrets-list-items "Login")) ;; Create a new item. - (secrets-create-item "session" "foo" "secret") - (should (string-equal (secrets-get-secret "session" "foo") "secret")) + (should (setq item-path (secrets-create-item "session" "foo" "secret"))) + (dolist (item `("foo" ,item-path)) + (should (string-equal (secrets-get-secret "session" item) "secret"))) + + ;; Create another item with same label. + (should (secrets-create-item "session" "foo" "geheim")) + (should (equal (secrets-list-items "session") '("foo" "foo"))) ;; Create an item with attributes. - (secrets-create-item - "session" "bar" "secret" - :method "sudo" :user "joe" :host "remote-host") (should - (string-equal (secrets-get-attribute "session" "bar" :method) "sudo")) - ;; The attributes are collected in reverse order. :xdg:schema - ;; is added silently. - (should - (equal - (secrets-get-attributes "session" "bar") - '((:xdg:schema . "org.freedesktop.Secret.Generic") - (:host . "remote-host") (:user . "joe") (:method . "sudo")))) + (setq item-path + (secrets-create-item + "session" "bar" "secret" + :method "sudo" :user "joe" :host "remote-host"))) + (dolist (item `("bar" ,item-path)) + (should + (string-equal (secrets-get-attribute "session" item :method) "sudo")) + ;; The attributes are collected in reverse order. + ;; :xdg:schema is added silently. + (should + (equal + (secrets-get-attributes "session" item) + '((:xdg:schema . "org.freedesktop.Secret.Generic") + (:host . "remote-host") (:user . "joe") (:method . "sudo"))))) ;; Create an item with another schema. - (secrets-create-item - "session" "baz" "secret" :xdg:schema "org.gnu.Emacs.foo") (should - (equal - (secrets-get-attributes "session" "baz") - '((:xdg:schema . "org.gnu.Emacs.foo")))) + (setq item-path + (secrets-create-item + "session" "baz" "secret" :xdg:schema "org.gnu.Emacs.foo"))) + (dolist (item `("baz" ,item-path)) + (should + (equal + (secrets-get-attributes "session" item) + '((:xdg:schema . "org.gnu.Emacs.foo"))))) ;; Delete them. (dolist (item (secrets-list-items "session")) @@ -201,15 +212,18 @@ (should-not (secrets-list-items "session")) ;; Create some items. - (secrets-create-item - "session" "foo" "secret" - :method "sudo" :user "joe" :host "remote-host") - (secrets-create-item - "session" "bar" "secret" - :method "sudo" :user "smith" :host "remote-host") - (secrets-create-item - "session" "baz" "secret" - :method "ssh" :user "joe" :host "other-host") + (should + (secrets-create-item + "session" "foo" "secret" + :method "sudo" :user "joe" :host "remote-host")) + (should + (secrets-create-item + "session" "bar" "secret" + :method "sudo" :user "smith" :host "remote-host")) + (should + (secrets-create-item + "session" "baz" "secret" + :method "ssh" :user "joe" :host "other-host")) ;; Search the items. (should-not (secrets-search-items "session" :user "john")) -- 2.39.5