[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