branch: externals/url-http-oauth
commit ee73bb045021eeef119ed638f61226fdcd011ed1
Author: Thomas Fitzsimmons <fitz...@fitzsim.org>
Commit: Thomas Fitzsimmons <fitz...@fitzsim.org>
Make functions private, fix some bugs
* url-http-oauth.el (url-http-oauth--url-string)
(url-http-oauth--url-object, url-http-oauth--url-no-query)
(url-http-oauth--settings, url-http-oauth--update-regexp)
(url-http-oauth--port, url-http-oauth--auth-info-password)
(url-http-oauth--json-parse-buffer)
(url-http-oauth--auth-source-search)
(url-http-oauth--parse-grant)
(url-http-oauth--get-access-token-grant)
(url-http-oauth--expiry-string)
(url-http-oauth--refresh-token-string)
(url-http-oauth--extract-authorization-code)
(url-http-oauth--authorization-url)
(url-http-oauth--url-build-refresh)
(url-http-oauth--netrc-delete, url-http-oauth--save-bearer)
(url-http-oauth--refresh-access-token-grant)
(url-http-oauth--retrieve-and-save-bearer)
(url-http-oauth--get-bearer): Rename to indicate private scope.
(url-http-oauth--parse-grant): Dump grant buffer contents to
messages buffer. Fix downcase typo. Fix error message format.
(url-http-oauth--get-access-token-grant): Save access-token-url to
auth-sources. Fix access-token-object typo.
(url-http-oauth--expiry-string): Use "expires_on" for absolute
expiry time.
(url-http-oauth--refresh-token-string): Fix copy-n-paste error.
(url-http-oauth--authorization-url): Wrap a long line.
(url-http-oauth--url-build-refresh): Wrap some long lines.
(url-http-oauth--netrc-delete): Use pos-bol and pos-eol.
(url-http-oauth--refresh-access-token-grant): Update docstring.
(url-http-oauth--retrieve-and-save-bearer): Fix docstring.
(url-http-oauth-get-bearer): Simplify resource-url handling.
---
url-http-oauth.el | 190 ++++++++++++++++++++++++++----------------------------
1 file changed, 93 insertions(+), 97 deletions(-)
diff --git a/url-http-oauth.el b/url-http-oauth.el
index 5d141674c2..5394846391 100644
--- a/url-http-oauth.el
+++ b/url-http-oauth.el
@@ -37,8 +37,6 @@
(require 'url-util)
(require 'json)
-;; FIXME: make functions private.
-
(defvar url-http-oauth--interposed nil
"A list of OAuth 2.0 settings association lists.")
@@ -47,20 +45,20 @@
If a URL matches this regular expression, `url' will use this
`url-http-oauth' to access resources at the URL via OAuth 2.0.")
-(defun url-http-oauth-url-string (url)
+(defun url-http-oauth--url-string (url)
"Return URL as a string.
URL is string or an object."
(if (stringp url) url (url-recreate-url url)))
-(defun url-http-oauth-url-object (url)
+(defun url-http-oauth--url-object (url)
"Return URL as a parsed URL object.
URL is a string or an object."
(if (stringp url) (url-generic-parse-url url) url))
-(defun url-http-oauth-url-no-query (url)
+(defun url-http-oauth--url-no-query (url)
"Return an object representing URL with no query components.
URL is a string or an object."
- (let ((url (url-http-oauth-url-object url)))
+ (let ((url (url-http-oauth--url-object url)))
(url-parse-make-urlobj
(url-type url)
nil nil
@@ -69,10 +67,10 @@ URL is a string or an object."
(car (url-path-and-query url))
nil nil t)))
-(defun url-http-oauth-settings (url)
+(defun url-http-oauth--settings (url)
"Return a settings list if URL needs OAuth 2.0, nil otherwise.
URL is an object or a string."
- (let* ((url (url-http-oauth-url-string url)))
+ (let* ((url (url-http-oauth--url-string url)))
(catch 'found
(dolist (settings url-http-oauth--interposed)
(when (or (string-prefix-p (cdr (assoc "resource-url" settings)) url)
@@ -83,7 +81,7 @@ URL is an object or a string."
(throw 'match t)))))
(throw 'found settings))))))
-(defun url-http-oauth-update-regexp ()
+(defun url-http-oauth--update-regexp ()
"Update `url-http-oauth--interposed-regexp'."
(let (all-urls)
(dolist (settings url-http-oauth--interposed)
@@ -138,7 +136,7 @@ REDIRECT_URI."
(error "Unrecognized client-secret-method value"))
(prog1
(add-to-list 'url-http-oauth--interposed url-settings)
- (url-http-oauth-update-regexp))))
+ (url-http-oauth--update-regexp))))
(defun url-http-oauth-uninterpose (url-settings)
"Arrange for Emacs not to use OAuth 2.0 when accessing URL in URL-SETTINGS.
@@ -146,33 +144,28 @@ This function does the opposite of
`url-http-oauth-interpose'."
(prog1
(setq url-http-oauth--interposed
(delete url-settings url-http-oauth--interposed))
- (url-http-oauth-update-regexp)))
+ (url-http-oauth--update-regexp)))
(defun url-http-oauth-interposed-p (url)
"Return non-nil if `url' will use OAuth 2.0 to access URL.
URL is an object."
(string-match-p url-http-oauth--interposed-regexp
- (url-http-oauth-url-string url)))
+ (url-http-oauth--url-string url)))
(defvar url-http-response-status)
(defvar auth-source-creation-prompts)
-;; FIXME: if anything goes wrong during the authentication steps,
-;; `url-http-end-of-document-sentinel' calls back into
-;; `url-oauth-auth' somehow. Maybe `url-http-no-retry' can help here?
-(defvar url-http-no-retry)
-
-(defun url-http-oauth-port (url)
+(defun url-http-oauth--port (url)
"Return port of URL.
Assume an HTTPS URL that does not specify a port uses 443. URL
is a string or an object."
- (let ((port-number (url-port (url-http-oauth-url-object url))))
+ (let ((port-number (url-port (url-http-oauth--url-object url))))
(if port-number
(number-to-string port-number)
(when (string= "https" (url-type url)) "443"))))
;; Backport of `auth-info-password'.
-(defun url-http-oauth-auth-info-password (auth-info)
+(defun url-http-oauth--auth-info-password (auth-info)
"Return the :secret password from the AUTH-INFO."
(let ((secret (plist-get auth-info :secret)))
(if (functionp secret)
@@ -180,14 +173,14 @@ is a string or an object."
secret)))
;; Backport (roughly) of `json-parse-buffer'.
-(defun url-http-oauth-json-parse-buffer ()
+(defun url-http-oauth--json-parse-buffer ()
"See `json-parse-buffer'."
(let ((json-object-type 'hash-table))
(json-read-from-string
(buffer-substring (point) (point-max)))))
-(defun url-http-oauth-auth-source-search (url &optional user secret prompt
- expiry refresh-token)
+(defun url-http-oauth--auth-source-search (url &optional user secret prompt
+ expiry refresh-token)
"Find the `auth-source' entry for USER and URL.
Arrange for the entry to be created if it is not already saved in
on of `auth-sources'. URL is a string or an object. USER is a
@@ -215,9 +208,9 @@ server to receive a new access token."
;; arbitrary fields would have too many forward
;; and backward compatibility implications for
;; netrc-formatted authinfo files.
- :host ,(url-http-oauth-url-string
- (url-http-oauth-url-no-query url))
- :port ,(url-http-oauth-port url)
+ :host ,(url-http-oauth--url-string
+ (url-http-oauth--url-no-query url))
+ :port ,(url-http-oauth--port url)
,@(when secret (list :secret secret))
,@(when expiry (list :expiry expiry))
,@(when refresh-token
@@ -227,27 +220,24 @@ server to receive a new access token."
(let ((auth-source-do-cache nil)) ; Do not cache nil result.
(apply #'auth-source-search spec)))))
-;; This monstrosity is required because the `auth-source' netrc
-;; backend does not support deletion, yet we need to refresh the
-;; bearer token.
-
(defun url-http-oauth--parse-grant ()
"Parse the JSON grant structure in the current buffer.
Return the parsed JSON object."
+ (message "url-http-oauth grant: %s" (buffer-string))
(progn
(goto-char (point-min))
(re-search-forward "\n\n")
- (let* ((grant (url-http-oauth-json-parse-buffer))
+ (let* ((grant (url-http-oauth--json-parse-buffer))
(type (gethash "token_type" grant)))
- (unless (equal (dowcase type) "bearer" )
- (error "Unrecognized token type %s for %s" type url-settings))
+ (unless (equal (downcase type) "bearer")
+ (error "Unrecognized token type %s" type))
;; Return grant object.
grant)))
-(defun url-http-oauth-get-access-token-grant (url-settings code)
+(defun url-http-oauth--get-access-token-grant (url-settings code)
"Get an access token for using CODE.
-URL-SETTINGS are OAuth 2.0 settings needed by URL."
- ;; (message "url-http-oauth-get-access-token-grant: %S, %S" url-settings
code)
+URL-SETTINGS contain the client identifier and access token
+endpoint."
(let* ((url-request-method "POST")
(access-token-url (cdr (assoc "access-token-endpoint" url-settings)))
(client-identifier (cdr (assoc "client-identifier" url-settings)))
@@ -255,9 +245,10 @@ URL-SETTINGS are OAuth 2.0 settings needed by URL."
url-settings)))
(auth-result
(when client-secret-method
- (url-http-oauth-auth-source-search
- url client-identifier "Client secret for %u at %h: ")))
- (client-secret (url-http-oauth-auth-info-password auth-result))
+ (url-http-oauth--auth-source-search
+ access-token-url client-identifier
+ "Client secret for %u at %h: ")))
+ (client-secret (url-http-oauth--auth-info-password auth-result))
(save-function (plist-get auth-result :save-function))
(authorization (when client-secret
(concat
@@ -275,33 +266,33 @@ URL-SETTINGS are OAuth 2.0 settings needed by URL."
(url-request-data
(url-build-query-string
(apply #'list (list "code" code)
- (list "client_id" client-identifier)
- (list "grant_type" "authorization_code")
- (when redirect-uri
- (list (list "redirect_uri" redirect-uri)))))))
- ;; (message "URL: %S\nAUTH: %S\nDAT: %S" url-settings authorization
url-request-data)
- (with-current-buffer (url-retrieve-synchronously access-token-object)
- ;; (message "GRANT BUFFER: %S" (buffer-string))
+ (list "client_id" client-identifier)
+ (list "grant_type" "authorization_code")
+ (when redirect-uri
+ (list (list "redirect_uri" redirect-uri)))))))
+ (with-current-buffer (url-retrieve-synchronously access-token-url)
(if (eq 'OK (car (alist-get url-http-response-status url-http-codes)))
(prog1
(url-http-oauth--parse-grant)
;; Success, so save client secret, if necessary.
(when (functionp save-function)
- (funcall save-function))
+ (funcall save-function)))
(error "url-http-oauth: Failed to get access token with %s"
(buffer-string))))))
-(defun url-http-oauth-expiry-string (grant)
+(defun url-http-oauth--expiry-string (grant)
"Return as a string a number representing the expiry time of GRANT.
The time is in seconds since the epoch."
- (format-time-string "%s" (time-add nil (gethash "expires_in" grant))))
+ (let ((expiry (gethash "expires_on" grant)))
+ (unless expiry (error "Did not find expiry time in grant"))
+ expiry))
-(defun url-http-oauth-refresh-token-string (grant)
+(defun url-http-oauth--refresh-token-string (grant)
"Return the refresh token from GRANT.
The refresh token is an opaque string."
- (format-time-string "%s" (time-add nil (gethash "refresh_token" grant))))
+ (gethash "refresh_token" grant))
-(defun url-http-oauth-extract-authorization-code (url)
+(defun url-http-oauth--extract-authorization-code (url)
"Extract the value of the code parameter in URL."
(let ((query (cdr (url-path-and-query (url-generic-parse-url url)))))
(unless query
@@ -311,7 +302,7 @@ The refresh token is an opaque string."
(error "url-http-oauth: Failed to find code in query component"))
code)))
-(defun url-http-oauth-authorization-url (url-settings)
+(defun url-http-oauth--authorization-url (url-settings)
"Return the authorization URL for URL-SETTINGS."
(let ((base (cdr (assoc "authorization-endpoint" url-settings)))
(client
@@ -320,23 +311,26 @@ The refresh token is an opaque string."
(scope (list "scope" (cdr (assoc "scope" url-settings))))
(extra (mapcar (lambda (entry)
(list (car entry) (cdr entry)))
- (cdr (assoc "authorization-extra-arguments" url-settings)))))
+ (cdr (assoc "authorization-extra-arguments"
+ url-settings)))))
(concat base "?" (url-build-query-string
(apply #'list client response-type scope extra)))))
-(defun url-http-oauth-url-build-refresh (url-settings)
+(defun url-http-oauth--url-build-refresh (url-settings)
"Build a refresh token URL query string from URL-SETTINGS."
(let* ((client-identifier (cdr (assoc "client-identifier" url-settings)))
- (authorization-extra-arguments (cdr (assoc
"authorization-extra-arguments" url-settings)))
+ (authorization-extra-arguments
+ (cdr (assoc "authorization-extra-arguments" url-settings)))
(resource (cdr (assoc "resource" authorization-extra-arguments)))
- (redirect-uri (cdr (assoc "redirect_uri"
authorization-extra-arguments))))
+ (redirect-uri
+ (cdr (assoc "redirect_uri" authorization-extra-arguments))))
(url-build-query-string
(apply #'list
(let ((resource-url
(cdr (assoc "resource-url" url-settings))))
(list "refresh_token"
(or (plist-get
- (url-http-oauth-auth-source-search resource-url)
+ (url-http-oauth--auth-source-search resource-url)
:refresh-token)
(error "Failed to retrieve refresh token for %s"
resource-url))))
@@ -346,6 +340,9 @@ The refresh token is an opaque string."
(when redirect-uri
(list (list "redirect_uri" redirect-uri)))))))
+;; This monstrosity is required because the `auth-source' netrc
+;; backend does not support deletion, yet we need to refresh the
+;; bearer token.
(defun url-http-oauth--netrc-delete (host &optional user port)
"Delete a netrc entry matching HOST, USER and PORT.
Delete the first matching line from any `auth-source' backend.
@@ -378,7 +375,6 @@ The entry is cleared from the `password-data' cache after
the
(setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
;; we want the new data to be found first, so insert at beginning
(goto-char (point-min))
-
;; Ask AFTER we've successfully opened the file.
(let* ((allow-null t)
(start-point (point-min))
@@ -422,17 +418,17 @@ The entry is cleared from the `password-data' cache after
the
(message "prior start point: %s" prior-start-point)
(goto-char prior-start-point)
(auth-source-netrc-parse-next-interesting)
- (goto-char (point-at-bol))
+ (goto-char (pos-bol))
(let ((extents
(if (bobp)
(progn
- (goto-char (point-at-eol))
+ (goto-char (pos-eol))
(if (eobp)
- (cons (point-at-bol) (point-at-eol))
- (cons (point-at-bol) (1+ (point-at-eol)))))
+ (cons (pos-bol) (pos-eol))
+ (cons (pos-bol) (1+ (pos-eol)))))
(progn
- (goto-char (point-at-eol))
- (cons (1- (point-at-bol)) (point-at-eol))))))
+ (goto-char (pos-eol))
+ (cons (1- (pos-bol)) (pos-eol))))))
(let ((region-to-delete (buffer-substring (car extents)
(cdr extents))))
(when (or (not (eq auth-source-save-behavior 'ask))
@@ -440,8 +436,8 @@ The entry is cleared from the `password-data' cache after
the
region-to-delete)))
(delete-region (car extents) (cdr extents))
(write-region (point-min) (point-max) file nil 'silent)
- ;; Make the .authinfo file non-world-readable.
- (set-file-modes file #o600)
+ ;; Make the .authinfo file non-world-readable.
+ (set-file-modes file #o600)
(auth-source-do-debug
"auth-source-netrc-create: deleted region %S from %s"
region-to-delete file)
@@ -450,17 +446,17 @@ The entry is cleared from the `password-data' cache after
the
:port (or port t)))
nil)))))))))))
-(defun url-http-oauth-save-bearer (url grant)
+(defun url-http-oauth--save-bearer (url grant)
"Save bearer access token for URL from GRANT.
URL is a string or an object. GRANT is a parsed JSON object.
Save the bearer token to `auth-sources' then return it."
(url-http-oauth--netrc-delete url)
(let* ((bearer-retrieved (gethash "access_token" grant))
(auth-result
- (url-http-oauth-auth-source-search
+ (url-http-oauth--auth-source-search
url nil bearer-retrieved nil
- (url-http-oauth-expiry-string grant)
- (url-http-oauth-refresh-token-string grant)))
+ (url-http-oauth--expiry-string grant)
+ (url-http-oauth--refresh-token-string grant)))
(save-function (plist-get auth-result :save-function)))
(when (functionp save-function)
(funcall save-function))
@@ -471,53 +467,53 @@ Save the bearer token to `auth-sources' then return it."
;; client_id="00000000-0000-0000-0000-000000000000",
;; trusted_issuers="00000000-0000-0000-0000-000000000000@*",
;; token_types="app_asserted_user_v1 service_asserted_app_v1",
-(defun url-http-oauth-refresh-access-token-grant (url-settings)
- "Refresh the access token for URL."
;; authorization_uri=
;; "https://login.microsoftonline.com/common/oauth2/authorize";,
;; error="invalid_token",Basic Realm="" in which case, call refresh on
;; URL before proceeding.
+(defun url-http-oauth--refresh-access-token-grant (url-settings)
+ "Refresh access token using URL-SETTINGS."
(let* ((url-request-method "POST")
(access-token-url (cdr (assoc "access-token-endpoint" url-settings)))
- (url-request-data (url-http-oauth-url-build-refresh url-settings)))
- ;; (message "URL: %S\nREQ: %S" url url-request-data)
+ (url-request-data (url-http-oauth--url-build-refresh url-settings)))
(with-current-buffer (url-retrieve-synchronously access-token-url)
(if (eq 'OK (car (alist-get url-http-response-status url-http-codes)))
(url-http-oauth--parse-grant)
(error "url-http-oauth: Failed to get access token with %s"
(buffer-string))))))
-(defun url-http-oauth-retrieve-and-save-bearer (url url-settings)
- "Retrieve the bearer token required to access resources needing URL-SETTINGS.
+(defun url-http-oauth--retrieve-and-save-bearer (url url-settings)
+ "Retrieve the bearer token required for URL, using URL-SETTINGS.
Save the bearer token to `auth-sources' upon success."
(let* ((response-url
;; FIXME: Make this a per-provider function.
(read-from-minibuffer
(format "Browse to %s and paste the redirected code URL: "
- (url-http-oauth-authorization-url url-settings))))
+ (url-http-oauth--authorization-url url-settings))))
(code
- (url-http-oauth-extract-authorization-code response-url))
- (grant (url-http-oauth-get-access-token-grant url-settings code)))
- (url-http-oauth-save-bearer url grant)))
+ (url-http-oauth--extract-authorization-code response-url))
+ (grant (url-http-oauth--get-access-token-grant url-settings code)))
+ (url-http-oauth--save-bearer url grant)))
-(defun url-http-oauth-get-bearer (url)
+;; FIXME: if anything goes wrong during the authentication steps,
+;; `url-http-end-of-document-sentinel' calls back into
+;; `url-oauth-auth' somehow. Maybe `url-http-no-retry' can help here?
+(defun url-http-oauth--get-bearer (url)
"Prompt the user with the authorization endpoint for URL.
URL is a parsed object."
- (let* ((url-settings (url-http-oauth-settings url))
- (url (url-http-oauth-url-object url))
- (path-and-query (url-path-and-query url))
- (path (car path-and-query)))
- (unless url-settings
- (error "%s is not interposed by url-http-oauth"
- (url-http-oauth-url-string url)))
- (let ((expiry (plist-get (url-http-oauth-auth-source-search url) :expiry)))
- (when (and expiry (> (time-to-seconds) expiry))
- (url-http-oauth-save-bearer
- url (url-http-oauth-refresh-access-token-grant url-settings))))
- (let ((bearer-current (url-http-oauth-auth-info-password
- (url-http-oauth-auth-source-search url))))
+ (let* ((url-settings (url-http-oauth--settings url))
+ (resource-url (cdr (assoc "resource-url" url-settings))))
+ (let ((expiry (plist-get (url-http-oauth--auth-source-search resource-url)
+ :expiry)))
+ (when (and expiry (> (time-to-seconds) (string-to-number expiry)))
+ (url-http-oauth--save-bearer
+ resource-url
+ (url-http-oauth--refresh-access-token-grant url-settings))))
+ (let ((bearer-current (url-http-oauth--auth-info-password
+ (url-http-oauth--auth-source-search resource-url))))
(or bearer-current
- (url-http-oauth-retrieve-and-save-bearer url-settings)))))
+ (url-http-oauth--retrieve-and-save-bearer resource-url
+ url-settings)))))
;;; Public function called by `url-get-authentication'.
;;;###autoload
@@ -527,7 +523,7 @@ URL is an object representing a parsed URL. It should
specify a
user, and contain a \"scope\" query argument representing the
permissions that the caller is requesting."
(when (url-http-oauth-interposed-p url)
- (let ((bearer (url-http-oauth-get-bearer url)))
+ (let ((bearer (url-http-oauth--get-bearer url)))
(if bearer
(concat "Bearer " bearer)
(error "Bearer retrieval failed for %s" url)))))
