url-digest-auth QOP implementation

url-digest-auth QOP implementation

[Jarno Malmari]

Greetings.

I've partially implemented the qop=auth in HTTP Digest Authentication
(RFC 2617) for the Emac Url package.

Change was motivated by running into servers that had dropped backward
compatibility for qop-less clients.

In order to implement the qop=auth I needed to refactor the old
url-digest-auth* functions. I added some tests to check I don't break
too much of the old functionality.

Git summarizes the change as follows:
lisp/url/url-auth.el             | 391
++++++++++++++++++++++++++++++++++++++++++++++++-----------------
test/automated/url-auth-tests.el | 293
++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 582 insertions(+), 102 deletions(-)

If we were to get these changes in, to who should I send the patches for
a review?

Other ideas and concerns are welcome also, of course.

Thanks

-- 
Jarno Malmari

Re: url-digest-auth QOP implementation

[Lars Magne Ingebrigtsen]

Jarno Malmari <jarno@malmari.fi> writes:

> I've partially implemented the qop=auth in HTTP Digest Authentication
> (RFC 2617) for the Emac Url package.
>
> Change was motivated by running into servers that had dropped backward
> compatibility for qop-less clients.
>
> In order to implement the qop=auth I needed to refactor the old
> url-digest-auth* functions. I added some tests to check I don't break
> too much of the old functionality.

Sounds good.

> If we were to get these changes in, to who should I send the patches for
> a review?

Just post the patches here, or file a bug report and append the patches
to the report.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Patches for qop=auth implementation for url-digest-auth

[Jarno Malmari]

I am not sure how common it is to have no backward compatibility for qop-less clients, as that is, afaik, against the standard RFC 2617. My use case and motivation for testing this is based on Gerrit servers that gave Forbidden with the old qop-less implementation, and with these patches, I can authenticate successfully.

There are three patches. First, tests were created to have some stable playground to do refactoring on url-digest-auth. As new functions were added, more tests were added. Finally, implement qop=auth (with limitations, as described in the commit message).

The potential risk of applying the third patch (the actual qop implementation) is that once the 'url' client reports that it supports qop, it should do it properly. If not, some servers that previously cooperated may stop to do so. Those are the servers where the backward compatibility is working ok, i.e. they are fine with clients not reporting back the "qop" field in Authorization header.

[PATCH 1/3] Test for url-auth

[Jarno Malmari]

So far not testing PROMPT and OVERWRITE arguments which would require
faking interactive minibuffer input.
---
 test/automated/url-auth-tests.el | 223 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 223 insertions(+)
 create mode 100644 test/automated/url-auth-tests.el

diff --git a/test/automated/url-auth-tests.el b/test/automated/url-auth-tests.el
new file mode 100644
index 0000000..715308c
--- /dev/null
+++ b/test/automated/url-auth-tests.el
@@ -0,0 +1,223 @@
+;;; 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 :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 nil)
+
+                  ;; 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."
+  (dolist (challenge url-auth-test-challenges)
+    (let* ((attrs (list (cons "nonce" (plist-get challenge :nonce))))
+           (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 ".*response=\"\\(.*?\\)\".*" auth))
+      (should (string= (match-string 1 auth)
+                       (plist-get challenge :expected-response)))
+      (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)))
+      )))
+
+(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
-- 
2.1.0.GIT

[PATCH 2/3] Refactor digest authentication in url-auth

[Jarno Malmari]

Add a few tests as now more features are testable via intermediate
functions.

Additionally, this refactoring fixed a bug where duplicate key entries
were continously added in `url-digest-auth-storage' each time
authenticated.
---
 lisp/url/url-auth.el             | 340 +++++++++++++++++++++++++++------------
 test/automated/url-auth-tests.el |  36 +++++
 2 files changed, 276 insertions(+), 100 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 58bf45b..17c98af 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -140,107 +140,247 @@ Its value is an assoc list of assoc lists.  The first assoc list is
 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 MD5 to DATA using SECRET as described in RFC 2617."
+  (md5 (url-digest-auth-colonjoin secret data)))
+
+(defsubst url-digest-auth-make-ha1 (user realm password)
+  "Compute hashed A1 value as described in RFC 2617.
+USER, REALM, and PASSWORD are strings used to create the hash
+from."
+  (md5 (url-digest-auth-colonjoin user realm password)))
+
+(defsubst url-digest-auth-make-ha2 (method digest-uri)
+  "Compute hashed A2 value as described in RFC 2617.
+METHOD and DIGEST-URI are strings used to create the hash from."
+  (md5 (url-digest-auth-colonjoin method digest-uri)))
+
+(defsubst url-digest-auth-make-request-digest (ha1 ha2 nonce)
+  "Construct the request-digest without qop as described in RFC 2617.
+Inputs for this are the hash strings HA1, HA2, and NONCE."
+  (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
+
+(defsubst url-digest-auth-directory-id (url realm)
+  "Make an identifier to use for server keys.
+The identifier is made either from URL's path or REALM."
+  (or realm (or (url-file-directory (url-filename url)) "/")))
+
+(defsubst url-digest-auth-server-id (url)
+  "Make an identifier to user for selecting servers in key cache.
+The identifier is made from URL's host and port."
+  (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 in key list using a path or a realm.
+
+The string DIRKEY is either a path or a realm.  The key list to
+search through is the alist KEYLIST where car of each element is
+either a path or a realm.  Realms are searched for an exact
+match.  For paths, an ancestor is sufficient for a match."
+  (or
+   ;; check exact match first, realm or path
+   (assoc dirkey keylist)
+   ;; no partial matches for non-path, i.e. 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,
+defined in RFC 2617. Modifying the contents of the returned list
+will modify the cache variable `url-digest-auth-storage' itself."
+  (let ((serverid (url-digest-auth-server-id url))
+        (dirid (url-digest-auth-directory-id url realm)))
+    (url-digest-auth-directory-id-assoc
+     dirid (cdr (assoc serverid 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 consisting of
+hashed authentication tokens HA1 and HA2, defined in RFC 2617.
+
+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 name1=\"value1\",
+name2=\"value2\", ...'
+
+Part of the challenge is already solved in a pre-computed KEY
+which is list of realm (or directory), user name, HA1 and HA2
+values (see RFC 2617).
+
+Some fields are filled with the given object URL, string REALM,
+and 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, allow to 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 incomplete and prompt 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/automated/url-auth-tests.el b/test/automated/url-auth-tests.el
index 715308c..462d5f2 100644
--- a/test/automated/url-auth-tests.el
+++ b/test/automated/url-auth-tests.el
@@ -63,6 +63,42 @@ server's WWW-Authenticate header field.")
              :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
+                      ;; HA1 and HA2 already tested
+                      (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.1.0.GIT

[PATCH 3/3] Initial implementation for HTTP Digest qop for url

[Jarno Malmari]

Some servers have dropped backward compatibility with HTTP Digest
Authentication without "qop". The Quality of protection scheme is
partially implemented:
* only one supported qop, qop=auth
* only one supported algorithm, algorithm=md5
* nonce count remains always as 1, no replays
---
 lisp/url/url-auth.el             | 59 +++++++++++++++++++++++++++++++++++----
 test/automated/url-auth-tests.el | 60 +++++++++++++++++++++++++++++++---------
 2 files changed, 100 insertions(+), 19 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 17c98af..f01c93b 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -128,8 +128,8 @@ instead of the filename inheritance method."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Digest authorization code
 ;;; ------------------------
-;;; This implements the DIGEST authorization type.  See the internet draft
-;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; This implements the DIGEST authorization type.  See RFC 2617
+;;; https://www.ietf.org/rfc/rfc2617.txt
 ;;; for the complete documentation on this type.
 ;;;
 ;;; This is very secure
@@ -164,6 +164,15 @@ METHOD and DIGEST-URI are strings used to create the hash from."
 Inputs for this are the hash strings HA1, HA2, and NONCE."
   (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
 
+(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
+  "Construct the request-digest with qop as described in RFC 2617.
+QOP describes the \"quality of protection\" and algorithm to use.
+HA1, HA2, and NONCE, NC, and CNONCE are string values, described
+in RFC 2617. It's worth noting that HA2 already depends on value
+of QOP."
+  (url-digest-auth-kd (url-digest-auth-colonjoin
+                       nonce nc cnonce qop ha2) ha1))
+
 (defsubst url-digest-auth-directory-id (url realm)
   "Make an identifier to use for server keys.
 The identifier is made either from URL's path or REALM."
@@ -174,6 +183,21 @@ The identifier is made either from URL's path or REALM."
 The identifier is made from URL's host and port."
   (format "%s:%d" (url-host url) (url-port url)))
 
+(defun url-digest-auth-make-cnonce ()
+  "Compute a new unique client nonce value."
+  (base64-encode-string
+   (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
+
+(defun url-digest-auth-nonce-count (nonce)
+  "The number requests sent to server with the given NONCE.
+This count includes the request we're preparing here.
+
+Currently, this is not implemented and will always return 1.
+
+Value returned is in string format with leading zeroes, such as
+\"00000001\"."
+  (format "%08x" 1))
+
 (defun url-digest-auth-name-value-string (pairs)
   "Concatenate name-value pairs in association list PAIRS.
 
@@ -278,12 +302,20 @@ Some fields are filled with the given object URL, string REALM,
 and contents of alist ATTRS.
 
 ATTRS is expected to contain at least the server's \"nonce\"
-value.  It also might contain the optional \"opaque\" value."
+value.  It also might contain the optional \"opaque\" value.
+Newer implementations conforming to RFC 2617 should also contain
+qop (Quality Of Protection) and related attributes.
+
+Restrictions on Quality of Protection scheme: The qop value
+\"auth-int\" or algorithm any other than \"MD5\" are not
+implemented."
+
   (when key
     (let ((user (nth 1 key))
           (ha1 (nth 2 key))
           (ha2 (nth 3 key))
           (digest-uri (url-filename url))
+          (qop (cdr-safe (assoc "qop" attrs)))
           (nonce (cdr-safe (assoc "nonce" attrs)))
           (opaque (cdr-safe (assoc "opaque" attrs))))
 
@@ -293,9 +325,24 @@ value.  It also might contain the optional \"opaque\" value."
         (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)))
+                      (cons 'uri digest-uri))
+
+                (cond
+                 ((null qop)
+                  (list (cons 'response (url-digest-auth-make-request-digest
+                                         ha1 ha2 nonce))))
+                 ((string= qop "auth")
+                  (let ((nc (url-digest-auth-nonce-count nonce))
+                        (cnonce (url-digest-auth-make-cnonce)))
+                    (list (cons 'qop qop)
+                          (cons 'nc nc)
+                          (cons 'cnonce cnonce)
+                          (cons 'response
+                                (url-digest-auth-make-request-digest-qop
+                                 qop ha1 ha2 nonce nc cnonce)))))
+                 (t (message "Quality of protection \"%s\" is not implemented." qop)
+                    nil))
+
 
                 (if opaque (list (cons 'opaque opaque)))))))))
 
diff --git a/test/automated/url-auth-tests.el b/test/automated/url-auth-tests.el
index 462d5f2..a956ad9 100644
--- a/test/automated/url-auth-tests.el
+++ b/test/automated/url-auth-tests.el
@@ -34,6 +34,18 @@ 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"
@@ -90,14 +102,23 @@ server's WWW-Authenticate header field.")
                      (plist-get row :expected-ha2)))))
 
 (ert-deftest url-auth-test-digest-request-digest ()
-  "Check digest response value when not supporting `qop'."
+  "Check digest response value."
   (dolist (row url-auth-test-challenges)
-    (should (string= (url-digest-auth-make-request-digest
-                      ;; HA1 and HA2 already tested
-                      (plist-get row :expected-ha1)
-                      (plist-get row :expected-ha2)
-                      (plist-get row :nonce))
-                     (plist-get row :expected-response)))))
+    (should (string= (plist-get row :expected-response)
+                     (if (plist-member row :qop)
+                         (url-digest-auth-make-request-digest-qop
+                          (plist-get row :qop)
+                          ;; HA1 and HA2 already tested
+                          (plist-get row :expected-ha1)
+                          (plist-get row :expected-ha2)
+                          (plist-get row :nonce)
+                          (plist-get row :nc)
+                          (plist-get row :cnonce))
+                       (url-digest-auth-make-request-digest
+                        ;; HA1 and HA2 already tested
+                        (plist-get row :expected-ha1)
+                        (plist-get row :expected-ha2)
+                        (plist-get row :nonce)))))))
 
 (ert-deftest url-auth-test-digest-create-key ()
   "Check user credentials in their hashed form."
@@ -203,9 +224,15 @@ Essential is how realms and paths are matched."
         (should-not auth)))))
 
 (ert-deftest url-auth-test-digest-auth ()
-  "Check common authorization string contents."
+  "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 (list (cons "nonce" (plist-get challenge :nonce))))
+    (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)
@@ -225,16 +252,23 @@ Essential is how realms and paths are matched."
                                   (plist-get challenge :realm) attrs))
       (should auth)
       (should (string-prefix-p "Digest " auth))
-      (should (string-match ".*response=\"\\(.*?\\)\".*" auth))
-      (should (string= (match-string 1 auth)
-                       (plist-get challenge :expected-response)))
       (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
-- 
2.1.0.GIT

Re: Patches for qop=auth implementation for url-digest-auth

[Lars Magne Ingebrigtsen]

Jarno Malmari <jarno@malmari.fi> writes:

> I am not sure how common it is to have no backward compatibility for
> qop-less clients, as that is, afaik, against the standard RFC 2617. My
> use case and motivation for testing this is based on Gerrit servers
> that gave Forbidden with the old qop-less implementation, and with
> these patches, I can authenticate successfully.

I'm not familiar with the digest authentication stuff at all, but surely
having support for qop is better than not having support for qop.  :-)

The code looks fine to me.  Do you have FSF copyright assignment papers
on file?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Re: Patches for qop=auth implementation for url-digest-auth

[Jarno Malmari]

> The code looks fine to me.  Do you have FSF copyright assignment papers
> on file?
> 

Thanks for checking!

I haven't taken any steps towards providing the papers. I'm currently
checking how this all works.

Re: Patches for qop=auth implementation for url-digest-auth

[Jarno Malmari]

On Mon, 18 May 2015, at 18:47, Lars Magne Ingebrigtsen wrote:
> The code looks fine to me.  Do you have FSF copyright assignment papers
> on file?
 
Took a while but now I do.

I rebased to latest master. No conflicts and tests pass ok.

Re: Patches for qop=auth implementation for url-digest-auth

[Lars Magne Ingebrigtsen]

Jarno Malmari <jarno@malmari.fi> writes:

> Took a while but now I do.
>
> I rebased to latest master. No conflicts and tests pass ok.

Cool.  Can you repost the patches?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

[PATCH 1/3] Test for url-auth

[Jarno Malmari]

So far not testing PROMPT and OVERWRITE arguments which would require
faking interactive minibuffer input.
---
 test/automated/url-auth-tests.el | 223 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 223 insertions(+)
 create mode 100644 test/automated/url-auth-tests.el

diff --git a/test/automated/url-auth-tests.el b/test/automated/url-auth-tests.el
new file mode 100644
index 0000000..715308c
--- /dev/null
+++ b/test/automated/url-auth-tests.el
@@ -0,0 +1,223 @@
+;;; 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 :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 nil)
+
+                  ;; 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."
+  (dolist (challenge url-auth-test-challenges)
+    (let* ((attrs (list (cons "nonce" (plist-get challenge :nonce))))
+           (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 ".*response=\"\\(.*?\\)\".*" auth))
+      (should (string= (match-string 1 auth)
+                       (plist-get challenge :expected-response)))
+      (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)))
+      )))
+
+(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
-- 
2.5.0.330.g130be8e

[PATCH 2/3] Refactor digest authentication in url-auth

[Jarno Malmari]

Add a few tests as now more features are testable via intermediate
functions.

Additionally, this refactoring fixed a bug where duplicate key entries
were continously added in `url-digest-auth-storage' each time
authenticated.
---
 lisp/url/url-auth.el             | 340 +++++++++++++++++++++++++++------------
 test/automated/url-auth-tests.el |  36 +++++
 2 files changed, 276 insertions(+), 100 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 64f56f0..23ee313 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -140,107 +140,247 @@ Its value is an assoc list of assoc lists.  The first assoc list is
 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 MD5 to DATA using SECRET as described in RFC 2617."
+  (md5 (url-digest-auth-colonjoin secret data)))
+
+(defsubst url-digest-auth-make-ha1 (user realm password)
+  "Compute hashed A1 value as described in RFC 2617.
+USER, REALM, and PASSWORD are strings used to create the hash
+from."
+  (md5 (url-digest-auth-colonjoin user realm password)))
+
+(defsubst url-digest-auth-make-ha2 (method digest-uri)
+  "Compute hashed A2 value as described in RFC 2617.
+METHOD and DIGEST-URI are strings used to create the hash from."
+  (md5 (url-digest-auth-colonjoin method digest-uri)))
+
+(defsubst url-digest-auth-make-request-digest (ha1 ha2 nonce)
+  "Construct the request-digest without qop as described in RFC 2617.
+Inputs for this are the hash strings HA1, HA2, and NONCE."
+  (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
+
+(defsubst url-digest-auth-directory-id (url realm)
+  "Make an identifier to use for server keys.
+The identifier is made either from URL's path or REALM."
+  (or realm (or (url-file-directory (url-filename url)) "/")))
+
+(defsubst url-digest-auth-server-id (url)
+  "Make an identifier to user for selecting servers in key cache.
+The identifier is made from URL's host and port."
+  (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 in key list using a path or a realm.
+
+The string DIRKEY is either a path or a realm.  The key list to
+search through is the alist KEYLIST where car of each element is
+either a path or a realm.  Realms are searched for an exact
+match.  For paths, an ancestor is sufficient for a match."
+  (or
+   ;; check exact match first, realm or path
+   (assoc dirkey keylist)
+   ;; no partial matches for non-path, i.e. 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,
+defined in RFC 2617. Modifying the contents of the returned list
+will modify the cache variable `url-digest-auth-storage' itself."
+  (let ((serverid (url-digest-auth-server-id url))
+        (dirid (url-digest-auth-directory-id url realm)))
+    (url-digest-auth-directory-id-assoc
+     dirid (cdr (assoc serverid 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 consisting of
+hashed authentication tokens HA1 and HA2, defined in RFC 2617.
+
+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 name1=\"value1\",
+name2=\"value2\", ...'
+
+Part of the challenge is already solved in a pre-computed KEY
+which is list of realm (or directory), user name, HA1 and HA2
+values (see RFC 2617).
+
+Some fields are filled with the given object URL, string REALM,
+and 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, allow to 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 incomplete and prompt 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/automated/url-auth-tests.el b/test/automated/url-auth-tests.el
index 715308c..462d5f2 100644
--- a/test/automated/url-auth-tests.el
+++ b/test/automated/url-auth-tests.el
@@ -63,6 +63,42 @@ server's WWW-Authenticate header field.")
              :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
+                      ;; HA1 and HA2 already tested
+                      (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.5.0.330.g130be8e

[PATCH 3/3] Initial implementation for HTTP Digest qop for url

[Jarno Malmari]

Some servers have dropped backward compatibility with HTTP Digest
Authentication without "qop". The Quality of protection scheme is
partially implemented:
* only one supported qop, qop=auth
* only one supported algorithm, algorithm=md5
* nonce count remains always as 1, no replays
---
 lisp/url/url-auth.el             | 59 +++++++++++++++++++++++++++++++++++----
 test/automated/url-auth-tests.el | 60 +++++++++++++++++++++++++++++++---------
 2 files changed, 100 insertions(+), 19 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 23ee313..d365e1a 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -128,8 +128,8 @@ instead of the filename inheritance method."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Digest authorization code
 ;;; ------------------------
-;;; This implements the DIGEST authorization type.  See the internet draft
-;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; This implements the DIGEST authorization type.  See RFC 2617
+;;; https://www.ietf.org/rfc/rfc2617.txt
 ;;; for the complete documentation on this type.
 ;;;
 ;;; This is very secure
@@ -164,6 +164,15 @@ METHOD and DIGEST-URI are strings used to create the hash from."
 Inputs for this are the hash strings HA1, HA2, and NONCE."
   (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
 
+(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
+  "Construct the request-digest with qop as described in RFC 2617.
+QOP describes the \"quality of protection\" and algorithm to use.
+HA1, HA2, and NONCE, NC, and CNONCE are string values, described
+in RFC 2617. It's worth noting that HA2 already depends on value
+of QOP."
+  (url-digest-auth-kd (url-digest-auth-colonjoin
+                       nonce nc cnonce qop ha2) ha1))
+
 (defsubst url-digest-auth-directory-id (url realm)
   "Make an identifier to use for server keys.
 The identifier is made either from URL's path or REALM."
@@ -174,6 +183,21 @@ The identifier is made either from URL's path or REALM."
 The identifier is made from URL's host and port."
   (format "%s:%d" (url-host url) (url-port url)))
 
+(defun url-digest-auth-make-cnonce ()
+  "Compute a new unique client nonce value."
+  (base64-encode-string
+   (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
+
+(defun url-digest-auth-nonce-count (nonce)
+  "The number requests sent to server with the given NONCE.
+This count includes the request we're preparing here.
+
+Currently, this is not implemented and will always return 1.
+
+Value returned is in string format with leading zeroes, such as
+\"00000001\"."
+  (format "%08x" 1))
+
 (defun url-digest-auth-name-value-string (pairs)
   "Concatenate name-value pairs in association list PAIRS.
 
@@ -278,12 +302,20 @@ Some fields are filled with the given object URL, string REALM,
 and contents of alist ATTRS.
 
 ATTRS is expected to contain at least the server's \"nonce\"
-value.  It also might contain the optional \"opaque\" value."
+value.  It also might contain the optional \"opaque\" value.
+Newer implementations conforming to RFC 2617 should also contain
+qop (Quality Of Protection) and related attributes.
+
+Restrictions on Quality of Protection scheme: The qop value
+\"auth-int\" or algorithm any other than \"MD5\" are not
+implemented."
+
   (when key
     (let ((user (nth 1 key))
           (ha1 (nth 2 key))
           (ha2 (nth 3 key))
           (digest-uri (url-filename url))
+          (qop (cdr-safe (assoc "qop" attrs)))
           (nonce (cdr-safe (assoc "nonce" attrs)))
           (opaque (cdr-safe (assoc "opaque" attrs))))
 
@@ -293,9 +325,24 @@ value.  It also might contain the optional \"opaque\" value."
         (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)))
+                      (cons 'uri digest-uri))
+
+                (cond
+                 ((null qop)
+                  (list (cons 'response (url-digest-auth-make-request-digest
+                                         ha1 ha2 nonce))))
+                 ((string= qop "auth")
+                  (let ((nc (url-digest-auth-nonce-count nonce))
+                        (cnonce (url-digest-auth-make-cnonce)))
+                    (list (cons 'qop qop)
+                          (cons 'nc nc)
+                          (cons 'cnonce cnonce)
+                          (cons 'response
+                                (url-digest-auth-make-request-digest-qop
+                                 qop ha1 ha2 nonce nc cnonce)))))
+                 (t (message "Quality of protection \"%s\" is not implemented." qop)
+                    nil))
+
 
                 (if opaque (list (cons 'opaque opaque)))))))))
 
diff --git a/test/automated/url-auth-tests.el b/test/automated/url-auth-tests.el
index 462d5f2..a956ad9 100644
--- a/test/automated/url-auth-tests.el
+++ b/test/automated/url-auth-tests.el
@@ -34,6 +34,18 @@ 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"
@@ -90,14 +102,23 @@ server's WWW-Authenticate header field.")
                      (plist-get row :expected-ha2)))))
 
 (ert-deftest url-auth-test-digest-request-digest ()
-  "Check digest response value when not supporting `qop'."
+  "Check digest response value."
   (dolist (row url-auth-test-challenges)
-    (should (string= (url-digest-auth-make-request-digest
-                      ;; HA1 and HA2 already tested
-                      (plist-get row :expected-ha1)
-                      (plist-get row :expected-ha2)
-                      (plist-get row :nonce))
-                     (plist-get row :expected-response)))))
+    (should (string= (plist-get row :expected-response)
+                     (if (plist-member row :qop)
+                         (url-digest-auth-make-request-digest-qop
+                          (plist-get row :qop)
+                          ;; HA1 and HA2 already tested
+                          (plist-get row :expected-ha1)
+                          (plist-get row :expected-ha2)
+                          (plist-get row :nonce)
+                          (plist-get row :nc)
+                          (plist-get row :cnonce))
+                       (url-digest-auth-make-request-digest
+                        ;; HA1 and HA2 already tested
+                        (plist-get row :expected-ha1)
+                        (plist-get row :expected-ha2)
+                        (plist-get row :nonce)))))))
 
 (ert-deftest url-auth-test-digest-create-key ()
   "Check user credentials in their hashed form."
@@ -203,9 +224,15 @@ Essential is how realms and paths are matched."
         (should-not auth)))))
 
 (ert-deftest url-auth-test-digest-auth ()
-  "Check common authorization string contents."
+  "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 (list (cons "nonce" (plist-get challenge :nonce))))
+    (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)
@@ -225,16 +252,23 @@ Essential is how realms and paths are matched."
                                   (plist-get challenge :realm) attrs))
       (should auth)
       (should (string-prefix-p "Digest " auth))
-      (should (string-match ".*response=\"\\(.*?\\)\".*" auth))
-      (should (string= (match-string 1 auth)
-                       (plist-get challenge :expected-response)))
       (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
-- 
2.5.0.330.g130be8e

Re: [PATCH 1/3] Test for url-auth

[Lars Ingebrigtsen]

Jarno Malmari <jarno@malmari.fi> writes:

> So far not testing PROMPT and OVERWRITE arguments which would require
> faking interactive minibuffer input.

This series of patches looks good, but I forgot whether I asked you if
you have FSF copyright assignment papers on file?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Re: [PATCH 1/3] Test for url-auth

[Eli Zaretskii]

> From: Lars Ingebrigtsen <larsi@gnus.org>
> Date: Sun, 07 Feb 2016 16:35:34 +1100
> Cc: emacs-devel@gnu.org
> 
> Jarno Malmari <jarno@malmari.fi> writes:
> 
> > So far not testing PROMPT and OVERWRITE arguments which would require
> > faking interactive minibuffer input.
> 
> This series of patches looks good, but I forgot whether I asked you if
> you have FSF copyright assignment papers on file?

He does.

Re: [PATCH 1/3] Test for url-auth

[Lars Ingebrigtsen]

Jarno Malmari <jarno@malmari.fi> writes:

> So far not testing PROMPT and OVERWRITE arguments which would require
> faking interactive minibuffer input.

I've installed your url-auth tests (in the new test directory layout),
but the other patches no longer seem to apply.  I'm sorry I've taken so
long to apply them, but would it be possible for you to re-spin the
patches?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Re: [PATCH 1/3] Test for url-auth

[Lars Ingebrigtsen]

And the digest tests fail.  For instance:

Test url-auth-test-digest-auth condition:
    (ert-test-failed
     ((should
       (string-match-p ".*nc=\".*?\".*" auth))
      :form
      (string-match-p ".*nc=\".*?\".*" "Digest username=\"jytky\", realm=\"Some 
test realm\",nonce=\"uBr3+qkQBybTr/dKWkmpUqVO7SaEwWYzyTKO7g==$\", uri=\"/random/
path\",response=\"e3b0bad6ad5f5cfb0ad6e9312b757f0f\"")
      :value nil))
   FAILED  1/4  url-auth-test-digest-auth

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Re: [PATCH 1/3] Test for url-auth

[Jarno Malmari]

Hi again! I ran the tests with my versions of the patches and they pass.

Seems there were some changes to my original first commit. I reverted it back to its original form, leaving behind cosmetic changes only. The first patch here is only to illustrate the changes reverted. It should be squashed with the third patch as the changes they contain are mostly redundant.

No intended changes to the second and third patches.

[PATCH 1/3] Revert parts of url-auth test

[Jarno Malmari]

This reverts some parts of commit f7b0ca9dfabc16cb286265de44a3fbfc3b5e73fa
that introduced QOP and digest test before their implementation.
---
 test/lisp/url/url-auth-tests.el | 37 +++++--------------------------------
 1 file changed, 5 insertions(+), 32 deletions(-)

diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index bc30f35..a80349d 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -36,18 +36,6 @@ url-auth-test-challenges
 ;; 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"
@@ -183,15 +171,9 @@ url-auth-test-challenges
         (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'."
+  "Check common authorization string contents."
   (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))))))
+    (let* ((attrs (list (cons "nonce" (plist-get challenge :nonce))))
            (url (concat "http://example.org" (plist-get challenge :uri)))
            url-digest-auth-storage
            auth)
@@ -212,24 +194,15 @@ url-auth-test-challenges
                                   (plist-get challenge :realm) attrs))
       (should auth)
       (should (string-prefix-p "Digest " auth))
+      (should (string-match ".*response=\"\\(.*?\\)\".*" auth))
+      (should (string= (match-string 1 auth)
+                       (plist-get challenge :expected-response)))
       (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))
-            ;; url-digest-auth doesn't return these AFAICS.
-;;;            (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 ()
-- 
2.7.0.25.gfc10eb5

[PATCH 2/3] Refactor digest authentication in url-auth

[Jarno Malmari]

Add a few tests as now more features are testable via intermediate
functions.

Additionally, this refactoring fixed a bug where duplicate key entries
were continously added in `url-digest-auth-storage' each time
authenticated.
---
 lisp/url/url-auth.el            | 340 ++++++++++++++++++++++++++++------------
 test/lisp/url/url-auth-tests.el |  36 +++++
 2 files changed, 276 insertions(+), 100 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index b2eceb0..59944af 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -143,107 +143,247 @@ 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 MD5 to DATA using SECRET as described in RFC 2617."
+  (md5 (url-digest-auth-colonjoin secret data)))
+
+(defsubst url-digest-auth-make-ha1 (user realm password)
+  "Compute hashed A1 value as described in RFC 2617.
+USER, REALM, and PASSWORD are strings used to create the hash
+from."
+  (md5 (url-digest-auth-colonjoin user realm password)))
+
+(defsubst url-digest-auth-make-ha2 (method digest-uri)
+  "Compute hashed A2 value as described in RFC 2617.
+METHOD and DIGEST-URI are strings used to create the hash from."
+  (md5 (url-digest-auth-colonjoin method digest-uri)))
+
+(defsubst url-digest-auth-make-request-digest (ha1 ha2 nonce)
+  "Construct the request-digest without qop as described in RFC 2617.
+Inputs for this are the hash strings HA1, HA2, and NONCE."
+  (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
+
+(defsubst url-digest-auth-directory-id (url realm)
+  "Make an identifier to use for server keys.
+The identifier is made either from URL's path or REALM."
+  (or realm (or (url-file-directory (url-filename url)) "/")))
+
+(defsubst url-digest-auth-server-id (url)
+  "Make an identifier to user for selecting servers in key cache.
+The identifier is made from URL's host and port."
+  (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 in key list using a path or a realm.
+
+The string DIRKEY is either a path or a realm.  The key list to
+search through is the alist KEYLIST where car of each element is
+either a path or a realm.  Realms are searched for an exact
+match.  For paths, an ancestor is sufficient for a match."
+  (or
+   ;; check exact match first, realm or path
+   (assoc dirkey keylist)
+   ;; no partial matches for non-path, i.e. 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,
+defined in RFC 2617. Modifying the contents of the returned list
+will modify the cache variable `url-digest-auth-storage' itself."
+  (let ((serverid (url-digest-auth-server-id url))
+        (dirid (url-digest-auth-directory-id url realm)))
+    (url-digest-auth-directory-id-assoc
+     dirid (cdr (assoc serverid 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 consisting of
+hashed authentication tokens HA1 and HA2, defined in RFC 2617.
+
+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 name1=\"value1\",
+name2=\"value2\", ...'
+
+Part of the challenge is already solved in a pre-computed KEY
+which is list of realm (or directory), user name, HA1 and HA2
+values (see RFC 2617).
+
+Some fields are filled with the given object URL, string REALM,
+and 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, allow to 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 incomplete and prompt 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 a80349d..adabaf2 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -65,6 +65,42 @@ 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
+                      ;; HA1 and HA2 already tested
+                      (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

[PATCH 3/3] Initial implementation for HTTP Digest qop for url

[Jarno Malmari]

Some servers have dropped backward compatibility with HTTP Digest
Authentication without "qop". The Quality of protection scheme is
partially implemented:
* only one supported qop, qop=auth
* only one supported algorithm, algorithm=md5
* nonce count remains always as 1, no replays
---
 lisp/url/url-auth.el            | 59 +++++++++++++++++++++++++++++++++++-----
 test/lisp/url/url-auth-tests.el | 60 ++++++++++++++++++++++++++++++++---------
 2 files changed, 100 insertions(+), 19 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 59944af..5c71481 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -131,8 +131,8 @@ url-basic-auth
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Digest authorization code
 ;;; ------------------------
-;;; This implements the DIGEST authorization type.  See the internet draft
-;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; This implements the DIGEST authorization type.  See RFC 2617
+;;; https://www.ietf.org/rfc/rfc2617.txt
 ;;; for the complete documentation on this type.
 ;;;
 ;;; This is very secure
@@ -167,6 +167,15 @@ url-digest-auth-make-request-digest
 Inputs for this are the hash strings HA1, HA2, and NONCE."
   (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
 
+(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
+  "Construct the request-digest with qop as described in RFC 2617.
+QOP describes the \"quality of protection\" and algorithm to use.
+HA1, HA2, and NONCE, NC, and CNONCE are string values, described
+in RFC 2617. It's worth noting that HA2 already depends on value
+of QOP."
+  (url-digest-auth-kd (url-digest-auth-colonjoin
+                       nonce nc cnonce qop ha2) ha1))
+
 (defsubst url-digest-auth-directory-id (url realm)
   "Make an identifier to use for server keys.
 The identifier is made either from URL's path or REALM."
@@ -177,6 +186,21 @@ url-digest-auth-server-id
 The identifier is made from URL's host and port."
   (format "%s:%d" (url-host url) (url-port url)))
 
+(defun url-digest-auth-make-cnonce ()
+  "Compute a new unique client nonce value."
+  (base64-encode-string
+   (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
+
+(defun url-digest-auth-nonce-count (nonce)
+  "The number requests sent to server with the given NONCE.
+This count includes the request we're preparing here.
+
+Currently, this is not implemented and will always return 1.
+
+Value returned is in string format with leading zeroes, such as
+\"00000001\"."
+  (format "%08x" 1))
+
 (defun url-digest-auth-name-value-string (pairs)
   "Concatenate name-value pairs in association list PAIRS.
 
@@ -281,12 +305,20 @@ url-digest-auth-build-response
 and contents of alist ATTRS.
 
 ATTRS is expected to contain at least the server's \"nonce\"
-value.  It also might contain the optional \"opaque\" value."
+value.  It also might contain the optional \"opaque\" value.
+Newer implementations conforming to RFC 2617 should also contain
+qop (Quality Of Protection) and related attributes.
+
+Restrictions on Quality of Protection scheme: The qop value
+\"auth-int\" or algorithm any other than \"MD5\" are not
+implemented."
+
   (when key
     (let ((user (nth 1 key))
           (ha1 (nth 2 key))
           (ha2 (nth 3 key))
           (digest-uri (url-filename url))
+          (qop (cdr-safe (assoc "qop" attrs)))
           (nonce (cdr-safe (assoc "nonce" attrs)))
           (opaque (cdr-safe (assoc "opaque" attrs))))
 
@@ -296,9 +328,24 @@ url-digest-auth-build-response
         (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)))
+                      (cons 'uri digest-uri))
+
+                (cond
+                 ((null qop)
+                  (list (cons 'response (url-digest-auth-make-request-digest
+                                         ha1 ha2 nonce))))
+                 ((string= qop "auth")
+                  (let ((nc (url-digest-auth-nonce-count nonce))
+                        (cnonce (url-digest-auth-make-cnonce)))
+                    (list (cons 'qop qop)
+                          (cons 'nc nc)
+                          (cons 'cnonce cnonce)
+                          (cons 'response
+                                (url-digest-auth-make-request-digest-qop
+                                 qop ha1 ha2 nonce nc cnonce)))))
+                 (t (message "Quality of protection \"%s\" is not implemented." qop)
+                    nil))
+
 
                 (if opaque (list (cons 'opaque opaque)))))))))
 
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index adabaf2..58f60c4 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -36,6 +36,18 @@ url-auth-test-challenges
 ;; 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"
@@ -92,14 +104,23 @@ url-auth-test-challenges
                      (plist-get row :expected-ha2)))))
 
 (ert-deftest url-auth-test-digest-request-digest ()
-  "Check digest response value when not supporting `qop'."
+  "Check digest response value."
   (dolist (row url-auth-test-challenges)
-    (should (string= (url-digest-auth-make-request-digest
-                      ;; HA1 and HA2 already tested
-                      (plist-get row :expected-ha1)
-                      (plist-get row :expected-ha2)
-                      (plist-get row :nonce))
-                     (plist-get row :expected-response)))))
+    (should (string= (plist-get row :expected-response)
+                     (if (plist-member row :qop)
+                         (url-digest-auth-make-request-digest-qop
+                          (plist-get row :qop)
+                          ;; HA1 and HA2 already tested
+                          (plist-get row :expected-ha1)
+                          (plist-get row :expected-ha2)
+                          (plist-get row :nonce)
+                          (plist-get row :nc)
+                          (plist-get row :cnonce))
+                       (url-digest-auth-make-request-digest
+                        ;; HA1 and HA2 already tested
+                        (plist-get row :expected-ha1)
+                        (plist-get row :expected-ha2)
+                        (plist-get row :nonce)))))))
 
 (ert-deftest url-auth-test-digest-create-key ()
   "Check user credentials in their hashed form."
@@ -207,9 +228,15 @@ url-auth-test-challenges
         (should-not auth)))))
 
 (ert-deftest url-auth-test-digest-auth ()
-  "Check common authorization string contents."
+  "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 (list (cons "nonce" (plist-get challenge :nonce))))
+    (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)
@@ -230,16 +257,23 @@ url-auth-test-challenges
                                   (plist-get challenge :realm) attrs))
       (should auth)
       (should (string-prefix-p "Digest " auth))
-      (should (string-match ".*response=\"\\(.*?\\)\".*" auth))
-      (should (string= (match-string 1 auth)
-                       (plist-get challenge :expected-response)))
       (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
-- 
2.7.0.25.gfc10eb5

Re: [PATCH 1/3] Test for url-auth

[Jarno Malmari]

> I ran the tests with my versions of the patches and they pass.
>  
> Seems there were some changes to my original first commit. I reverted
> it back to its original form, leaving behind cosmetic changes
> only. The first patch here is only to illustrate the changes
> reverted. It should be squashed with the third patch as the changes
> they contain are mostly redundant.
>  
> No intended changes to the second and third patches.

Bump. I did the squash on previous patches 1/3 and 3/3. Rebased on
latest master.

files modified:
* lisp/url/url-auth.el            | 391 +++++++++++++++++++++++++++++-----------
* test/lisp/url/url-auth-tests.el |  53 +++++-
2 files changed, 337 insertions(+), 107 deletions(-)

patch set that follows this email:
[PATCH 1/2] Refactor digest authentication in url-auth
[PATCH 2/2] Initial implementation for HTTP Digest qop for url

[PATCH 1/2] Refactor digest authentication in url-auth

[Jarno Malmari]

Add a few tests as now more features are testable via intermediate
functions.

Additionally, this refactoring fixed a bug where duplicate key entries
were continously added in `url-digest-auth-storage' each time
authenticated.
---
 lisp/url/url-auth.el            | 340 ++++++++++++++++++++++++++++------------
 test/lisp/url/url-auth-tests.el |  36 +++++
 2 files changed, 276 insertions(+), 100 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index a2aa97c..52b2244 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -143,107 +143,247 @@ 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 MD5 to DATA using SECRET as described in RFC 2617."
+  (md5 (url-digest-auth-colonjoin secret data)))
+
+(defsubst url-digest-auth-make-ha1 (user realm password)
+  "Compute hashed A1 value as described in RFC 2617.
+USER, REALM, and PASSWORD are strings used to create the hash
+from."
+  (md5 (url-digest-auth-colonjoin user realm password)))
+
+(defsubst url-digest-auth-make-ha2 (method digest-uri)
+  "Compute hashed A2 value as described in RFC 2617.
+METHOD and DIGEST-URI are strings used to create the hash from."
+  (md5 (url-digest-auth-colonjoin method digest-uri)))
+
+(defsubst url-digest-auth-make-request-digest (ha1 ha2 nonce)
+  "Construct the request-digest without qop as described in RFC 2617.
+Inputs for this are the hash strings HA1, HA2, and NONCE."
+  (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
+
+(defsubst url-digest-auth-directory-id (url realm)
+  "Make an identifier to use for server keys.
+The identifier is made either from URL's path or REALM."
+  (or realm (or (url-file-directory (url-filename url)) "/")))
+
+(defsubst url-digest-auth-server-id (url)
+  "Make an identifier to user for selecting servers in key cache.
+The identifier is made from URL's host and port."
+  (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 in key list using a path or a realm.
+
+The string DIRKEY is either a path or a realm.  The key list to
+search through is the alist KEYLIST where car of each element is
+either a path or a realm.  Realms are searched for an exact
+match.  For paths, an ancestor is sufficient for a match."
+  (or
+   ;; check exact match first, realm or path
+   (assoc dirkey keylist)
+   ;; no partial matches for non-path, i.e. 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,
+defined in RFC 2617. Modifying the contents of the returned list
+will modify the cache variable `url-digest-auth-storage' itself."
+  (let ((serverid (url-digest-auth-server-id url))
+        (dirid (url-digest-auth-directory-id url realm)))
+    (url-digest-auth-directory-id-assoc
+     dirid (cdr (assoc serverid 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 consisting of
+hashed authentication tokens HA1 and HA2, defined in RFC 2617.
+
+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 name1=\"value1\",
+name2=\"value2\", ...'
+
+Part of the challenge is already solved in a pre-computed KEY
+which is list of realm (or directory), user name, HA1 and HA2
+values (see RFC 2617).
+
+Some fields are filled with the given object URL, string REALM,
+and 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, allow to 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 incomplete and prompt 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 bc30f35..3d3132b 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -77,6 +77,42 @@ 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
+                      ;; HA1 and HA2 already tested
+                      (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

[PATCH 2/2] Initial implementation for HTTP Digest qop for url

[Jarno Malmari]

Some servers have dropped backward compatibility with HTTP Digest
Authentication without "qop". The Quality Of Protection scheme is
partially implemented:
* only one supported qop, qop=auth
* only one supported algorithm, algorithm=md5
* nonce count remains always as 1, no replays
---
 lisp/url/url-auth.el            | 59 ++++++++++++++++++++++++++++++++++++-----
 test/lisp/url/url-auth-tests.el | 31 +++++++++++++---------
 2 files changed, 72 insertions(+), 18 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 52b2244..a48e511 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -131,8 +131,8 @@ url-basic-auth
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Digest authorization code
 ;;; ------------------------
-;;; This implements the DIGEST authorization type.  See the internet draft
-;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; This implements the DIGEST authorization type.  See RFC 2617
+;;; https://www.ietf.org/rfc/rfc2617.txt
 ;;; for the complete documentation on this type.
 ;;;
 ;;; This is very secure
@@ -167,6 +167,15 @@ url-digest-auth-make-request-digest
 Inputs for this are the hash strings HA1, HA2, and NONCE."
   (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
 
+(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
+  "Construct the request-digest with qop as described in RFC 2617.
+QOP describes the \"quality of protection\" and algorithm to use.
+HA1, HA2, and NONCE, NC, and CNONCE are string values, described
+in RFC 2617. It's worth noting that HA2 already depends on value
+of QOP."
+  (url-digest-auth-kd (url-digest-auth-colonjoin
+                       nonce nc cnonce qop ha2) ha1))
+
 (defsubst url-digest-auth-directory-id (url realm)
   "Make an identifier to use for server keys.
 The identifier is made either from URL's path or REALM."
@@ -177,6 +186,21 @@ url-digest-auth-server-id
 The identifier is made from URL's host and port."
   (format "%s:%d" (url-host url) (url-port url)))
 
+(defun url-digest-auth-make-cnonce ()
+  "Compute a new unique client nonce value."
+  (base64-encode-string
+   (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
+
+(defun url-digest-auth-nonce-count (nonce)
+  "The number requests sent to server with the given NONCE.
+This count includes the request we're preparing here.
+
+Currently, this is not implemented and will always return 1.
+
+Value returned is in string format with leading zeroes, such as
+\"00000001\"."
+  (format "%08x" 1))
+
 (defun url-digest-auth-name-value-string (pairs)
   "Concatenate name-value pairs in association list PAIRS.
 
@@ -281,12 +305,20 @@ url-digest-auth-build-response
 and contents of alist ATTRS.
 
 ATTRS is expected to contain at least the server's \"nonce\"
-value.  It also might contain the optional \"opaque\" value."
+value.  It also might contain the optional \"opaque\" value.
+Newer implementations conforming to RFC 2617 should also contain
+qop (Quality Of Protection) and related attributes.
+
+Restrictions on Quality of Protection scheme: The qop value
+\"auth-int\" or algorithm any other than \"MD5\" are not
+implemented."
+
   (when key
     (let ((user (nth 1 key))
           (ha1 (nth 2 key))
           (ha2 (nth 3 key))
           (digest-uri (url-filename url))
+          (qop (cdr-safe (assoc "qop" attrs)))
           (nonce (cdr-safe (assoc "nonce" attrs)))
           (opaque (cdr-safe (assoc "opaque" attrs))))
 
@@ -296,9 +328,24 @@ url-digest-auth-build-response
         (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)))
+                      (cons 'uri digest-uri))
+
+                (cond
+                 ((null qop)
+                  (list (cons 'response (url-digest-auth-make-request-digest
+                                         ha1 ha2 nonce))))
+                 ((string= qop "auth")
+                  (let ((nc (url-digest-auth-nonce-count nonce))
+                        (cnonce (url-digest-auth-make-cnonce)))
+                    (list (cons 'qop qop)
+                          (cons 'nc nc)
+                          (cons 'cnonce cnonce)
+                          (cons 'response
+                                (url-digest-auth-make-request-digest-qop
+                                 qop ha1 ha2 nonce nc cnonce)))))
+                 (t (message "Quality of protection \"%s\" is not implemented." qop)
+                    nil))
+
 
                 (if opaque (list (cons 'opaque opaque)))))))))
 
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index 3d3132b..58f60c4 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -104,14 +104,23 @@ url-auth-test-challenges
                      (plist-get row :expected-ha2)))))
 
 (ert-deftest url-auth-test-digest-request-digest ()
-  "Check digest response value when not supporting `qop'."
+  "Check digest response value."
   (dolist (row url-auth-test-challenges)
-    (should (string= (url-digest-auth-make-request-digest
-                      ;; HA1 and HA2 already tested
-                      (plist-get row :expected-ha1)
-                      (plist-get row :expected-ha2)
-                      (plist-get row :nonce))
-                     (plist-get row :expected-response)))))
+    (should (string= (plist-get row :expected-response)
+                     (if (plist-member row :qop)
+                         (url-digest-auth-make-request-digest-qop
+                          (plist-get row :qop)
+                          ;; HA1 and HA2 already tested
+                          (plist-get row :expected-ha1)
+                          (plist-get row :expected-ha2)
+                          (plist-get row :nonce)
+                          (plist-get row :nc)
+                          (plist-get row :cnonce))
+                       (url-digest-auth-make-request-digest
+                        ;; HA1 and HA2 already tested
+                        (plist-get row :expected-ha1)
+                        (plist-get row :expected-ha2)
+                        (plist-get row :nonce)))))))
 
 (ert-deftest url-auth-test-digest-create-key ()
   "Check user credentials in their hashed form."
@@ -259,14 +268,12 @@ url-auth-test-challenges
           (progn
             ;; We don't know these, just check that they exists.
             (should (string-match-p ".*response=\".*?\".*" auth))
-            ;; url-digest-auth doesn't return these AFAICS.
-;;;            (should (string-match-p ".*nc=\".*?\".*" auth))
-;;;            (should (string-match-p ".*cnonce=\".*?\".*" 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
-- 
2.7.0.25.gfc10eb5

Re: [PATCH 1/3] Test for url-auth

[Jarno Malmari]

> patch set that follows this email:
> [PATCH 1/2] Refactor digest authentication in url-auth
> [PATCH 2/2] Initial implementation for HTTP Digest qop for url

Another set following with fixed commit messages (following CONTRIBUTE). Sorry for spam.

[PATCH 1/2] Refactor digest authentication in url-auth

[Jarno Malmari]

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            | 340 ++++++++++++++++++++++++++++------------
 test/lisp/url/url-auth-tests.el |  36 +++++
 2 files changed, 276 insertions(+), 100 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index a2aa97c..52b2244 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -143,107 +143,247 @@ 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 MD5 to DATA using SECRET as described in RFC 2617."
+  (md5 (url-digest-auth-colonjoin secret data)))
+
+(defsubst url-digest-auth-make-ha1 (user realm password)
+  "Compute hashed A1 value as described in RFC 2617.
+USER, REALM, and PASSWORD are strings used to create the hash
+from."
+  (md5 (url-digest-auth-colonjoin user realm password)))
+
+(defsubst url-digest-auth-make-ha2 (method digest-uri)
+  "Compute hashed A2 value as described in RFC 2617.
+METHOD and DIGEST-URI are strings used to create the hash from."
+  (md5 (url-digest-auth-colonjoin method digest-uri)))
+
+(defsubst url-digest-auth-make-request-digest (ha1 ha2 nonce)
+  "Construct the request-digest without qop as described in RFC 2617.
+Inputs for this are the hash strings HA1, HA2, and NONCE."
+  (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
+
+(defsubst url-digest-auth-directory-id (url realm)
+  "Make an identifier to use for server keys.
+The identifier is made either from URL's path or REALM."
+  (or realm (or (url-file-directory (url-filename url)) "/")))
+
+(defsubst url-digest-auth-server-id (url)
+  "Make an identifier to user for selecting servers in key cache.
+The identifier is made from URL's host and port."
+  (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 in key list using a path or a realm.
+
+The string DIRKEY is either a path or a realm.  The key list to
+search through is the alist KEYLIST where car of each element is
+either a path or a realm.  Realms are searched for an exact
+match.  For paths, an ancestor is sufficient for a match."
+  (or
+   ;; check exact match first, realm or path
+   (assoc dirkey keylist)
+   ;; no partial matches for non-path, i.e. 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,
+defined in RFC 2617. Modifying the contents of the returned list
+will modify the cache variable `url-digest-auth-storage' itself."
+  (let ((serverid (url-digest-auth-server-id url))
+        (dirid (url-digest-auth-directory-id url realm)))
+    (url-digest-auth-directory-id-assoc
+     dirid (cdr (assoc serverid 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 consisting of
+hashed authentication tokens HA1 and HA2, defined in RFC 2617.
+
+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 name1=\"value1\",
+name2=\"value2\", ...'
+
+Part of the challenge is already solved in a pre-computed KEY
+which is list of realm (or directory), user name, HA1 and HA2
+values (see RFC 2617).
+
+Some fields are filled with the given object URL, string REALM,
+and 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, allow to 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 incomplete and prompt 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 bc30f35..3d3132b 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -77,6 +77,42 @@ 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
+                      ;; HA1 and HA2 already tested
+                      (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

Re: [PATCH 1/2] Refactor digest authentication in url-auth

[Eli Zaretskii]

> From: Jarno Malmari <jarno@malmari.fi>
> Date: Sun, 13 Nov 2016 13:36:20 +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.

This is not how we format commit logs of changes to several functions
whose list spans several lines.  The entry should look like this:

* 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.

IOW, each line begins is separately parenthesized.

> +(defsubst url-digest-auth-kd (data secret)
> +  "Apply digest algorithm MD5 to DATA using SECRET as described in RFC 2617."
> +  (md5 (url-digest-auth-colonjoin secret data)))
> +
> +(defsubst url-digest-auth-make-ha1 (user realm password)
> +  "Compute hashed A1 value as described in RFC 2617.
> +USER, REALM, and PASSWORD are strings used to create the hash
> +from."
> +  (md5 (url-digest-auth-colonjoin user realm password)))

Hear and elsewhere, I find the doc strings impenetrable without having
RFC 2617 around.  I wonder if it would make sense to describe the
arguments in a bit more detail, such that consulting the RFC each time
these are used would not be necessary.  Is that practical?

> +(defun url-digest-auth-directory-id-assoc (dirkey keylist)
> +  "Find the best match in key list using a path or a realm.
> +
> +The string DIRKEY is either a path or a realm.  The key list to
> +search through is the alist KEYLIST where car of each element is
> +either a path or a realm.  Realms are searched for an exact
> +match.  For paths, an ancestor is sufficient for a match."

GNU coding standards frown on using "path" for anything but PATH-style
directory lists.  Please use "file name" or "directory name" instead.

> +   ;; no partial matches for non-path, i.e. realm
> +   (and (string-match "/" dirkey)

This will fail with Windows file names that use backslashes.

I also find the test to be too loose: does having a slash in a string
really make it a directory name?  At least on Windows, a string with
embedded slashes or backslashes can be an invalid file name.

> +(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,
> +defined in RFC 2617. Modifying the contents of the returned list

Two spaces between sentences, please.

> +  "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 consisting of
> +hashed authentication tokens HA1 and HA2, defined in RFC 2617.

Same here.

> +Primary method for finding credentials is from Emacs auth-source.
> +If password isn't found, and PROMPT is non-nil, allow to query
> +credentials via minibuffer.

"Allow to query" or "query"?

> +    ;; if incomplete and prompt allowed, prompt the user

Comments should begin with a capital letter and end with a period, as
normal sentences are (here and elsewhere in the patch).

Thanks.

Re: [PATCH 1/2] Refactor digest authentication in url-auth

[Jarno Malmari]

Eli Zaretskii <eliz@gnu.org> writes:
>> * 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.
>
> This is not how we format commit logs of changes to several functions
> whose list spans several lines.  The entry should look like this:
>
> * 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.
>
> IOW, each line begins is separately parenthesized.

Will fix. Seems I wasn't able to deduce the correct format from previous
log entries nor from the CONTRIBUTE file. Is this format obvious to
others? Should the "each line separately parenthesized" be described in
the CONTRIBUTE file?

>
>> +(defsubst url-digest-auth-kd (data secret)
>> +  "Apply digest algorithm MD5 to DATA using SECRET as described in RFC 2617."
>> +  (md5 (url-digest-auth-colonjoin secret data)))
>> +
>> +(defsubst url-digest-auth-make-ha1 (user realm password)
>> +  "Compute hashed A1 value as described in RFC 2617.
>> +USER, REALM, and PASSWORD are strings used to create the hash
>> +from."
>> +  (md5 (url-digest-auth-colonjoin user realm password)))
>
> Hear and elsewhere, I find the doc strings impenetrable without having
> RFC 2617 around.

Yeah, it's kind of annoying.

> I wonder if it would make sense to describe the arguments in a bit
> more detail, such that consulting the RFC each time these are used
> would not be necessary.  Is that practical?

I'll give it a try and see if it gets messy. Some arguments might have
complex(ish) BNF to them but we may not have to go that far in our
limited implementation.

>
>> +(defun url-digest-auth-directory-id-assoc (dirkey keylist)
>> +  "Find the best match in key list using a path or a realm.
>> +
>> +The string DIRKEY is either a path or a realm.  The key list to
>> +search through is the alist KEYLIST where car of each element is
>> +either a path or a realm.  Realms are searched for an exact
>> +match.  For paths, an ancestor is sufficient for a match."
>
> GNU coding standards frown on using "path" for anything but PATH-style
> directory lists.  Please use "file name" or "directory name" instead.

Good to know. Is there a convention to indicate path part in URIs?

>
>> +   ;; no partial matches for non-path, i.e. realm
>> +   (and (string-match "/" dirkey)
>
> This will fail with Windows file names that use backslashes.

We're actually not talking about file system paths. We're talking about
paths (directory names?) in URIs which define, together with realm, the
"protection space" (see RFC2617 ;)). The idea behind protection spaces
are that the same credentials can be preemptively reused without
bothering the user.

I can't say if the url package is using the path part correctly or not,
or if it's even trying to implement protection spaces with it. (I'm not
an expert on this. I just refactored the code trying to preserve the old
functionality the best I could.) In any case, url package uses either
realm or the path as key to find cached credentials, and prefers the
realm. If the path is used, then same credentials is tried for every
"sub directory" resource: If path "/a/b" (www.example.com/a/b) has
credentials cached, the same credentials are tried for "a/b/c" and so
on.

>
>> +(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,
>> +defined in RFC 2617. Modifying the contents of the returned list
>
> Two spaces between sentences, please.

Will fix.

>
>> +  "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 consisting of
>> +hashed authentication tokens HA1 and HA2, defined in RFC 2617.
>
> Same here.

On to it.

>
>> +Primary method for finding credentials is from Emacs auth-source.
>> +If password isn't found, and PROMPT is non-nil, allow to query
>> +credentials via minibuffer.
>
> "Allow to query" or "query"?

Query. Confusion arised since prompt=t by itself doesn't mean query will
happen. Will fix.

>
>> +    ;; if incomplete and prompt allowed, prompt the user
>
> Comments should begin with a capital letter and end with a period, as
> normal sentences are (here and elsewhere in the patch).

Does that implicitly mean that each comment should be a complete
sentence? Granted, this one is close to one. Will fix.

>
> Thanks.

Re: [PATCH 1/2] Refactor digest authentication in url-auth

[Eli Zaretskii]

> From: Jarno Malmari <jarno@malmari.fi>
> Cc: emacs-devel@gnu.org
> Date: Sun, 13 Nov 2016 23:57:08 +0200
> 
> > * 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.
> >
> > IOW, each line begins is separately parenthesized.
> 
> Will fix. Seems I wasn't able to deduce the correct format from previous
> log entries nor from the CONTRIBUTE file. Is this format obvious to
> others? Should the "each line separately parenthesized" be described in
> the CONTRIBUTE file?

CONTRIBUTE says to use ChangeLog commands, like "C-x 4 a", to add the
entries.  Those commands produce the above format automatically.

> >> +(defun url-digest-auth-directory-id-assoc (dirkey keylist)
> >> +  "Find the best match in key list using a path or a realm.
> >> +
> >> +The string DIRKEY is either a path or a realm.  The key list to
> >> +search through is the alist KEYLIST where car of each element is
> >> +either a path or a realm.  Realms are searched for an exact
> >> +match.  For paths, an ancestor is sufficient for a match."
> >
> > GNU coding standards frown on using "path" for anything but PATH-style
> > directory lists.  Please use "file name" or "directory name" instead.
> 
> Good to know. Is there a convention to indicate path part in URIs?

Not that I know of.  I'd use "file-name part".

> >> +   ;; no partial matches for non-path, i.e. realm
> >> +   (and (string-match "/" dirkey)
> >
> > This will fail with Windows file names that use backslashes.
> 
> We're actually not talking about file system paths. We're talking about
> paths (directory names?) in URIs which define, together with realm, the
> "protection space" (see RFC2617 ;)).

Ah, okay.  In that case, this should be described in more detail, I
think.

Note that there's also an Info manual for the URL package.

> >> +    ;; if incomplete and prompt allowed, prompt the user
> >
> > Comments should begin with a capital letter and end with a period, as
> > normal sentences are (here and elsewhere in the patch).
> 
> Does that implicitly mean that each comment should be a complete
> sentence?

Yes, preferably.

Thanks.

Re: [PATCH 1/2] Refactor digest authentication in url-auth

[Yuri Khan]

On Mon, Nov 14, 2016 at 10:42 AM, Eli Zaretskii <eliz@gnu.org> wrote:

>> > GNU coding standards frown on using "path" for anything but PATH-style
>> > directory lists.  Please use "file name" or "directory name" instead.
>>
>> Good to know. Is there a convention to indicate path part in URIs?
>
> Not that I know of.  I'd use "file-name part".

To a network application developer, “path” is a domain[^1] term (RFC
3986 § 3.3) and any replacement would be surprising and hinder API
discoverability. URIs don’t even necessarily map to files, so the
replacement proposed above is, in addition, misleading.

[^1]: “domain” as in “business domain”, not “domain name system”.

Please consider “URI path” if you must disambiguate.

Re: [PATCH 1/2] Refactor digest authentication in url-auth

[Eli Zaretskii]

> From: Yuri Khan <yuri.v.khan@gmail.com>
> Date: Mon, 14 Nov 2016 10:34:18 +0600
> Cc: Jarno Malmari <jarno@malmari.fi>, Emacs developers <emacs-devel@gnu.org>
> 
> >> > GNU coding standards frown on using "path" for anything but PATH-style
> >> > directory lists.  Please use "file name" or "directory name" instead.
> >>
> >> Good to know. Is there a convention to indicate path part in URIs?
> >
> > Not that I know of.  I'd use "file-name part".
> 
> To a network application developer, “path” is a domain[^1] term (RFC
> 3986 § 3.3) and any replacement would be surprising and hinder API
> discoverability. URIs don’t even necessarily map to files, so the
> replacement proposed above is, in addition, misleading.

The terminology in this case doesn't include "path", it includes
"URI" and "abs_path" (see RFC 2617).  The use of "path" in the doc
strings being discussed should therefore be minimal, ideally zero.

The clash with terminology accepted elsewhere is unfortunate, but
nothing new: we have the same issues with "yank" vs "paste", "frame"
vs "window", etc.  GNU Coding Standards are mandatory for us, because
GNU documentation is primarily for users of GNU software, who are
accustomed to our terminology which is used consistently across
projects.  Therefore we should strive to use our terminology whenever
we can, and if that requires some "creative" wording, so be it.

> Please consider “URI path” if you must disambiguate.

If needed, we should use "the path component of a URI" or somesuch.
But ideally the need should not arise in this case at all, at least
not AFAICT.

Re: Refactor digest authentication in url-auth

[Jarno Malmari]

Here's a revised patch set for the earlier digest auth work.

* Changed comments to follow gnu coding standards: two spaces between
  sentences, capital letter at beginning, period at the end, and the
  like

* Removed bunch of references to RFC 2617 from docstrings. Still to
  understand what's being done requires you to pick that up, but
  mentioning it repeatedly doesn't help too much.

* Changed the format of commit messages.

* There were talk about what to call the "path component of an URI".
  Is it file-name part, directory, path, or URI path. I tried avoiding
  mentioning it but a few references remains and I ended up choosing
  "directory" since that's what's used in functions used here, namely:

    (url-file-directory (url-filename url))

  The `url-file-directory' is defined in url-util with docstring:

     "Return the directory part of FILE, for a URL."

Patches that follows:
[PATCH 1/2] Refactor digest authentication in url-auth
[PATCH 2/2] Initial implementation for HTTP Digest qop for url

[PATCH 1/2] Refactor digest authentication in url-auth

[Jarno Malmari]

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

[PATCH 2/2] Initial implementation for HTTP Digest qop for url

[Jarno Malmari]

Some servers have dropped backward compatibility with HTTP Digest
Authentication without "qop".  The Quality Of Protection scheme is
partially implemented: only one supported qop (qop=auth), only one
supported algorithm (md5), nonce count remains always as 1 (no replays)
* lisp/url/url-auth.el (url-digest-auth-build-response): Hook up new
functionality, or fall back to previous.
(url-digest-auth-make-request-digest-qop):
(url-digest-auth-make-cnonce, url-digest-auth-nonce-count):
(url-digest-auth-name-value-string): Add new helper functions.
* test/lisp/url/url-auth-tests.el (url-auth-test-challenges):
(url-auth-test-digest-request-digest): Test the new implementation.
Parts of these were accidentally already merged in the past.
---
 lisp/url/url-auth.el            | 60 ++++++++++++++++++++++++++++++++++++-----
 test/lisp/url/url-auth-tests.el | 28 +++++++++++--------
 2 files changed, 71 insertions(+), 17 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 6512e12..3447caa 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -131,8 +131,8 @@ url-basic-auth
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Digest authorization code
 ;;; ------------------------
-;;; This implements the DIGEST authorization type.  See the internet draft
-;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; This implements the DIGEST authorization type.  See RFC 2617
+;;; https://www.ietf.org/rfc/rfc2617.txt
 ;;; for the complete documentation on this type.
 ;;;
 ;;; This is very secure
@@ -165,6 +165,16 @@ url-digest-auth-make-request-digest
 a password."
   (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
 
+(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
+  "Construct the request-digest with qop.
+QOP describes the \"quality of protection\" and algorithm to use.
+All of the strings QOP, HA1, HA2, NONCE, NC, and CNONCE are
+combined into a single hash value that proves to a server the
+user knows a password.  It's worth noting that HA2 already
+depends on value of QOP."
+  (url-digest-auth-kd (url-digest-auth-colonjoin
+                       nonce nc cnonce qop 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
@@ -179,6 +189,21 @@ url-digest-auth-server-id
 key cache `url-digest-auth-storage'."
   (format "%s:%d" (url-host url) (url-port url)))
 
+(defun url-digest-auth-make-cnonce ()
+  "Compute a new unique client nonce value."
+  (base64-encode-string
+   (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
+
+(defun url-digest-auth-nonce-count (nonce)
+  "The number requests sent to server with the given NONCE.
+This count includes the request we're preparing here.
+
+Currently, this is not implemented and will always return 1.
+
+Value returned is in string format with leading zeroes, such as
+\"00000001\"."
+  (format "%08x" 1))
+
 (defun url-digest-auth-name-value-string (pairs)
   "Concatenate name-value pairs in association list PAIRS.
 
@@ -284,12 +309,20 @@ url-digest-auth-build-response
 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."
+value.  It also might contain the optional \"opaque\" value.
+Newer implementations conforming to RFC 2617 should also contain
+qop (Quality Of Protection) and related attributes.
+
+Restrictions on Quality of Protection scheme: The qop value
+\"auth-int\" or algorithm any other than \"MD5\" are not
+implemented."
+
   (when key
     (let ((user (nth 1 key))
           (ha1 (nth 2 key))
           (ha2 (nth 3 key))
           (digest-uri (url-filename url))
+          (qop (cdr-safe (assoc "qop" attrs)))
           (nonce (cdr-safe (assoc "nonce" attrs)))
           (opaque (cdr-safe (assoc "opaque" attrs))))
 
@@ -299,9 +332,24 @@ url-digest-auth-build-response
         (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)))
+                      (cons 'uri digest-uri))
+
+                (cond
+                 ((null qop)
+                  (list (cons 'response (url-digest-auth-make-request-digest
+                                         ha1 ha2 nonce))))
+                 ((string= qop "auth")
+                  (let ((nc (url-digest-auth-nonce-count nonce))
+                        (cnonce (url-digest-auth-make-cnonce)))
+                    (list (cons 'qop qop)
+                          (cons 'nc nc)
+                          (cons 'cnonce cnonce)
+                          (cons 'response
+                                (url-digest-auth-make-request-digest-qop
+                                 qop ha1 ha2 nonce nc cnonce)))))
+                 (t (message "Quality of protection \"%s\" is not implemented." qop)
+                    nil))
+
 
                 (if opaque (list (cons 'opaque opaque)))))))))
 
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index a6b31d7..30636db 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -104,13 +104,21 @@ url-auth-test-challenges
                      (plist-get row :expected-ha2)))))
 
 (ert-deftest url-auth-test-digest-request-digest ()
-  "Check digest response value when not supporting `qop'."
+  "Check digest response value."
   (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)))))
+    (should (string= (plist-get row :expected-response)
+                     (if (plist-member row :qop)
+                         (url-digest-auth-make-request-digest-qop
+                          (plist-get row :qop)
+                          (plist-get row :expected-ha1)
+                          (plist-get row :expected-ha2)
+                          (plist-get row :nonce)
+                          (plist-get row :nc)
+                          (plist-get row :cnonce))
+                       (url-digest-auth-make-request-digest
+                        (plist-get row :expected-ha1)
+                        (plist-get row :expected-ha2)
+                        (plist-get row :nonce)))))))
 
 (ert-deftest url-auth-test-digest-create-key ()
   "Check user credentials in their hashed form."
@@ -258,14 +266,12 @@ url-auth-test-challenges
           (progn
             ;; We don't know these, just check that they exists.
             (should (string-match-p ".*response=\".*?\".*" auth))
-            ;; url-digest-auth doesn't return these AFAICS.
-;;;            (should (string-match-p ".*nc=\".*?\".*" auth))
-;;;            (should (string-match-p ".*cnonce=\".*?\".*" 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
-- 
2.7.0.25.gfc10eb5

Re: Refactor digest authentication in url-auth

[Eli Zaretskii]

> From: Jarno Malmari <jarno@malmari.fi>
> Cc: eliz@gnu.org
> Date: Tue, 14 Feb 2017 23:12:55 +0200
> 
> Here's a revised patch set for the earlier digest auth work.
> 
> * Changed comments to follow gnu coding standards: two spaces between
>   sentences, capital letter at beginning, period at the end, and the
>   like
> 
> * Removed bunch of references to RFC 2617 from docstrings. Still to
>   understand what's being done requires you to pick that up, but
>   mentioning it repeatedly doesn't help too much.
> 
> * Changed the format of commit messages.
> 
> * There were talk about what to call the "path component of an URI".
>   Is it file-name part, directory, path, or URI path. I tried avoiding
>   mentioning it but a few references remains and I ended up choosing
>   "directory" since that's what's used in functions used here, namely:
> 
>     (url-file-directory (url-filename url))
> 
>   The `url-file-directory' is defined in url-util with docstring:
> 
>      "Return the directory part of FILE, for a URL."
> 
> Patches that follows:
> [PATCH 1/2] Refactor digest authentication in url-auth
> [PATCH 2/2] Initial implementation for HTTP Digest qop for url

Thanks.

Could someone familiar with url-auth.el please review these?

Re: Refactor digest authentication in url-auth

[Eli Zaretskii]

Ping!

> Date: Sat, 18 Feb 2017 13:11:45 +0200
> From: Eli Zaretskii <eliz@gnu.org>
> Cc: emacs-devel@gnu.org
> 
> > From: Jarno Malmari <jarno@malmari.fi>
> > Cc: eliz@gnu.org
> > Date: Tue, 14 Feb 2017 23:12:55 +0200
> > 
> > Here's a revised patch set for the earlier digest auth work.
> > 
> > * Changed comments to follow gnu coding standards: two spaces between
> >   sentences, capital letter at beginning, period at the end, and the
> >   like
> > 
> > * Removed bunch of references to RFC 2617 from docstrings. Still to
> >   understand what's being done requires you to pick that up, but
> >   mentioning it repeatedly doesn't help too much.
> > 
> > * Changed the format of commit messages.
> > 
> > * There were talk about what to call the "path component of an URI".
> >   Is it file-name part, directory, path, or URI path. I tried avoiding
> >   mentioning it but a few references remains and I ended up choosing
> >   "directory" since that's what's used in functions used here, namely:
> > 
> >     (url-file-directory (url-filename url))
> > 
> >   The `url-file-directory' is defined in url-util with docstring:
> > 
> >      "Return the directory part of FILE, for a URL."
> > 
> > Patches that follows:
> > [PATCH 1/2] Refactor digest authentication in url-auth
> > [PATCH 2/2] Initial implementation for HTTP Digest qop for url
> 
> Thanks.
> 
> Could someone familiar with url-auth.el please review these?

Re: Refactor digest authentication in url-auth

[Jarno Malmari]

Eli Zaretskii <eliz@gnu.org> writes:

For what it's worth I'd consider the refactoring patch (PATCH 1/2) quite
safe to merge in and would suggest prioritizing reviewing efforts on the
latter patch (PATCH 2/2) that contains the actual QOP feature.

> Ping!
>
>> Date: Sat, 18 Feb 2017 13:11:45 +0200
>> From: Eli Zaretskii <eliz@gnu.org>
>> Cc: emacs-devel@gnu.org
>> 
>> > From: Jarno Malmari <jarno@malmari.fi>
>> > Cc: eliz@gnu.org
>> > Date: Tue, 14 Feb 2017 23:12:55 +0200
>> > 
>> > Here's a revised patch set for the earlier digest auth work.
>> > 
>> > * Changed comments to follow gnu coding standards: two spaces between
>> >   sentences, capital letter at beginning, period at the end, and the
>> >   like
>> > 
>> > * Removed bunch of references to RFC 2617 from docstrings. Still to
>> >   understand what's being done requires you to pick that up, but
>> >   mentioning it repeatedly doesn't help too much.
>> > 
>> > * Changed the format of commit messages.
>> > 
>> > * There were talk about what to call the "path component of an URI".
>> >   Is it file-name part, directory, path, or URI path. I tried avoiding
>> >   mentioning it but a few references remains and I ended up choosing
>> >   "directory" since that's what's used in functions used here, namely:
>> > 
>> >     (url-file-directory (url-filename url))
>> > 
>> >   The `url-file-directory' is defined in url-util with docstring:
>> > 
>> >      "Return the directory part of FILE, for a URL."
>> > 
>> > Patches that follows:
>> > [PATCH 1/2] Refactor digest authentication in url-auth
>> > [PATCH 2/2] Initial implementation for HTTP Digest qop for url
>> 
>> Thanks.
>> 
>> Could someone familiar with url-auth.el please review these?

Re: Refactor digest authentication in url-auth

[Eli Zaretskii]

> From: Jarno Malmari <jarno@malmari.fi>
> Cc: 
> Date: Sun, 05 Mar 2017 17:54:01 +0200
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> For what it's worth I'd consider the refactoring patch (PATCH 1/2) quite
> safe to merge in and would suggest prioritizing reviewing efforts on the
> latter patch (PATCH 2/2) that contains the actual QOP feature.

I asked the experts to review both, thanks.

Re: Refactor digest authentication in url-auth

[Eli Zaretskii]

> From: Jarno Malmari <jarno@malmari.fi>
> Cc: 
> Date: Sun, 05 Mar 2017 17:54:01 +0200
> 
> For what it's worth I'd consider the refactoring patch (PATCH 1/2) quite
> safe to merge in and would suggest prioritizing reviewing efforts on the
> latter patch (PATCH 2/2) that contains the actual QOP feature.

Since no one seems to be interested to review this patch, I did that
myself.  I have two comments:

> +(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\", ...'

Typo: should be "look", not "looks".

> +(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."

This function's doc string looks strikingly different from the rest of
the functions you wrote: not as detailed and clear as the rest.  Can
you rework it to be more in line with the rest of the functions?

With those minor issues fixed, I will push your changes.

Thanks.

Re: Refactor digest authentication in url-auth

[Eli Zaretskii]

Ping!

> Date: Sat, 11 Mar 2017 12:08:50 +0200
> From: Eli Zaretskii <eliz@gnu.org>
> Cc: emacs-devel@gnu.org
> 
> > From: Jarno Malmari <jarno@malmari.fi>
> > Cc: 
> > Date: Sun, 05 Mar 2017 17:54:01 +0200
> > 
> > For what it's worth I'd consider the refactoring patch (PATCH 1/2) quite
> > safe to merge in and would suggest prioritizing reviewing efforts on the
> > latter patch (PATCH 2/2) that contains the actual QOP feature.
> 
> Since no one seems to be interested to review this patch, I did that
> myself.  I have two comments:
> 
> > +(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\", ...'
> 
> Typo: should be "look", not "looks".
> 
> > +(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."
> 
> This function's doc string looks strikingly different from the rest of
> the functions you wrote: not as detailed and clear as the rest.  Can
> you rework it to be more in line with the rest of the functions?
> 
> With those minor issues fixed, I will push your changes.
> 
> Thanks.

Re: Refactor digest authentication in url-auth

[Jarno Malmari]

> Since no one seems to be interested to review this patch, I did that
> myself.  I have two comments:
>  
> > +(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\", ...'
>  
> Typo: should be "look", not "looks".

I decided the typo is in the plural form of "strings" since it describes the single return value. Fixed.

>  
> > +(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."
>  
> This function's doc string looks strikingly different from the rest of
> the functions you wrote: not as detailed and clear as the rest.  Can
> you rework it to be more in line with the rest of the functions?

Revised content:

(defun url-digest-find-new-key (url realm prompt)
  "Find credentials and create a new authorization key for given URL and REALM.

Return value is the new key, or nil if credentials weren't found.
\"New\" in this context means a key that's not yet found in cache
variable `url-digest-auth-storage'.  You may use `url-digest-cache-key'
to put it there.

This function uses `url-digest-find-creds' to find the
credentials.  It first looks in auth-source.  If not found, and
PROMPT is non-nil, user is asked for credentials interactively
via minibuffer."

>  
> With those minor issues fixed, I will push your changes.

Thanks! Update patches follow this mail.

[PATCH 1/2] Refactor digest authentication in url-auth

[Jarno Malmari]

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            | 351 ++++++++++++++++++++++++++++------------
 test/lisp/url/url-auth-tests.el |  35 ++++
 2 files changed, 286 insertions(+), 100 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 7b6cdd5..4c9a907 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -143,107 +143,258 @@ 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 string 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 credentials and create a new authorization key for given URL and REALM.
+
+Return value is the new key, or nil if credentials weren't found.
+\"New\" in this context means a key that's not yet found in cache
+variable `url-digest-auth-storage'.  You may use `url-digest-cache-key'
+to put it there.
+
+This function uses `url-digest-find-creds' to find the
+credentials.  It first looks in auth-source.  If not found, and
+PROMPT is non-nil, user is asked for credentials interactively
+via minibuffer."
+  (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

[PATCH 2/2] Initial implementation for HTTP Digest qop for url

[Jarno Malmari]

Some servers have dropped backward compatibility with HTTP Digest
Authentication without "qop".  The Quality Of Protection scheme is
partially implemented: only one supported qop (qop=auth), only one
supported algorithm (md5), nonce count remains always as 1 (no replays)
* lisp/url/url-auth.el (url-digest-auth-build-response): Hook up new
functionality, or fall back to previous.
(url-digest-auth-make-request-digest-qop):
(url-digest-auth-make-cnonce, url-digest-auth-nonce-count):
(url-digest-auth-name-value-string): Add new helper functions.
* test/lisp/url/url-auth-tests.el (url-auth-test-challenges):
(url-auth-test-digest-request-digest): Test the new implementation.
Parts of these were accidentally already merged in the past.
---
 lisp/url/url-auth.el            | 60 ++++++++++++++++++++++++++++++++++++-----
 test/lisp/url/url-auth-tests.el | 28 +++++++++++--------
 2 files changed, 71 insertions(+), 17 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 4c9a907..2885d4e 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -131,8 +131,8 @@ url-basic-auth
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Digest authorization code
 ;;; ------------------------
-;;; This implements the DIGEST authorization type.  See the internet draft
-;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; This implements the DIGEST authorization type.  See RFC 2617
+;;; https://www.ietf.org/rfc/rfc2617.txt
 ;;; for the complete documentation on this type.
 ;;;
 ;;; This is very secure
@@ -165,6 +165,16 @@ url-digest-auth-make-request-digest
 a password."
   (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
 
+(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
+  "Construct the request-digest with qop.
+QOP describes the \"quality of protection\" and algorithm to use.
+All of the strings QOP, HA1, HA2, NONCE, NC, and CNONCE are
+combined into a single hash value that proves to a server the
+user knows a password.  It's worth noting that HA2 already
+depends on value of QOP."
+  (url-digest-auth-kd (url-digest-auth-colonjoin
+                       nonce nc cnonce qop 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
@@ -179,6 +189,21 @@ url-digest-auth-server-id
 key cache `url-digest-auth-storage'."
   (format "%s:%d" (url-host url) (url-port url)))
 
+(defun url-digest-auth-make-cnonce ()
+  "Compute a new unique client nonce value."
+  (base64-encode-string
+   (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
+
+(defun url-digest-auth-nonce-count (nonce)
+  "The number requests sent to server with the given NONCE.
+This count includes the request we're preparing here.
+
+Currently, this is not implemented and will always return 1.
+
+Value returned is in string format with leading zeroes, such as
+\"00000001\"."
+  (format "%08x" 1))
+
 (defun url-digest-auth-name-value-string (pairs)
   "Concatenate name-value pairs in association list PAIRS.
 
@@ -284,12 +309,20 @@ url-digest-auth-build-response
 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."
+value.  It also might contain the optional \"opaque\" value.
+Newer implementations conforming to RFC 2617 should also contain
+qop (Quality Of Protection) and related attributes.
+
+Restrictions on Quality of Protection scheme: The qop value
+\"auth-int\" or algorithm any other than \"MD5\" are not
+implemented."
+
   (when key
     (let ((user (nth 1 key))
           (ha1 (nth 2 key))
           (ha2 (nth 3 key))
           (digest-uri (url-filename url))
+          (qop (cdr-safe (assoc "qop" attrs)))
           (nonce (cdr-safe (assoc "nonce" attrs)))
           (opaque (cdr-safe (assoc "opaque" attrs))))
 
@@ -299,9 +332,24 @@ url-digest-auth-build-response
         (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)))
+                      (cons 'uri digest-uri))
+
+                (cond
+                 ((null qop)
+                  (list (cons 'response (url-digest-auth-make-request-digest
+                                         ha1 ha2 nonce))))
+                 ((string= qop "auth")
+                  (let ((nc (url-digest-auth-nonce-count nonce))
+                        (cnonce (url-digest-auth-make-cnonce)))
+                    (list (cons 'qop qop)
+                          (cons 'nc nc)
+                          (cons 'cnonce cnonce)
+                          (cons 'response
+                                (url-digest-auth-make-request-digest-qop
+                                 qop ha1 ha2 nonce nc cnonce)))))
+                 (t (message "Quality of protection \"%s\" is not implemented." qop)
+                    nil))
+
 
                 (if opaque (list (cons 'opaque opaque)))))))))
 
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index a6b31d7..30636db 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -104,13 +104,21 @@ url-auth-test-challenges
                      (plist-get row :expected-ha2)))))
 
 (ert-deftest url-auth-test-digest-request-digest ()
-  "Check digest response value when not supporting `qop'."
+  "Check digest response value."
   (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)))))
+    (should (string= (plist-get row :expected-response)
+                     (if (plist-member row :qop)
+                         (url-digest-auth-make-request-digest-qop
+                          (plist-get row :qop)
+                          (plist-get row :expected-ha1)
+                          (plist-get row :expected-ha2)
+                          (plist-get row :nonce)
+                          (plist-get row :nc)
+                          (plist-get row :cnonce))
+                       (url-digest-auth-make-request-digest
+                        (plist-get row :expected-ha1)
+                        (plist-get row :expected-ha2)
+                        (plist-get row :nonce)))))))
 
 (ert-deftest url-auth-test-digest-create-key ()
   "Check user credentials in their hashed form."
@@ -258,14 +266,12 @@ url-auth-test-challenges
           (progn
             ;; We don't know these, just check that they exists.
             (should (string-match-p ".*response=\".*?\".*" auth))
-            ;; url-digest-auth doesn't return these AFAICS.
-;;;            (should (string-match-p ".*nc=\".*?\".*" auth))
-;;;            (should (string-match-p ".*cnonce=\".*?\".*" 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
-- 
2.7.0.25.gfc10eb5

Re: Refactor digest authentication in url-auth

[Eli Zaretskii]

> From: Jarno Malmari <jarno@malmari.fi>
> Cc: emacs-devel@gnu.org
> Date: Mon, 27 Mar 2017 22:47:25 +0300
> 
> > With those minor issues fixed, I will push your changes.
> 
> Thanks! Update patches follow this mail.

This is now pushed to the master branch.  Thank you for your work and
for persevering.

[PATCH 2/2] Initial implementation for HTTP Digest qop for url

[Jarno Malmari]

Some servers have dropped backward compatibility with HTTP Digest
Authentication without "qop". The Quality Of Protection scheme is
partially implemented: only one supported qop (qop=auth), only one
supported algorithm (md5), nonce count remains always as 1 (no replays)
* lisp/url/url-auth.el (url-digest-auth-build-response): Hook up new
functionality, or fall back to previous.
(url-digest-auth-make-request-digest-qop, url-digest-auth-make-cnonce,
url-digest-auth-nonce-count, url-digest-auth-name-value-string): Add new
helper functions.
* test/lisp/url/url-auth-tests.el (url-auth-test-digest-request-digest,
url-auth-test-challenges): Test the new implementation. Parts of these
were accidentally already merged in the past.
---
 lisp/url/url-auth.el            | 59 ++++++++++++++++++++++++++++++++++++-----
 test/lisp/url/url-auth-tests.el | 31 +++++++++++++---------
 2 files changed, 72 insertions(+), 18 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 52b2244..a48e511 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -131,8 +131,8 @@ url-basic-auth
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Digest authorization code
 ;;; ------------------------
-;;; This implements the DIGEST authorization type.  See the internet draft
-;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; This implements the DIGEST authorization type.  See RFC 2617
+;;; https://www.ietf.org/rfc/rfc2617.txt
 ;;; for the complete documentation on this type.
 ;;;
 ;;; This is very secure
@@ -167,6 +167,15 @@ url-digest-auth-make-request-digest
 Inputs for this are the hash strings HA1, HA2, and NONCE."
   (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
 
+(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
+  "Construct the request-digest with qop as described in RFC 2617.
+QOP describes the \"quality of protection\" and algorithm to use.
+HA1, HA2, and NONCE, NC, and CNONCE are string values, described
+in RFC 2617. It's worth noting that HA2 already depends on value
+of QOP."
+  (url-digest-auth-kd (url-digest-auth-colonjoin
+                       nonce nc cnonce qop ha2) ha1))
+
 (defsubst url-digest-auth-directory-id (url realm)
   "Make an identifier to use for server keys.
 The identifier is made either from URL's path or REALM."
@@ -177,6 +186,21 @@ url-digest-auth-server-id
 The identifier is made from URL's host and port."
   (format "%s:%d" (url-host url) (url-port url)))
 
+(defun url-digest-auth-make-cnonce ()
+  "Compute a new unique client nonce value."
+  (base64-encode-string
+   (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
+
+(defun url-digest-auth-nonce-count (nonce)
+  "The number requests sent to server with the given NONCE.
+This count includes the request we're preparing here.
+
+Currently, this is not implemented and will always return 1.
+
+Value returned is in string format with leading zeroes, such as
+\"00000001\"."
+  (format "%08x" 1))
+
 (defun url-digest-auth-name-value-string (pairs)
   "Concatenate name-value pairs in association list PAIRS.
 
@@ -281,12 +305,20 @@ url-digest-auth-build-response
 and contents of alist ATTRS.
 
 ATTRS is expected to contain at least the server's \"nonce\"
-value.  It also might contain the optional \"opaque\" value."
+value.  It also might contain the optional \"opaque\" value.
+Newer implementations conforming to RFC 2617 should also contain
+qop (Quality Of Protection) and related attributes.
+
+Restrictions on Quality of Protection scheme: The qop value
+\"auth-int\" or algorithm any other than \"MD5\" are not
+implemented."
+
   (when key
     (let ((user (nth 1 key))
           (ha1 (nth 2 key))
           (ha2 (nth 3 key))
           (digest-uri (url-filename url))
+          (qop (cdr-safe (assoc "qop" attrs)))
           (nonce (cdr-safe (assoc "nonce" attrs)))
           (opaque (cdr-safe (assoc "opaque" attrs))))
 
@@ -296,9 +328,24 @@ url-digest-auth-build-response
         (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)))
+                      (cons 'uri digest-uri))
+
+                (cond
+                 ((null qop)
+                  (list (cons 'response (url-digest-auth-make-request-digest
+                                         ha1 ha2 nonce))))
+                 ((string= qop "auth")
+                  (let ((nc (url-digest-auth-nonce-count nonce))
+                        (cnonce (url-digest-auth-make-cnonce)))
+                    (list (cons 'qop qop)
+                          (cons 'nc nc)
+                          (cons 'cnonce cnonce)
+                          (cons 'response
+                                (url-digest-auth-make-request-digest-qop
+                                 qop ha1 ha2 nonce nc cnonce)))))
+                 (t (message "Quality of protection \"%s\" is not implemented." qop)
+                    nil))
+
 
                 (if opaque (list (cons 'opaque opaque)))))))))
 
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index 3d3132b..58f60c4 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -104,14 +104,23 @@ url-auth-test-challenges
                      (plist-get row :expected-ha2)))))
 
 (ert-deftest url-auth-test-digest-request-digest ()
-  "Check digest response value when not supporting `qop'."
+  "Check digest response value."
   (dolist (row url-auth-test-challenges)
-    (should (string= (url-digest-auth-make-request-digest
-                      ;; HA1 and HA2 already tested
-                      (plist-get row :expected-ha1)
-                      (plist-get row :expected-ha2)
-                      (plist-get row :nonce))
-                     (plist-get row :expected-response)))))
+    (should (string= (plist-get row :expected-response)
+                     (if (plist-member row :qop)
+                         (url-digest-auth-make-request-digest-qop
+                          (plist-get row :qop)
+                          ;; HA1 and HA2 already tested
+                          (plist-get row :expected-ha1)
+                          (plist-get row :expected-ha2)
+                          (plist-get row :nonce)
+                          (plist-get row :nc)
+                          (plist-get row :cnonce))
+                       (url-digest-auth-make-request-digest
+                        ;; HA1 and HA2 already tested
+                        (plist-get row :expected-ha1)
+                        (plist-get row :expected-ha2)
+                        (plist-get row :nonce)))))))
 
 (ert-deftest url-auth-test-digest-create-key ()
   "Check user credentials in their hashed form."
@@ -259,14 +268,12 @@ url-auth-test-challenges
           (progn
             ;; We don't know these, just check that they exists.
             (should (string-match-p ".*response=\".*?\".*" auth))
-            ;; url-digest-auth doesn't return these AFAICS.
-;;;            (should (string-match-p ".*nc=\".*?\".*" auth))
-;;;            (should (string-match-p ".*cnonce=\".*?\".*" 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
-- 
2.7.0.25.gfc10eb5