1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
;;; oauth2.el --- OAuth 2.0 Authorization Protocol -*- lexical-binding:t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc
;; Author: Julien Danjou <julien@danjou.info>
;; Version: 0.17
;; Keywords: comm
;; Package-Requires: ((cl-lib "0.5") (nadvice "0.3"))
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Implementation of the OAuth 2.0 draft.
;;
;; The main entry point is `oauth2-auth-and-store' which will return a token
;; structure. This token structure can be then used with
;; `oauth2-url-retrieve-synchronously' or `oauth2-url-retrieve' to retrieve
;; any data that need OAuth authentication to be accessed.
;;
;; If the token needs to be refreshed, the code handles it automatically and
;; store the new value of the access token.
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'plstore)
(require 'json)
(require 'url-http)
(defvar url-http-data)
(defvar url-http-method)
(defvar url-http-extra-headers)
(defvar url-callback-arguments)
(defvar url-callback-function)
(defgroup oauth2 nil
"OAuth 2.0 Authorization Protocol."
:group 'comm
:link '(url-link :tag "Savannah" "https://git.savannah.gnu.org/cgit/emacs/elpa.git/tree/?h=externals/oauth2")
:link '(url-link :tag "ELPA" "https://elpa.gnu.org/packages/oauth2.html"))
(defvar oauth2-debug nil
"Enable verbose logging in oauth2 to help debugging.")
(defun oauth2--do-debug (&rest msg)
"Output debug messages when `oauth2-debug' is enabled."
(when oauth2-debug
(setcar msg (concat "[oauth2] " (car msg)))
(apply #'message msg)))
(defun oauth2-request-authorization (auth-url client-id &optional scope state redirect-uri)
"Request OAuth authorization at AUTH-URL by launching `browse-url'.
CLIENT-ID is the client id provided by the provider.
It returns the code provided by the service."
(let ((url (concat auth-url
(if (string-match-p "\?" auth-url) "&" "?")
"client_id=" (url-hexify-string client-id)
"&response_type=code"
"&redirect_uri=" (url-hexify-string (or redirect-uri "urn:ietf:wg:oauth:2.0:oob"))
(if scope (concat "&scope=" (url-hexify-string scope)) "")
(if state (concat "&state=" (url-hexify-string state)) "")
;; The following two parameters are required for Gmail
;; OAuth2 to generate the refresh token
"&access_type=offline"
"&prompt=consent")))
(browse-url url)
(read-string (concat "Follow the instruction on your default browser, or "
"visit:\n" url
"\nEnter the code your browser displayed: "))))
(defun oauth2-request-access-parse ()
"Parse the result of an OAuth request."
(goto-char (point-min))
(when (search-forward-regexp "^$" nil t)
(json-read)))
(defun oauth2-make-access-request (url data)
"Make an access request to URL using DATA in POST."
(let ((func-name (nth 1 (backtrace-frame 2))))
(oauth2--do-debug "%s: url: %s" func-name url)
(oauth2--do-debug "%s: data: %s" func-name data)
(let ((url-request-method "POST")
(url-request-data data)
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(with-current-buffer (url-retrieve-synchronously url)
(let ((data (oauth2-request-access-parse)))
(kill-buffer (current-buffer))
(oauth2--do-debug "%s: response: %s" func-name (prin1-to-string data))
data)))))
(cl-defstruct oauth2-token
plstore
plstore-id
client-id
client-secret
access-token
refresh-token
token-url
access-response)
(defun oauth2-request-access (token-url client-id client-secret code &optional redirect-uri)
"Request OAuth access at TOKEN-URL.
The CODE should be obtained with `oauth2-request-authorization'.
Return an `oauth2-token' structure."
(when code
(let ((result
(oauth2-make-access-request
token-url
(url-encode-url
(concat
"client_id=" client-id
(when client-secret
(concat "&client_secret=" client-secret))
"&code=" code
"&redirect_uri=" (or redirect-uri "urn:ietf:wg:oauth:2.0:oob")
"&grant_type=authorization_code")))))
(make-oauth2-token :client-id client-id
:client-secret client-secret
:access-token (cdr (assoc 'access_token result))
:refresh-token (cdr (assoc 'refresh_token result))
:token-url token-url
:access-response result))))
;;;###autoload
(defun oauth2-refresh-access (token)
"Refresh OAuth access TOKEN.
TOKEN should be obtained with `oauth2-request-access'."
(setf (oauth2-token-access-token token)
(cdr (assoc 'access_token
(oauth2-make-access-request
(oauth2-token-token-url token)
(concat "client_id=" (oauth2-token-client-id token)
(when (oauth2-token-client-secret token)
(concat "&client_secret=" (oauth2-token-client-secret token)))
"&refresh_token=" (oauth2-token-refresh-token token)
"&grant_type=refresh_token")))))
;; If the token has a plstore, update it
(let ((plstore (oauth2-token-plstore token)))
(when plstore
(plstore-put plstore (oauth2-token-plstore-id token)
nil `(:access-token
,(oauth2-token-access-token token)
:refresh-token
,(oauth2-token-refresh-token token)
:access-response
,(oauth2-token-access-response token)
))
(plstore-save plstore)))
token)
;;;###autoload
(defun oauth2-auth (auth-url token-url client-id client-secret &optional scope state redirect-uri)
"Authenticate application via OAuth2."
(oauth2-request-access
token-url
client-id
client-secret
(oauth2-request-authorization
auth-url client-id scope state redirect-uri)
redirect-uri))
(defcustom oauth2-token-file (concat user-emacs-directory "oauth2.plstore")
"File path where store OAuth tokens."
:group 'oauth2
:type 'file)
(defun oauth2-compute-id (auth-url token-url scope client-id)
"Compute an unique id based on URLs.
This allows to store the token in an unique way."
(secure-hash 'sha512 (concat auth-url token-url scope client-id)))
;;;###autoload
(defun oauth2-auth-and-store (auth-url token-url scope client-id client-secret &optional redirect-uri state)
"Request access to a resource and store it using `plstore'."
;; We store a MD5 sum of all URL
(let* ((plstore (plstore-open oauth2-token-file))
(id (oauth2-compute-id auth-url token-url scope client-id))
(plist (cdr (plstore-get plstore id))))
;; Check if we found something matching this access
(if plist
;; We did, return the token object
(make-oauth2-token :plstore plstore
:plstore-id id
:client-id client-id
:client-secret client-secret
:access-token (plist-get plist :access-token)
:refresh-token (plist-get plist :refresh-token)
:token-url token-url
:access-response (plist-get plist :access-response))
(let ((token (oauth2-auth auth-url token-url
client-id client-secret scope state redirect-uri)))
;; Set the plstore
(setf (oauth2-token-plstore token) plstore)
(setf (oauth2-token-plstore-id token) id)
(plstore-put plstore id nil `(:access-token
,(oauth2-token-access-token token)
:refresh-token
,(oauth2-token-refresh-token token)
:access-response
,(oauth2-token-access-response token)))
(plstore-save plstore)
token))))
(defun oauth2-url-append-access-token (token url)
"Append access token to URL."
(concat url
(if (string-match-p "\?" url) "&" "?")
"access_token=" (oauth2-token-access-token token)))
(defvar oauth--url-advice nil)
(defvar oauth--token-data)
(defun oauth2-authz-bearer-header (token)
"Return `Authoriztions: Bearer' header with TOKEN."
(cons "Authorization" (format "Bearer %s" token)))
(defun oauth2-extra-headers (extra-headers)
"Return EXTRA-HEADERS with `Authorization: Bearer' added."
(cons (oauth2-authz-bearer-header (oauth2-token-access-token (car oauth--token-data)))
extra-headers))
;; FIXME: We should change URL so that this can be done without an advice.
(defun oauth2--url-http-handle-authentication-hack (orig-fun &rest args)
(if (not oauth--url-advice)
(apply orig-fun args)
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers
(oauth2-extra-headers url-http-extra-headers)))
(oauth2-refresh-access (car oauth--token-data))
(url-retrieve-internal (cdr oauth--token-data)
url-callback-function
url-callback-arguments)
;; This is to make `url' think it's done.
(when (boundp 'success) (setq success t)) ;For URL library in Emacs<24.4.
t))) ;For URL library in Emacsā„24.4.
(advice-add 'url-http-handle-authentication :around
#'oauth2--url-http-handle-authentication-hack)
;;;###autoload
(defun oauth2-url-retrieve-synchronously (token url &optional request-method request-data request-extra-headers)
"Retrieve an URL synchronously using TOKEN to access it.
TOKEN can be obtained with `oauth2-auth'."
(let* ((oauth--token-data (cons token url)))
(let ((oauth--url-advice t) ;Activate our advice.
(url-request-method request-method)
(url-request-data request-data)
(url-request-extra-headers
(oauth2-extra-headers request-extra-headers)))
(url-retrieve-synchronously url))))
;;;###autoload
(defun oauth2-url-retrieve (token url callback &optional
cbargs
request-method request-data request-extra-headers)
"Retrieve an URL asynchronously using TOKEN to access it.
TOKEN can be obtained with `oauth2-auth'. CALLBACK gets called with CBARGS
when finished. See `url-retrieve'."
;; TODO add support for SILENT and INHIBIT-COOKIES. How to handle this in `url-http-handle-authentication'.
(let* ((oauth--token-data (cons token url)))
(let ((oauth--url-advice t) ;Activate our advice.
(url-request-method request-method)
(url-request-data request-data)
(url-request-extra-headers
(oauth2-extra-headers request-extra-headers)))
(url-retrieve url callback cbargs))))
(provide 'oauth2)
;;; oauth2.el ends here
|
