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
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
|
;;; rest.el --- library for interacting with restful web APIs -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; Keywords: comm
;; This program 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.
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'cl-lib)
(require 'subr-x)
(require 'url)
;;; Error reporting
(defun rest-report-buffer ()
"Write TEXT to the *Api Server* buffer."
(let ((text (buffer-string)))
(with-current-buffer (get-buffer-create "*Api Report*")
(let ((inhibit-read-only t))
(erase-buffer)
(insert text))
(goto-char (point-min)))))
(define-error 'rest-error "Unkown REST error, see \"*Api Report*\" buffer")
(define-error 'rest-page-does-not-exist
"This page doesn't seem to exist (see \"*Api Report*\" buffer), replied said"
'rest-error)
(define-error 'rest-empty-redirect
"Redirect received, but Location header not found! (see \"*Api Report*\" buffer)"
'rest-error)
(define-error 'rest-unintelligible-result
"Tried contacting server, but I can't understand the reply. See \"*Api Report*\" buffer"
'rest-error)
(define-error 'rest-bad-request
"Server didn't understand my request, please you should probably file a bug report"
'rest-error)
(define-error 'rest-unauthorized
"Server says you're not authenticated"
'rest-error)
(define-error 'rest-infinite-redirection-loop
"Server is sending us in a redirection loop"
'rest-error)
(define-error 'rest-server-error
"Something bad happened on the server side, see \"*Api Report*\" buffer"
'rest-error)
(defun rest-error (signal &rest args)
"Throw an error SIGNAL with ARGS.
Also print contents of current buffer to *Api Report*."
(declare (indent 1))
(rest-report-buffer)
(signal signal args))
(defun rest-parse-response-code (&optional is-auth)
"Non-nil if this reponse buffer looks ok.
Leave point at the return code on the first line."
(goto-char (point-min))
(unless (search-forward-regexp "^HTTP/[.0-9]+ +" nil t)
(rest-error 'rest-unintelligible-result))
(pcase (thing-at-point 'number)
((or 100 204) nil) ;; OK, but no content.
((or 200 202 201 203) t) ;; OK, with content.
;; Redirection
((or 301 302 303 304 305 307)
(if (search-forward-regexp "^Location: *\\([^\s\n\r\t]+\\)" nil 'noerror)
(match-string 1)
(rest-error 'rest-empty-redirect)))
;; Client errors
((or 403 404 405 410) (rest-error 'rest-page-does-not-exist
(substring-no-properties (thing-at-point 'line) 0 -1)))
((or 400 422 408 409 411 412 413 414 415 416 417) (rest-error 'rest-bad-request))
((or 401 407) (rest-error 'rest-unauthorized
(if is-auth "try creating a new token"
"you probably need to configure a token")))
((pred (<= 500)) (rest-error 'rest-server-error))
(_ (rest-error 'rest-error
(substring (thing-at-point 'line) 0 -1)))))
;;; Requests
(cl-defmacro rest-with-response-buffer (url &rest body &key async (method :get) file
unwind-form error-form noerror
extra-headers &allow-other-keys)
"Access URL and run BODY in a buffer containing the resonse.
Point is after the headers when BODY runs.
URL can be a local file name, which must be absolute.
UNWIND-FORM is run after BODY, even if there was an error during
or before the execution of BODY. ERROR-FORM is run only if an
error occurs. If NOERROR is non-nil, don't propagate errors
caused by the connection or by BODY. Errors signaled by
UNWIND-FORM or ERROR-FORM are not caught.
EXTRA-HEADERS is an alist of headers used in `url-request-extra-headers'.
ASYNC, if non-nil, runs the request asynchronously."
(declare (indent defun)
(debug t))
(while (keywordp (car body))
(setq body (cdr (cdr body))))
(macroexp-let2* nil ((url-1 url))
`(cl-macrolet ((wrap-errors (&rest bodyforms)
(let ((err (make-symbol "err")))
`(condition-case ,err
,(macroexp-progn bodyforms)
,(list 'error ',error-form ',unwind-form
(list 'unless ',noerror
`(signal (car ,err) (cdr ,err))))))))
(if (string-match-p "\\`https?:" ,url-1)
(let* ((url-request-method (upcase (replace-regexp-in-string "\\`:" "" (format "%s" ,method))))
(url-request-extra-headers (cons '("Content-Type" . "application/x-www-form-urlencoded")
,extra-headers))
(url (concat ,url-1 ,file))
(callback (lambda (status)
(let ((b (current-buffer)))
(unwind-protect (wrap-errors
(when-let ((er (plist-get status :error)))
(error "Error retrieving: %s %S" url er))
(unless (search-forward-regexp "^\r?$" nil 'noerror)
(rest-error 'rest-unintelligible-result))
(prog1 ,(macroexp-progn body)
,unwind-form))
(when (buffer-live-p b)
(kill-buffer b)))))))
(if ,async
(wrap-errors (url-retrieve url callback nil 'silent))
(let ((buffer (wrap-errors (url-retrieve-synchronously url 'silent))))
(with-current-buffer buffer
(funcall callback nil)))))
(wrap-errors (with-temp-buffer
(let ((url (expand-file-name ,file ,url-1)))
(unless (file-name-absolute-p url)
(error "Location %s is not a url nor an absolute file name" url))
(insert-file-contents url))
(prog1 ,(macroexp-progn body)
,unwind-form)))))))
(defvar-local rest-url-root nil
"Prepended to REST url when a full url is not given.")
(defun rest--headers-alist ()
"Return an alist of all headers above point."
(let ((ac))
(while (search-backward-regexp "^\\(X-[^ ]+\\): *\\(.*?\\)\r?$" nil 'noerror)
(push (cons (intern (downcase (match-string 1))) (match-string 2))
ac))
ac))
;;; Authentication
(autoload 'auth-source-search "auth-source")
(defun rest--auth-source-search (url-obj)
"Return authentication information for URL-OBJ.
URL-OBJ is a value returned by `url-generic-parse-url'.
Information is found by running `auth-source-search' with the
properties of URL-OBJ."
(let ((port (url-port url-obj))
(args (list :require '(:secret) :host (url-host url-obj)
:max 1 :user (url-user url-obj))))
(car (or (apply #'auth-source-search :port port args)
;; If URL does not specify a port, try again without the default.
(unless (url-portspec url-obj)
(or (apply #'auth-source-search args)))))))
(defun rest--get-auth-info (info)
"Return a function that returns (USER . PASSWORD).
INFO is a plist returned by `auth-source-search'."
(let ((user (plist-get info :user))
(pass (plist-get info :secret)))
(lambda () (cons user (funcall pass)))))
(defun rest--make-authorization-header (_plist user password)
"Return an alist containing an \"Authorization\" header.
The car of the list is nil, so this function can be used as the
AUTH-METHOD in `rest-action'."
`(nil . (("Authorization" .
,(concat "Basic " (base64-encode-string
(concat user ":" password)))))))
;;; The function
(autoload 'json-read "json")
;;;###autoload
(cl-defun rest-action (url &rest all-options
&key auth
(method :get)
(reader #'json-read)
(callback #'identity)
async
(max-pages 1)
(next-page-rule '(header "Link"))
extra-headers
(auth-method (if auth #'rest--make-authorization-header))
(return :simple)
-url-history)
"Contact URL with METHOD.
METHOD is a keyword of an http method, defaulting to :get.
URL can be a string such as \"user/starred?per_page=100\" to
be appended at the end of `rest-url-root'. It can also be a full url
string, in which case it is used verbatim.
READER is called as a function with no arguments, with point
after the headers. If MAX-PAGES > 1 is specified, then READER
must return a sequence. READER is `json-read' by default. Set it
to `ignore' if you don't care about the response data. READER is
not called if the response had no content.
CALLBACK is a function that will be called with the data returned
by READER as an argument. CALLBACK is called even if the response
was empty (in which case its argument is nil).
The return value depends on a few factors:
- If ASYNC is non-nil, the return value is undefined.
- Otherwise, return the value returned by CALLBACK (or by READER,
if no CALLBACK provided).
- If RETURN is :rich, return a list. The car is the value
returned by CALLBACK, and the cdr is an alist of meta-data
about the request \(next-page, quota, etc).
If ASYNC is non-nil, run the request asynchronously.
AUTH may have four forms, 2 and 3 may prompt for information.
1. nil (the default), meaning no authentication is done.
2. t, meaning a user/password combination is automatically obtained
by running `auth-source-search' with the host and port.
3. A list of arguments to pass directly to `auth-source-search'.
4. A function that returns (\"USER\" . \"PASSWORD\") when called.
AUTH-METHOD determines how to use the authentication information.
By default, it does basic authentication with the \"Authorization\"
header.
If provided, it must be a function taking three arguments, which
should return a cons cell. The car of this cell (if non-nil)
replaces URL and the cdr is appended to EXTRA-HEADERS. It is
called with a plist, the user string and the password string.
The plist contais at least :url, :method, and :extra-headers.
`rest-action' can also handle the pagination used in server
results by appending together the contents of each page. Use
MAX-PAGES to increase the number of pages that are
fetched (default 1).
By default the URL of the next page is taken from the \"Link\"
header. You can change this by passing somthing like
(header \"Next-link\")
as the value of the NEXT-PAGE-PROPERTY keyword. You can also pass
a regexp like this:
(regexp \"Some \\(.*\\)regexp\")
which is then searched and `(match-string 1)' is used as the URL.
EXTRA-HEADERS is an alist from header names (string) to header
values (string), as per `url-request-extra-headers'.
If the http request is unsuccessful, an error is signaled
according to the reply. The possible errors are:
`rest-bad-request', `rest-server-error', `rest-unauthorized',
`rest-unintelligible-result', `rest-empty-redirect',
`rest-page-does-not-exist', and `rest-infinite-redirection-loop',
all of which inherit from `rest-error'.
\(fn URL &key AUTH (METHOD :get) (READER #'json-read) CALLBACK ASYNC AUTH-METHOD (MAX-PAGES 1) NEXT-PAGE-RULE EXTRA-HEADERS RETURN)"
(declare (indent 1))
(unless (string-match "\\`https?://" url)
(setq url (concat rest-url-root url)))
(when (member url -url-history)
(signal 'rest-infinite-redirection-loop (cons url -url-history)))
(when auth
(let ((href (url-generic-parse-url url)))
(when (url-password href)
(error "AUTH requested, but URL already contains a password"))
(unless (functionp auth)
(setq auth (rest--get-auth-info (if (listp auth)
(apply #'auth-source-search auth)
(rest--auth-source-search href)))))
(pcase-let* ((`(,user . ,pass) (funcall auth))
(`(,new-url . ,headers)
(funcall auth-method (list :url url :method method
:extra-headers extra-headers)
user pass)))
(when new-url (setq url new-url))
(setq extra-headers (append headers extra-headers)))))
(rest-with-response-buffer url
:method method
:extra-headers extra-headers
:-url-depth (cons url -url-history)
:async async
(pcase (rest-parse-response-code auth)
(`nil nil)
((and (pred stringp) link)
(message "Redirected to %s" link)
(apply #'rest-action all-options))
(`t
(let ((next-page
(when (pcase next-page-rule
(`(header ,name) (search-forward-regexp
(format "^%s: .*<\\([^>]+\\)>;" (regexp-quote name))
nil t))
(`(regexp ,rx) (search-forward-regexp rx nil t))
(_ nil))
(match-string-no-properties 1))))
(goto-char (point-min))
(search-forward-regexp "^\r?$")
(let* ((data (unless (eobp) (funcall reader))))
(if (or (not next-page)
(< max-pages 2))
(pcase return
(:simple (funcall callback data))
(:rich `(,(funcall callback data)
(next-page . ,next-page)
,@(rest--headers-alist))))
(rest-action next-page
:auth auth
:method method
:reader reader
:next-page-rule next-page-rule
:return return
:async async
:max-pages (1- max-pages)
:callback (lambda (res)
(funcall callback
(if (listp res)
(append data res)
(vconcat data res))))))))))))
(provide 'rest)
;;; rest.el ends here
|
