[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 1/2] Refactor digest authentication in url-auth
|
From: |
Jarno Malmari |
|
Subject: |
[PATCH 1/2] Refactor digest authentication in url-auth |
|
Date: |
Tue, 14 Feb 2017 23:12:56 +0200 |
Additionally, this refactoring fixed a bug where duplicate key entries
were continuously added in `url-digest-auth-storage' each time
authenticated.
* lisp/url/url-auth.el (url-digest-auth, url-digest-auth-create-key):
(url-digest-auth-build-response, url-digest-auth-directory-id-assoc):
(url-digest-auth-name-value-string, url-digest-auth-source-creds):
(url-digest-cached-key, url-digest-cache-key, url-digest-find-creds):
(url-digest-find-new-key, url-digest-prompt-creds): Add new functions
to simplify code and aid in unit testing.
* test/lisp/url/url-auth-tests.el (url-auth-test-colonjoin):
(url-auth-test-digest-ha1, url-auth-test-digest-ha2):
(url-auth-test-digest-request-digest): Add a few tests as now more
features are testable via intermediate functions.
---
lisp/url/url-auth.el | 344 ++++++++++++++++++++++++++++------------
test/lisp/url/url-auth-tests.el | 35 ++++
2 files changed, 279 insertions(+), 100 deletions(-)
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 7b6cdd5..6512e12 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -143,107 +143,251 @@ url-digest-auth-storage
keyed by the server name. The cdr of this is an assoc list based
on the \"directory\" specified by the url we are looking up.")
+(defsubst url-digest-auth-colonjoin (&rest args)
+ "Concatenate ARGS as strings with colon as a separator."
+ (mapconcat 'identity args ":"))
+
+(defsubst url-digest-auth-kd (data secret)
+ "Apply digest algorithm to DATA using SECRET and return the result."
+ (md5 (url-digest-auth-colonjoin secret data)))
+
+(defsubst url-digest-auth-make-ha1 (user realm password)
+ "Compute checksum out of strings USER, REALM, and PASSWORD."
+ (md5 (url-digest-auth-colonjoin user realm password)))
+
+(defsubst url-digest-auth-make-ha2 (method digest-uri)
+ "Compute checksum out of strings METHOD and DIGEST-URI."
+ (md5 (url-digest-auth-colonjoin method digest-uri)))
+
+(defsubst url-digest-auth-make-request-digest (ha1 ha2 nonce)
+ "Construct the request-digest from hash strings HA1, HA2, and NONCE.
+This is the value that server receives as a proof that user knows
+a password."
+ (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
+
+(defsubst url-digest-auth-directory-id (url realm)
+ "Make an identifier for selecting a key in key cache.
+The identifier is made either from URL or REALM. It represents a
+protection space within a server so that one server can have
+multiple authorizations."
+ (or realm (or (url-file-directory (url-filename url)) "/")))
+
+(defsubst url-digest-auth-server-id (url)
+ "Make an identifier for selecting a server in key cache.
+The identifier is made from URL's host and port. Together with
+`url-digest-auth-directory-id' these identify a single key in the
+key cache `url-digest-auth-storage'."
+ (format "%s:%d" (url-host url) (url-port url)))
+
+(defun url-digest-auth-name-value-string (pairs)
+ "Concatenate name-value pairs in association list PAIRS.
+
+Output is formatted as \"name1=\\\"value1\\\", name2=\\\"value2\\\", ...\""
+ (mapconcat (lambda (pair)
+ (format "%s=\"%s\""
+ (symbol-name (car pair))
+ (cdr pair)))
+ pairs ", "))
+
+(defun url-digest-auth-source-creds (url)
+ "Find credentials for URL object from the Emacs auth-source.
+Return value is a plist that has `:user' and `:secret' properties
+if credentials were found. Otherwise nil."
+ (let ((server (url-digest-auth-server-id url))
+ (type (url-type url)))
+ (list :user (url-do-auth-source-search server type :user)
+ :secret (url-do-auth-source-search server type :secret))))
+
+(defun url-digest-prompt-creds (url realm &optional creds)
+ "Prompt credentials for URL and REALM, defaulting to CREDS.
+CREDS is a plist that may have properties `:user' and `:secret'."
+ ;; Set explicitly in case creds were nil. This makes the second
+ ;; plist-put modify the same plist.
+ (setq creds
+ (plist-put creds :user
+ (read-string (url-auth-user-prompt url realm)
+ (or (plist-get creds :user)
+ (user-real-login-name)))))
+ (plist-put creds :secret
+ (read-passwd "Password: " nil (plist-get creds :secret))))
+
+(defun url-digest-auth-directory-id-assoc (dirkey keylist)
+ "Find the best match for DIRKEY in key alist KEYLIST.
+
+The string DIRKEY should be obtained using
+`url-digest-auth-directory-id'. The key list to search through
+is the alist KEYLIST where car of each element may match DIRKEY.
+If DIRKEY represents a realm, the list is searched only for an
+exact match. For directory names, an ancestor is sufficient for
+a match."
+ (or
+ ;; Check exact match first.
+ (assoc dirkey keylist)
+ ;; No exact match found. Continue to look for partial match if
+ ;; dirkey is not a realm.
+ (and (string-match "/" dirkey)
+ (let (match)
+ (while (and (null match) keylist)
+ (if (or
+ ;; Any realm candidate matches. Why?
+ (not (string-match "/" (caar keylist)))
+ ;; Parent directory matches.
+ (string-prefix-p (caar keylist) dirkey))
+ (setq match (car keylist))
+ (setq keylist (cdr keylist))))
+ match))))
+
+(defun url-digest-cached-key (url realm)
+ "Find best match for URL and REALM from `url-digest-auth-storage'.
+The return value is a list consisting of a realm (or a directory)
+a user name, and hashed authentication tokens HA1 and HA2.
+Modifying the contents of the returned list will modify the cache
+variable `url-digest-auth-storage' itself."
+ (url-digest-auth-directory-id-assoc
+ (url-digest-auth-directory-id url realm)
+ (cdr (assoc (url-digest-auth-server-id url) url-digest-auth-storage))))
+
+(defun url-digest-cache-key (key url)
+ "Add key to `url-digest-auth-storage'.
+KEY has the same format as returned by `url-digest-cached-key'.
+The key is added to cache hierarchy under server id, deduced from
+URL."
+ (let ((serverid (url-digest-auth-server-id url)))
+ (push (list serverid key) url-digest-auth-storage)))
+
(defun url-digest-auth-create-key (username password realm method uri)
- "Create a key for digest authentication method"
- (let* ((info (if (stringp uri)
- (url-generic-parse-url uri)
- uri))
- (a1 (md5 (concat username ":" realm ":" password)))
- (a2 (md5 (concat method ":" (url-filename info)))))
- (list a1 a2)))
-
-(defun url-digest-auth (url &optional prompt overwrite realm args)
- "Get the username/password for the specified URL.
-If optional argument PROMPT is non-nil, ask for the username/password
-to use for the URL and its descendants. If optional third argument
-OVERWRITE is non-nil, overwrite the old username/password pair if it
-is found in the assoc list. If REALM is specified, use that as the realm
-instead of hostname:portnum."
- (if args
- (let* ((href (if (stringp url)
- (url-generic-parse-url url)
- url))
- (server (url-host href))
- (type (url-type href))
- (port (url-port href))
- (file (url-filename href))
- (enable-recursive-minibuffers t)
- user pass byserv retval data)
- (setq file (cond
- (realm realm)
- ((string-match "/$" file) file)
- (t (url-file-directory file)))
- server (format "%s:%d" server port)
- byserv (cdr-safe (assoc server url-digest-auth-storage)))
- (cond
- ((and prompt (not byserv))
- (setq user (or
- (url-do-auth-source-search server type :user)
- (read-string (url-auth-user-prompt url realm)
- (user-real-login-name)))
- pass (or
- (url-do-auth-source-search server type :secret)
- (read-passwd "Password: "))
- url-digest-auth-storage
- (cons (list server
- (cons file
- (setq retval
- (cons user
- (url-digest-auth-create-key
- user pass realm
- (or url-request-method "GET")
- url)))))
- url-digest-auth-storage)))
- (byserv
- (setq retval (cdr-safe (assoc file byserv)))
- (if (and (not retval) ; no exact match, check directories
- (string-match "/" file)) ; not looking for a realm
- (while (and byserv (not retval))
- (setq data (car (car byserv)))
- (if (or (not (string-match "/" data))
- (and
- (>= (length file) (length data))
- (string= data (substring file 0 (length data)))))
- (setq retval (cdr (car byserv))))
- (setq byserv (cdr byserv))))
- (if overwrite
- (if (and (not retval) prompt)
- (setq user (or
- (url-do-auth-source-search server type :user)
- (read-string (url-auth-user-prompt url realm)
- (user-real-login-name)))
- pass (or
- (url-do-auth-source-search server type :secret)
- (read-passwd "Password: "))
- retval (setq retval
- (cons user
- (url-digest-auth-create-key
- user pass realm
- (or url-request-method "GET")
- url)))
- byserv (assoc server url-digest-auth-storage))
- (setcdr byserv
- (cons (cons file retval) (cdr byserv))))))
- (t (setq retval nil)))
- (if retval
- (if (cdr-safe (assoc "opaque" args))
- (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
- (opaque (cdr-safe (assoc "opaque" args))))
- (format
- (concat "Digest username=\"%s\", realm=\"%s\","
- "nonce=\"%s\", uri=\"%s\","
- "response=\"%s\", opaque=\"%s\"")
- (nth 0 retval) realm nonce (url-filename href)
- (md5 (concat (nth 1 retval) ":" nonce ":"
- (nth 2 retval))) opaque))
- (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")))
- (format
- (concat "Digest username=\"%s\", realm=\"%s\","
- "nonce=\"%s\", uri=\"%s\","
- "response=\"%s\"")
- (nth 0 retval) realm nonce (url-filename href)
- (md5 (concat (nth 1 retval) ":" nonce ":"
- (nth 2 retval))))))))))
+ "Create a key for digest authentication method.
+The USERNAME and PASSWORD are the credentials for REALM and are
+used in making a hashed value named HA1. The HTTP METHOD and URI
+makes a second hashed value HA2. These hashes are used in making
+the authentication key that can be stored without saving the
+password in plain text. The return value is a list (HA1 HA2).
+
+For backward compatibility, URI is allowed to be a URL cl-struct
+object."
+ (and username password realm
+ (list (url-digest-auth-make-ha1 username realm password)
+ (url-digest-auth-make-ha2 method (cond ((stringp uri) uri)
+ (t (url-filename uri)))))))
+
+(defun url-digest-auth-build-response (key url realm attrs)
+ "Compute authorization string for the given challenge using KEY.
+
+The strings looks like 'Digest username=\"John\", realm=\"The
+Realm\", ...'
+
+Part of the challenge is already solved in a pre-computed KEY
+which is list of a realm (or a directory), user name, and hash
+tokens HA1 and HA2.
+
+Some fields are filled as is from the given URL, REALM, and
+using the contents of alist ATTRS.
+
+ATTRS is expected to contain at least the server's \"nonce\"
+value. It also might contain the optional \"opaque\" value."
+ (when key
+ (let ((user (nth 1 key))
+ (ha1 (nth 2 key))
+ (ha2 (nth 3 key))
+ (digest-uri (url-filename url))
+ (nonce (cdr-safe (assoc "nonce" attrs)))
+ (opaque (cdr-safe (assoc "opaque" attrs))))
+
+ (concat
+ "Digest "
+ (url-digest-auth-name-value-string
+ (append (list (cons 'username user)
+ (cons 'realm realm)
+ (cons 'nonce nonce)
+ (cons 'uri digest-uri)
+ (cons 'response (url-digest-auth-make-request-digest
+ ha1 ha2 nonce)))
+
+ (if opaque (list (cons 'opaque opaque)))))))))
+
+(defun url-digest-find-creds (url prompt &optional realm)
+ "Find or ask credentials for URL.
+
+Primary method for finding credentials is from Emacs auth-source.
+If password isn't found, and PROMPT is non-nil, query credentials
+via minibuffer. Optional REALM may be used when prompting as a
+hint to the user.
+
+Return value is nil in case either user name or password wasn't
+found. Otherwise, it's a plist containing `:user' and `:secret'.
+Additional `:source' property denotes the origin of the
+credentials and its value can be either symbol `authsource' or
+`interactive'."
+ (let ((creds (url-digest-auth-source-creds url)))
+
+ ;; If credentials weren't found and prompting is allowed, prompt
+ ;; the user.
+ (if (and prompt
+ (or (null creds)
+ (null (plist-get creds :secret))))
+ (progn
+ (setq creds (url-digest-prompt-creds url realm creds))
+ (plist-put creds :source 'interactive))
+ (plist-put creds :source 'authsource))
+
+ (and (plist-get creds :user)
+ (plist-get creds :secret)
+ creds)))
+
+(defun url-digest-find-new-key (url realm prompt)
+ "Find new key either from auth-source or interactively.
+The key is looked for based on URL and REALM. If PROMPT is
+non-nil, ask interactively in case credentials weren't found from
+auth-source."
+ (let (creds)
+ (unwind-protect
+ (if (setq creds (url-digest-find-creds url prompt realm))
+ (cons (url-digest-auth-directory-id url realm)
+ (cons (plist-get creds :user)
+ (url-digest-auth-create-key
+ (plist-get creds :user)
+ (plist-get creds :secret)
+ realm
+ (or url-request-method "GET")
+ (url-filename url)))))
+ (if (and creds
+ ;; Don't clear secret for `authsource' since it will
+ ;; corrupt any future fetches for it.
+ (not (eq (plist-get creds :source) 'authsource)))
+ (clear-string (plist-get creds :secret))))))
+
+(defun url-digest-auth (url &optional prompt overwrite realm attrs)
+ "Get the HTTP Digest response string for the specified URL.
+
+If optional argument PROMPT is non-nil, ask for the username and
+password to use for the URL and its descendants but only if one
+cannot be found from cache. Look also in Emacs auth-source.
+
+If optional third argument OVERWRITE is non-nil, overwrite the
+old credentials, if they're found in cache, with new ones from
+user prompt or from Emacs auth-source.
+
+If REALM is specified, use that instead of the URL descendant
+method to match cached credentials.
+
+Alist ATTRS contains additional attributes for the authentication
+challenge such as nonce and opaque."
+ (if attrs
+ (let* ((href (if (stringp url) (url-generic-parse-url url) url))
+ (enable-recursive-minibuffers t)
+ (key (url-digest-cached-key href realm)))
+
+ (if (or (null key) overwrite)
+ (let ((newkey (url-digest-find-new-key href realm (cond
+ (key nil)
+ (t prompt)))))
+ (if (and newkey key overwrite)
+ (setcdr key (cdr newkey))
+ (if (and newkey (null key))
+ (url-digest-cache-key (setq key newkey) href)))))
+
+ (if key
+ (url-digest-auth-build-response key href realm attrs)))))
(defvar url-registered-auth-schemes nil
"A list of the registered authorization schemes and various and sundry
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index 11e5a47..a6b31d7 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -77,6 +77,41 @@ url-auth-test-challenges
:expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863"
:expected-response "0d84884d967e04440efc77e9e2b5b561")))
+(ert-deftest url-auth-test-colonjoin ()
+ "Check joining strings with `:'."
+ (should (string= (url-digest-auth-colonjoin) ""))
+ (should (string= (url-digest-auth-colonjoin nil) ""))
+ (should (string= (url-digest-auth-colonjoin nil nil nil) "::"))
+ (should (string= (url-digest-auth-colonjoin "") ""))
+ (should (string= (url-digest-auth-colonjoin "" "") ":"))
+ (should (string= (url-digest-auth-colonjoin "one") "one"))
+ (should (string= (url-digest-auth-colonjoin "one" "two" "three")
"one:two:three")))
+
+(ert-deftest url-auth-test-digest-ha1 ()
+ "Check HA1 computation."
+ (dolist (row url-auth-test-challenges)
+ (should (string= (url-digest-auth-make-ha1 (plist-get row :username)
+ (plist-get row :realm)
+ (plist-get row :password))
+ (plist-get row :expected-ha1)
+ ))))
+
+(ert-deftest url-auth-test-digest-ha2 ()
+ "Check HA2 computation."
+ (dolist (row url-auth-test-challenges)
+ (should (string= (url-digest-auth-make-ha2 (plist-get row :method)
+ (plist-get row :uri))
+ (plist-get row :expected-ha2)))))
+
+(ert-deftest url-auth-test-digest-request-digest ()
+ "Check digest response value when not supporting `qop'."
+ (dolist (row url-auth-test-challenges)
+ (should (string= (url-digest-auth-make-request-digest
+ (plist-get row :expected-ha1)
+ (plist-get row :expected-ha2)
+ (plist-get row :nonce))
+ (plist-get row :expected-response)))))
+
(ert-deftest url-auth-test-digest-create-key ()
"Check user credentials in their hashed form."
(dolist (challenge url-auth-test-challenges)
--
2.7.0.25.gfc10eb5