From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Jarno Malmari Newsgroups: gmane.emacs.devel Subject: [PATCH 1/2] Refactor digest authentication in url-auth Date: Tue, 14 Feb 2017 23:12:56 +0200 Message-ID: <1487106777-17025-2-git-send-email-jarno@malmari.fi> References: <1487106777-17025-1-git-send-email-jarno@malmari.fi> NNTP-Posting-Host: blaine.gmane.org X-Trace: blaine.gmane.org 1487106914 13256 195.159.176.226 (14 Feb 2017 21:15:14 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 14 Feb 2017 21:15:14 +0000 (UTC) Cc: eliz@gnu.org To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Feb 14 22:15:09 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cdkRF-0002cu-0w for ged-emacs-devel@m.gmane.org; Tue, 14 Feb 2017 22:15:05 +0100 Original-Received: from localhost ([::1]:37193 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cdkRH-0006y4-Kb for ged-emacs-devel@m.gmane.org; Tue, 14 Feb 2017 16:15:07 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43571) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cdkQO-0006wP-8N for emacs-devel@gnu.org; Tue, 14 Feb 2017 16:14:14 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cdkQL-0003lD-Un for emacs-devel@gnu.org; Tue, 14 Feb 2017 16:14:12 -0500 Original-Received: from out1-smtp.messagingengine.com ([66.111.4.25]:37505) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cdkQH-0003eF-8j; Tue, 14 Feb 2017 16:14:05 -0500 Original-Received: from compute6.internal (compute6.nyi.internal [10.202.2.46]) by mailout.nyi.internal (Postfix) with ESMTP id AB5D0211BA; Tue, 14 Feb 2017 16:14:03 -0500 (EST) Original-Received: from frontend1 ([10.202.2.160]) by compute6.internal (MEProxy); Tue, 14 Feb 2017 16:14:03 -0500 DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=malmari.fi; h=cc :date:from:in-reply-to:message-id:references:subject:to :x-me-sender:x-me-sender:x-sasl-enc:x-sasl-enc; s=mesmtp; bh=zcV RZByRvOpY3YkQ7SdJ4j5ifpA=; b=CuA9QsB2gMbNohw15SANJKnHsCqoJy35QPk Sq+6aGkn2juIAzeZW2ZVRvoCM8h3u0S8yKkGmfz42NOExsyL9/Fm38GhBasErQfx Xr1t6BISYg3EwLKyo2/zj7lvG7M+0VNO4H1aZaZwGXd1G63n8sDT/9fREpcGe7At MkLae4Ig= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d= messagingengine.com; h=cc:date:from:in-reply-to:message-id :references:subject:to:x-me-sender:x-me-sender:x-sasl-enc :x-sasl-enc; s=smtpout; bh=zcVRZByRvOpY3YkQ7SdJ4j5ifpA=; b=bJqkz JGvJrnMzMnVgp5fVbqZYvg0OaKso8+luG1u4S7fU4O8YtiHmU6uvqsRDtndAw8/y Znhj5F3TuWXt5mcKIwJlG4ZwgIndVpyCg/10YFS95IFnMepSYwwsCqOrbrjHanUS 9bn+VVGo+gtnv9GymmOGcMIZC84FFD4bw5FfzQ= X-ME-Sender: X-Sasl-enc: jf7GVkhuQ8jSkhIT56qG66yQEI5wwEYtYDjWURVJzoFQ 1487106843 Original-Received: from vabi.peto.intranet (a88-113-156-118.elisa-laajakaista.fi [88.113.156.118]) by mail.messagingengine.com (Postfix) with ESMTPA id E7F117E429; Tue, 14 Feb 2017 16:14:02 -0500 (EST) X-Mailer: git-send-email 2.7.0.25.gfc10eb5 In-Reply-To: <1487106777-17025-1-git-send-email-jarno@malmari.fi> X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 66.111.4.25 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:212386 Archived-At: 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