Add tests for secrets.el

* lisp/net/secrets.el (secrets-lock-collection): New defun.
(secrets-search-items, secrets-create-item): Fix structure of :dict-entry.

* test/lisp/net/secrets-tests.el: New package.

diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index fbb0a74978a2e069b3a27e77ed8eeb3f0325a5ae..e5ab5b31ab08e11a48be5c5fb517f39a696c3082 100644 (file)
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -539,6 +539,18 @@ For the time being, only the alias \"default\" is supported."
    secrets-interface-service "SetAlias"
    alias :object-path secrets-empty-path))
 
+(defun secrets-lock-collection (collection)
+  "Lock 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)
+      (secrets-prompt
+       (cadr
+       (dbus-call-method
+        :session secrets-service secrets-path secrets-interface-service
+        "Lock" `(:array :object-path ,collection-path)))))
+    collection-path))
+
 (defun secrets-unlock-collection (collection)
   "Unlock collection labeled COLLECTION.
 If successful, return the object path of the collection."
@@ -612,9 +624,9 @@ The object labels of the found items are returned as list."
           (error 'wrong-type-argument (cadr attributes)))
        (setq props (append
                     props
-                    (list :dict-entry
-                          (substring (symbol-name (car attributes)) 1)
-                          (cadr attributes)))
+                    `((:dict-entry
+                       ,(substring (symbol-name (car attributes)) 1)
+                       ,(cadr attributes))))
              attributes (cddr attributes)))
       ;; Search.  The result is a list of object paths.
       (setq result
@@ -650,9 +662,9 @@ The object path of the created item is returned."
             (error 'wrong-type-argument (cadr attributes)))
          (setq props (append
                       props
-                      (list :dict-entry
-                            (substring (symbol-name (car attributes)) 1)
-                            (cadr attributes)))
+                      `((:dict-entry
+                         ,(substring (symbol-name (car attributes)) 1)
+                         ,(cadr attributes))))
                attributes (cddr attributes)))
        ;; Create the item.
        (setq result

diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el
new file mode 100644 (file)
index 0000000..dc9c7f1
--- /dev/null
+++ b/test/lisp/net/secrets-tests.el
@@ -0,0 +1,234 @@
+;;; secrets-tests.el --- Tests of Secret Service API
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+
+;; This program 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.
+;;
+;; This program 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
+;; along with this program.  If not, see `https://www.gnu.org/licenses/'.
+
+;;; Code:
+
+(require 'ert)
+(require 'secrets)
+(require 'notifications)
+
+;; We do not want chatty messages.
+(setq secrets-debug nil)
+
+(ert-deftest secrets-test00-availability ()
+  "Test availability of Secret Service API."
+  :expected-result (if secrets-enabled :passed :failed)
+  (should secrets-enabled)
+  (should (dbus-ping :session secrets-service))
+  ;; We do not test when there's an open session.
+  (should (secrets-empty-path secrets-session-path)))
+
+(defun secrets--test-get-all-sessions ()
+  "Return all object paths for existing secrets sessions."
+  (let ((session-path (concat secrets-path "/session")))
+    (delete
+     session-path
+     (dbus-introspect-get-all-nodes :session secrets-service session-path))))
+
+(defun secrets--test-close-all-sessions ()
+  "Close all secrets sessions which are bound to this Emacs."
+  (secrets-close-session)
+  ;; We loop over all other sessions.  If a session does not belong to
+  ;; us, a `dbus-error' is fired, which we ignore.
+  (dolist (path (secrets--test-get-all-sessions))
+    (dbus-ignore-errors
+      (dbus-call-method
+       :session secrets-service path secrets-interface-session "Close"))))
+
+(defun secrets--test-delete-all-session-items ()
+  "Delete all items of collection \"session\" bound to this Emacs."
+  (dolist (item (secrets-list-items "session"))
+    (secrets-delete-item "session" item)))
+
+(ert-deftest secrets-test01-sessions ()
+  "Test opening / closing a secrets session."
+  (skip-unless secrets-enabled)
+  (skip-unless (secrets-empty-path secrets-session-path))
+
+  (unwind-protect
+      (progn
+       ;; Simple opening / closing of a session.
+       (should (secrets-open-session))
+       (should-not (secrets-empty-path secrets-session-path))
+       (should (secrets-close-session))
+       (should (secrets-empty-path secrets-session-path))
+
+       ;; Reopening a new session.
+       (should (string-equal (secrets-open-session) (secrets-open-session)))
+       (should (string-equal secrets-session-path (secrets-open-session)))
+       (should-not
+        (string-equal (secrets-open-session) (secrets-open-session 'reopen)))
+       (should-not
+        (string-equal secrets-session-path (secrets-open-session 'reopen))))
+
+    ;; Exit.
+    (should (secrets-close-session))
+    (secrets--test-close-all-sessions)))
+
+(ert-deftest secrets-test02-collections ()
+  "Test creation / deletion a secrets collections."
+  (skip-unless secrets-enabled)
+  (skip-unless (secrets-empty-path secrets-session-path))
+
+  (unwind-protect
+      (progn
+       ;; There must be at least the collections "Login" and "session".
+       (should (member "Login" (secrets-list-collections)))
+       (should (member "session" (secrets-list-collections)))
+
+       ;; Create a random collection.  This asks for a password
+       ;; outside our control, so we make it in the interactive case
+       ;; only.
+       (unless noninteractive
+         (let ((collection (md5 (concat (prin1-to-string process-environment)
+                                        (current-time-string))))
+               (alias (secrets-get-alias "default")))
+           (notifications-notify
+            :title (symbol-name (ert-test-name (ert-running-test)))
+            :body "Please enter the password \"secret\" twice")
+           ;; The optional argument ALIAS does not seem to work.
+           (should (secrets-create-collection collection))
+           (should (member collection (secrets-list-collections)))
+
+           ;; We reset the alias.  The temporary collection "session"
+           ;; is not accepted.
+           (secrets-set-alias collection "default")
+           (should (string-equal (secrets-get-alias "default") collection))
+
+           ;; Delete alias.
+           (secrets-delete-alias "default")
+           (should-not (secrets-get-alias "default"))
+
+           ;; Lock / unlock the collection.
+           (secrets-lock-collection collection)
+           (should
+            (secrets-get-collection-property
+             (secrets-collection-path collection) "Locked"))
+           (notifications-notify
+            :title (symbol-name (ert-test-name (ert-running-test)))
+            :body "Please enter the password \"secret\"")
+           (secrets-unlock-collection collection)
+           (should-not
+            (secrets-get-collection-property
+             (secrets-collection-path collection) "Locked"))
+
+           ;; Delete the collection.  The alias disappears as well.
+           (secrets-set-alias collection "default")
+           (secrets-delete-collection collection)
+           (should-not (secrets-get-alias "default"))
+
+           ;; Reset alias.
+           (when alias
+             (secrets-set-alias alias "default")
+             (should (string-equal (secrets-get-alias "default") alias))))))
+
+    ;; Exit.
+    (should (secrets-close-session))
+    (secrets--test-close-all-sessions)))
+
+(ert-deftest secrets-test03-items ()
+  "Test creation / deletion a secret item."
+  (skip-unless secrets-enabled)
+  (skip-unless (secrets-empty-path secrets-session-path))
+
+  (unwind-protect
+      (progn
+       ;; 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"))
+
+       ;; 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")
+         '((:host . "remote-host") (:user . "joe")
+           (:method . "sudo")
+           (:xdg:schema . "org.freedesktop.Secret.Generic"))))
+
+       ;; Delete them.
+       (dolist (item (secrets-list-items "session"))
+         (secrets-delete-item "session" item))
+       (should-not (secrets-list-items "session")))
+
+    ;; Exit.
+    (secrets--test-delete-all-session-items)
+    (should (secrets-close-session))
+    (secrets--test-close-all-sessions)))
+
+(ert-deftest secrets-test04-search ()
+  "Test searching of secret items."
+  (skip-unless secrets-enabled)
+  (skip-unless (secrets-empty-path secrets-session-path))
+
+  (unwind-protect
+      (progn
+       ;; There shall be no items in the "session" collection.
+       (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")
+
+       ;; Search the items.
+       (should-not (secrets-search-items "session" :user "john"))
+       (should
+        (equal
+         (sort (secrets-search-items "session" :user "joe") 'string-lessp)
+         '("baz" "foo")))
+       (should
+        (equal
+         (secrets-search-items "session":method "sudo" :user "joe") '("foo")))
+       (should
+        (equal
+         (sort (secrets-search-items "session") 'string-lessp)
+         '("bar" "baz" "foo"))))
+
+    ;; Exit.
+    (secrets--test-delete-all-session-items)
+    (should (secrets-close-session))
+    (secrets--test-close-all-sessions)))
+
+(defun secrets-test-all (&optional interactive)
+  "Run all tests for \\[secrets]."
+  (interactive "p")
+  (funcall
+   (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch)
+   "^secrets"))
+
+(provide 'secrets-tests)
+;;; secrets-tests.el ends here