[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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

From: Jarno Malmari
Subject: [PATCH 1/2] Refactor digest authentication in url-auth
Date: 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
* 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
+  (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
+  (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
+  (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
+  (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
+  (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") 
+(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)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]