From: Michael Albinus Date: Thu, 5 Apr 2018 15:40:57 +0000 (+0200) Subject: Add tests for secrets.el X-Git-Tag: emacs-27.0.90~5321 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b6aea79b008c7fcb9aea60a33709f94a734532f8;p=emacs.git 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 fbb0a74978a..e5ab5b31ab0 100644 --- 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 index 00000000000..dc9c7f1004a --- /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 + +;; 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