Add tests for url-auth
* test/lisp/url/url-auth-tests.el: New file.
This commit is contained in:
Jarno Malmari
Lars Ingebrigtsen
parent
f29b6cf379
commit
f7b0ca9dfa
1 changed files with 249 additions and 0 deletions
249
test/lisp/url/url-auth-tests.el
Normal file
249
test/lisp/url/url-auth-tests.el
Normal file
|
|
@ -0,0 +1,249 @@
|
|||
;;; url-auth-tests.el --- Test suite for url-auth.
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jarno Malmari <jarno@malmari.fi>
|
||||
|
||||
;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Test HTTP authentication methods.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'url-auth)
|
||||
|
||||
(defvar url-auth-test-challenges nil
|
||||
"List of challenges for testing.
|
||||
Each challenge is a plist. Values are as presented by the
|
||||
server's WWW-Authenticate header field.")
|
||||
|
||||
;; Set explicitly for easier modification for re-runs.
|
||||
(setq url-auth-test-challenges
|
||||
(list
|
||||
(list :qop "auth"
|
||||
:nonce "uBr3+qkQBybTr/dKWkmpUqVO7SaEwWYzyTKO7g==$"
|
||||
:uri "/random/path"
|
||||
:method "GET"
|
||||
:realm "Some test realm"
|
||||
:cnonce "YWU4NDcxYWMxMDAxMjlkMjAwMDE4MjI5MDAwMGY4NGQ="
|
||||
:nc "00000001"
|
||||
:username "jytky"
|
||||
:password "xi5Ac2HEfKt1lKKO05DCSqsK0u7hqqtsT"
|
||||
:expected-ha1 "af521db3a83abd91262fead04fa31892"
|
||||
:expected-ha2 "e490a6a147c79404b365d1f6059ddda5"
|
||||
:expected-response "ecb6396e93b9e09e31f19264cfd8f854")
|
||||
(list :nonce "a1be8a3065e00c5bf190ad499299aea5"
|
||||
:opaque "d7c2a27230fc8c74bb6e06be8c9cd189"
|
||||
:realm "The Test Realm"
|
||||
:username "user"
|
||||
:password "passwd"
|
||||
:uri "/digest-auth/auth/user/passwd"
|
||||
:method "GET"
|
||||
:expected-ha1 "19c41161a8720edaeb7922ef8531137d"
|
||||
:expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863"
|
||||
:expected-response "46c47a6d8e1fa95a3efcf49724af3fe7")
|
||||
(list :nonce "servernonce"
|
||||
:username "user"
|
||||
:password "passwd"
|
||||
:realm "The Test Realm 1"
|
||||
:uri "/digest-auth/auth/user/passwd"
|
||||
:method "GET"
|
||||
:expected-ha1 "00f848f943c9a05dd06c932a7334f120"
|
||||
:expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863"
|
||||
:expected-response "b8a48cdc9aa9e514509a5a5c53d4e8cf")
|
||||
(list :nonce "servernonce"
|
||||
:username "user"
|
||||
:password "passwd"
|
||||
:realm "The Test Realm 2"
|
||||
:uri "/digest-auth/auth/user/passwd"
|
||||
:method "GET"
|
||||
:expected-ha1 "74d6abd3651d6b8260733d8a4c37ec1a"
|
||||
:expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863"
|
||||
:expected-response "0d84884d967e04440efc77e9e2b5b561")))
|
||||
|
||||
(ert-deftest url-auth-test-digest-create-key ()
|
||||
"Check user credentials in their hashed form."
|
||||
(dolist (challenge url-auth-test-challenges)
|
||||
(let ((key (url-digest-auth-create-key (plist-get challenge :username)
|
||||
(plist-get challenge :password)
|
||||
(plist-get challenge :realm)
|
||||
(plist-get challenge :method)
|
||||
(plist-get challenge :uri))))
|
||||
(should (= (length key) 2))
|
||||
(should (string= (nth 0 key) (plist-get challenge :expected-ha1)))
|
||||
(should (string= (nth 1 key) (plist-get challenge :expected-ha2)))
|
||||
)))
|
||||
|
||||
(ert-deftest url-auth-test-digest-auth-retrieve-cache ()
|
||||
"Check how the entry point retrieves cached authentication.
|
||||
Essential is how realms and paths are matched."
|
||||
|
||||
(let* ((url-digest-auth-storage
|
||||
'(("example.org:80"
|
||||
("/path/auth1" "auth1user" "key")
|
||||
("/path" "pathuser" "key")
|
||||
("/" "rootuser" "key")
|
||||
("realm1" "realm1user" "key")
|
||||
("realm2" "realm2user" "key")
|
||||
("/path/auth2" "auth2user" "key"))
|
||||
("example.org:443"
|
||||
("realm" "secure_user" "key"))
|
||||
("rootless.org:80" ; no "/" entry for this on purpose
|
||||
("/path" "pathuser" "key")
|
||||
("realm" "realmuser" "key"))))
|
||||
(attrs (list (cons "nonce" "servernonce")))
|
||||
auth)
|
||||
|
||||
(dolist (row (list
|
||||
;; If :expected-user is `nil' it indicates
|
||||
;; authentication information shouldn't be found.
|
||||
|
||||
;; non-existent server
|
||||
(list :url "http://other.com/path" :realm nil :expected-user nil)
|
||||
|
||||
;; unmatched port
|
||||
(list :url "http://example.org:444/path" :realm nil :expected-user
|
||||
il)
|
||||
|
||||
;; root, no realm
|
||||
(list :url "http://example.org/"
|
||||
:realm nil :expected-user "rootuser")
|
||||
|
||||
;; root, no realm, explicit port
|
||||
(list :url "http://example.org:80/"
|
||||
:realm nil :expected-user "rootuser")
|
||||
|
||||
(list :url "http://example.org/unknown"
|
||||
:realm nil :expected-user "rootuser")
|
||||
|
||||
;; realm specified, overrides any path
|
||||
(list :url "http://example.org/"
|
||||
:realm "realm1" :expected-user "realm1user")
|
||||
|
||||
;; realm specified, overrides any path
|
||||
(list :url "http://example.org/"
|
||||
:realm "realm2" :expected-user "realm2user")
|
||||
|
||||
;; authentication determined by path
|
||||
(list :url "http://example.org/path/auth1/query"
|
||||
:realm nil :expected-user "auth1user")
|
||||
|
||||
;; /path shadows /path/auth2, hence pathuser is expected
|
||||
(list :url "http://example.org/path/auth2/query"
|
||||
:realm nil :expected-user "pathuser")
|
||||
|
||||
(list :url "https://example.org/path"
|
||||
:realm nil :expected-user "secure_user")
|
||||
|
||||
;; not really secure user but using the same port
|
||||
(list :url "http://example.org:443/path"
|
||||
:realm nil :expected-user "secure_user")
|
||||
|
||||
;; preferring realm user over path, even though no
|
||||
;; realm specified (not sure why)
|
||||
(list :url "http://rootless.org/"
|
||||
:realm nil :expected-user "realmuser")
|
||||
;; second variant for the same case
|
||||
(list :url "http://rootless.org/unknown/path"
|
||||
:realm nil :expected-user "realmuser")
|
||||
|
||||
;; path match
|
||||
(list :url "http://rootless.org/path/query?q=a"
|
||||
:realm nil :expected-user "pathuser")
|
||||
|
||||
;; path match, realm match, prefer realm
|
||||
(list :url "http://rootless.org/path/query?q=a"
|
||||
:realm "realm" :expected-user "realmuser")
|
||||
))
|
||||
(setq auth (url-digest-auth (plist-get row :url)
|
||||
nil nil
|
||||
(plist-get row :realm) attrs))
|
||||
(if (plist-get row :expected-user)
|
||||
(progn (should auth)
|
||||
(should (string-match ".*username=\"\\(.*?\\)\".*" auth))
|
||||
(should (string= (match-string 1 auth)
|
||||
(plist-get row :expected-user))))
|
||||
(should-not auth)))))
|
||||
|
||||
(ert-deftest url-auth-test-digest-auth ()
|
||||
"Check common authorization string contents.
|
||||
Challenges with qop are not checked for response since a unique
|
||||
cnonce is used for generating them which is not mocked by the
|
||||
test and cannot be passed by arguments to `url-digest-auth'."
|
||||
(dolist (challenge url-auth-test-challenges)
|
||||
(let* ((attrs (append
|
||||
(list (cons "nonce" (plist-get challenge :nonce)))
|
||||
(if (plist-get challenge :qop)
|
||||
(list (cons "qop" (plist-get challenge :qop))))))
|
||||
(url (concat "http://example.org" (plist-get challenge :uri)))
|
||||
url-digest-auth-storage
|
||||
auth)
|
||||
;; Add authentication info to cache so `url-digest-auth' can
|
||||
;; complete without prompting minibuffer input.
|
||||
(setq url-digest-auth-storage
|
||||
(list
|
||||
(list "example.org:80"
|
||||
(cons (or (plist-get challenge :realm) "/")
|
||||
(cons (plist-get challenge :username)
|
||||
(url-digest-auth-create-key (plist-get challenge :username)
|
||||
(plist-get challenge :password)
|
||||
(plist-get challenge :realm)
|
||||
(plist-get challenge :method)
|
||||
(plist-get challenge :uri)))))))
|
||||
(setq auth (url-digest-auth (url-generic-parse-url url) nil nil
|
||||
(plist-get challenge :realm) attrs))
|
||||
(should auth)
|
||||
(should (string-prefix-p "Digest " auth))
|
||||
(should (string-match ".*username=\"\\(.*?\\)\".*" auth))
|
||||
(should (string= (match-string 1 auth)
|
||||
(plist-get challenge :username)))
|
||||
(should (string-match ".*realm=\"\\(.*?\\)\".*" auth))
|
||||
(should (string= (match-string 1 auth)
|
||||
(plist-get challenge :realm)))
|
||||
|
||||
(if (plist-member challenge :qop)
|
||||
(progn
|
||||
;; We don't know these, just check that they exists.
|
||||
(should (string-match-p ".*response=\".*?\".*" auth))
|
||||
(should (string-match-p ".*nc=\".*?\".*" auth))
|
||||
(should (string-match-p ".*cnonce=\".*?\".*" auth)))
|
||||
(should (string-match ".*response=\"\\(.*?\\)\".*" auth))
|
||||
(should (string= (match-string 1 auth)
|
||||
(plist-get challenge :expected-response))))
|
||||
)))
|
||||
|
||||
(ert-deftest url-auth-test-digest-auth-opaque ()
|
||||
"Check that `opaque' value is added to result when presented by
|
||||
the server."
|
||||
(let* ((url-digest-auth-storage
|
||||
'(("example.org:80" ("/" "user" "key"))))
|
||||
(attrs (list (cons "nonce" "anynonce")))
|
||||
auth)
|
||||
;; Get authentication info from cache without `opaque'.
|
||||
(setq auth (url-digest-auth "http://example.org/path" nil nil nil attrs))
|
||||
(should auth)
|
||||
(should-not (string-match-p "opaque=" auth))
|
||||
|
||||
;; Add `opaque' to attributes.
|
||||
(push (cons "opaque" "opaque-value") attrs)
|
||||
(setq auth (url-digest-auth "http://example.org/path" nil nil nil attrs))
|
||||
(should auth)
|
||||
(should (string-match ".*opaque=\"\\(.*?\\)\".*" auth))
|
||||
(should (string= (match-string 1 auth) "opaque-value"))))
|
||||
|
||||
(provide 'url-auth-tests)
|
||||
;;; url-auth-tests.el ends here
|
||||
Loading…
Add table
Reference in a new issue