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

[Jarno Malmari <jarno@malmari.fi>]

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