Skip to content
This repository has been archived by the owner on Mar 14, 2023. It is now read-only.

Commit

Permalink
Change: Use request instead of url.el
Browse files Browse the repository at this point in the history 
It's impossible to upload files with url.el unless
url-http-create-request is overridden with a fixed version, and that
must be done with function advice (which applies to everything in
Emacs), because doing it with cl-letf doesn't work (who knows why--it
works fine for other things).  Obviously we don't want to override
that function globally, even though it works fine now, because when
url.el changes in the future, that might break something.  And it's
not a good idea, anyway.

So let's switch back to request.el.  Frankly, I don't even remember
why I switched to my url-with-retrieve-async function.  There is this
pesky bug at tkf/emacs-request#92, but that
only applies to synchronous requests, which we aren't using.
  • Loading branch information
@alphapapa
alphapapa committed Oct 10, 2018
1 parent 0bcb790 commit 21c8af2
Show file tree
Hide file tree
Showing 3 changed files with 16 additions and 357 deletions.
38 changes: 16 additions & 22 deletions matrix-api-r0.3.0.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -355,28 +355,22 @@ set, will be called if the request fails."
'data data
'timeout timeout))
(pcase method
("GET" (matrix-url-with-retrieve-async url
:query-on-exit query-on-exit
:silent t
:inhibit-cookies t
:extra-headers (a-list "Authorization" (concat "Bearer " access-token))
:query data
:parser #'json-read
:success success
:error error
:timeout timeout))
((or "POST" "PUT") (matrix-url-with-retrieve-async url
:query-on-exit query-on-exit
:silent t
:inhibit-cookies t
:method method
:extra-headers (a-list "Content-Type" content-type
"Authorization" (concat "Bearer " access-token))
:data (or raw-data (json-encode data))
:parser #'json-read
:success success
:error error
:timeout timeout))))))
("GET" (request url
:headers (a-list "Authorization" (concat "Bearer " access-token))
:params data
:parser #'json-read
:success success
:error error
:timeout timeout))
((or "POST" "PUT") (request url
:type method
:headers (a-list "Content-Type" content-type
"Authorization" (concat "Bearer " access-token))
:data (or raw-data (json-encode data))
:parser #'json-read
:success success
:error error
:timeout timeout))))))

(matrix-defcallback request-error matrix-session
"Callback function for request error."
Expand Down
152 changes: 0 additions & 152 deletions matrix-helpers.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -159,157 +159,5 @@ PAIRS is a spliced plist."
when value
collect (cons key value)))

(defun matrix--url-http-create-request (&optional ref-url)
"Create an HTTP request for `url-http-target-url', referred to by REF-URL.
This is a copy of `url-http-create-request' from Emacs 26.1,
modified to allows binary uploads, which are prevented by the
\"fix\" for bug #23750 near the bottom of the function."
(let* ((extra-headers)
(request nil)
(no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
(using-proxy url-http-proxy)
(proxy-auth (if (or (cdr-safe (assoc "Proxy-Authorization"
url-http-extra-headers))
(not using-proxy))
nil
(let ((url-basic-auth-storage
'url-http-proxy-basic-auth-storage))
(url-get-authentication url-http-proxy nil 'any nil))))
(real-fname (url-filename url-http-target-url))
(host (url-http--encode-string (url-host url-http-target-url)))
(auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
nil
(url-get-authentication (or
(and (boundp 'proxy-info)
proxy-info)
url-http-target-url) nil 'any nil))))
(if (equal "" real-fname)
(setq real-fname "/"))
(setq no-cache (and no-cache (string-match "no-cache" no-cache)))
(if auth
(setq auth (concat "Authorization: " auth "\r\n")))
(if proxy-auth
(setq proxy-auth (concat "Proxy-Authorization: " proxy-auth "\r\n")))

;; Protection against stupid values in the referrer
(if (and ref-url (stringp ref-url) (or (string= ref-url "file:nil")
(string= ref-url "")))
(setq ref-url nil))

;; We do not want to expose the referrer if the user is paranoid.
(if (or (memq url-privacy-level '(low high paranoid))
(and (listp url-privacy-level)
(memq 'lastloc url-privacy-level)))
(setq ref-url nil))

;; url-http-extra-headers contains an assoc-list of
;; header/value pairs that we need to put into the request.
(setq extra-headers (mapconcat
(lambda (x)
(concat (car x) ": " (cdr x)))
url-http-extra-headers "\r\n"))
(if (not (equal extra-headers ""))
(setq extra-headers (concat extra-headers "\r\n")))

;; This was done with a call to `format'. Concatenating parts has
;; the advantage of keeping the parts of each header together and
;; allows us to elide null lines directly, at the cost of making
;; the layout less clear.
(setq request
(concat
;; The request
(or url-http-method "GET") " "
(url-http--encode-string
(if using-proxy (url-recreate-url url-http-target-url) real-fname))
" HTTP/" url-http-version "\r\n"
;; Version of MIME we speak
"MIME-Version: 1.0\r\n"
;; (maybe) Try to keep the connection open
"Connection: " (if (or using-proxy
(not url-http-attempt-keepalives))
"close" "keep-alive") "\r\n"
;; HTTP extensions we support
(if url-extensions-header
(format
"Extension: %s\r\n" url-extensions-header))
;; Who we want to talk to
(if (/= (url-port url-http-target-url)
(url-scheme-get-property
(url-type url-http-target-url) 'default-port))
(format
"Host: %s:%d\r\n" (puny-encode-domain host)
(url-port url-http-target-url))
(format "Host: %s\r\n" (puny-encode-domain host)))
;; Who its from
(if url-personal-mail-address
(concat
"From: " url-personal-mail-address "\r\n"))
;; Encodings we understand
(if (or url-mime-encoding-string
;; MS-Windows loads zlib dynamically, so recheck
;; in case they made it available since
;; initialization in url-vars.el.
(and (eq 'system-type 'windows-nt)
(fboundp 'zlib-available-p)
(zlib-available-p)
(setq url-mime-encoding-string "gzip")))
(concat
"Accept-encoding: " url-mime-encoding-string "\r\n"))
(if url-mime-charset-string
(concat
"Accept-charset: "
(url-http--encode-string url-mime-charset-string)
"\r\n"))
;; Languages we understand
(if url-mime-language-string
(concat
"Accept-language: " url-mime-language-string "\r\n"))
;; Types we understand
"Accept: " (or url-mime-accept-string "*/*") "\r\n"
;; User agent
(url-http-user-agent-string)
;; Proxy Authorization
proxy-auth
;; Authorization
auth
;; Cookies
(when (url-use-cookies url-http-target-url)
(url-http--encode-string
(url-cookie-generate-header-lines
host real-fname
(equal "https" (url-type url-http-target-url)))))
;; If-modified-since
(if (and (not no-cache)
(member url-http-method '("GET" nil)))
(let ((tm (url-is-cached url-http-target-url)))
(if tm
(concat "If-modified-since: "
(url-get-normalized-date tm) "\r\n"))))
;; Whence we came
(if ref-url (concat
"Referer: " ref-url "\r\n"))
extra-headers
;; Length of data
(if url-http-data
(concat
"Content-length: " (number-to-string
(length url-http-data))
"\r\n"))
;; End request
"\r\n"
;; Any data
url-http-data))
;; Bug#23750
(unless (or
;; Our local fix to the "fix" is to not do the string-bytes/length comparison when
;; POSTing.
(equal url-http-method "POST")
(= (string-bytes request)
(length request)))
(error "Multibyte text in HTTP request: %s" request))
(url-http-debug "Request is: \n%s" request)
request))

(provide 'matrix-helpers)
;;; matrix-helpers.el ends here
183 changes: 0 additions & 183 deletions matrix-macros.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -203,187 +203,4 @@ Is transformed to:
do (setq body `((with-slots ,slots ,object ,@body)))
finally return (car body)))

(defvar-local matrix-url-with-retrieve-async-timeout-timer nil
"When a response buffer has a timeout, this variable stores the
timer object so that it may be canceled if the request
completes successfully.")

(cl-defun matrix-url-with-retrieve-async (url &key cbargs silent inhibit-cookies data
(method "GET") extra-headers query timeout success error
parser (query-on-exit t))
"Retrieve URL asynchronously with `url-retrieve'.
Arguments CBARGS, SILENT, and INHIBIT-COOKIES are passed to
`url-retrieve', which see.
DATA is bound to `url-request-data', which see.
METHOD may be a symbol or string, which is bound as a capitalized
string to `url-request-method', which see.
EXTRA-HEADERS is an alist of header-value pairs, which is bound
to `url-request-extra-headers', which see.
QUERY is an alist of key-value pairs which is appended to the URL
as the query.
TIMEOUT may be a number of seconds, after which the error
callback will run if the request hasn't completed by then.
SUCCESS may be a function symbol or a body form, which is called
with zero arguments upon successful completion of the request.
In the call to SUCCESS, these variables will be bound:
`status': See `url-retrieve'.
`cbargs': See `url-retrieve'.
`headers': The HTTP response headers as a string.
`body': The HTTP response body as a string.
ERROR may be a function symbol or a body form, which is called
with zero arguments if the request fails. In the error call,
these variables will be bound, in addition to the ones bound for
SUCCESS:
`errors': The list of `url' error symbols for the most recent
error, e.g. `(error http 404)' for an HTTP 404 error.
In the SUCCESS and ERROR calls, the current buffer is the
response buffer, and it is automatically killed when the call
completes.
PARSE-BODY-FN may be a function which parses the body and returns
a value to bind `body' to. The point is positioned after the
headers, at the beginning of the body, before calling the
function. For example, `json-read' may be used to parse JSON
documents, after which the parsed JSON would be available in
SUCCESS and ERROR as `body'. Or, if the body is not needed,
`ignore' could be used to prevent the body from being parsed."
(declare (indent defun))
(let* ((success-body-fn (cl-typecase success
(function success)
(otherwise (byte-compile
`(cl-function
(lambda (&key cbargs status headers data)
,success))))))
(error-body-fn (cl-typecase error
(function error)
(otherwise (byte-compile
`(cl-function
(lambda (&key cbargs status error headers data url)
,error))))))
(url-request-data (when data
(encode-coding-string data 'utf-8)))
(url-request-method (upcase (cl-typecase method
(symbol (symbol-name method))
(string method))))
;; TODO: Note that extra-headers must be an alist, and both keys and values must be strings.
(url-request-extra-headers extra-headers)
;; FIXME: Document how `url-http-attempt-keepalives' is set.
(url-http-attempt-keepalives (and (not timeout)
url-http-attempt-keepalives))
(callback (lambda (status &optional cbargs)
(unwind-protect
;; This is called by `url-http-activate-callback' with the response buffer
;; as the current buffer.

;; Check for errors
(pcase status
;; NOTE: This may need to be updated to correctly handle multiple errors
(`(:error . ,_) (funcall error-body-fn
:url url
:cbargs cbargs
:status status
:error (plist-get status :error)))
((or 'nil
`(:peer (:certificate . ,_))
`(:redirect . ,_))
(if (not url-http-end-of-headers)
;; HACK: It seems that the callback can be called with `nil' when
;; the connection fails before getting any headers, like:
;; url-http-end-of-document-sentinel(#<process matrix.org<5>>
;; "connection broken by remote peer\n"), in which case
;; `url-http-end-of-headers' is nil, so we need to call the error
;; fn. Would like to structure this more cleanly.
(funcall error-body-fn
:url url
:cbargs cbargs
:status status
:error (plist-get status :error))
(let ((headers (buffer-substring (point) url-http-end-of-headers))
(data (if parser
(progn
(goto-char (1+ url-http-end-of-headers))
(funcall parser))
(buffer-substring (1+ url-http-end-of-headers) (point-max)))))
(funcall success-body-fn
:cbargs cbargs
:status status
:headers headers
:data data))))
(_ (error "Response status unrecognized; please report this error: %s" (pp-to-string status))))
(when matrix-url-with-retrieve-async-timeout-timer
(cancel-timer matrix-url-with-retrieve-async-timeout-timer))
(unless (kill-buffer (current-buffer))
(warn "Unable to kill response buffer: %s" (current-buffer))))))
url-obj query-string query-params response-buffer)
(when (or (memq 'http url-debug)
(eq url-debug t))
(matrix-log (a-list 'type 'url-with-retrieve-async
'method method
'url url
'query query
'extra-headers extra-headers
'data data
'timeout timeout
'parser parser
'success success
'error error)))
(when query
;; Build and append query string to URL
(progn
;; Transform alist to plain list for `url-build-query-string'
(setq query-params (cl-loop for (key . val) in query
when val
collect (list key val)))
(setq url-obj (url-generic-parse-url url))
(setq query-string (url-build-query-string query-params))
(setf (url-filename url-obj) (concat (url-filename url-obj) "?" query-string))
(setq url (url-recreate-url url-obj))))
(setq response-buffer (url-retrieve url callback cbargs silent inhibit-cookies))
(when timeout
(with-current-buffer response-buffer
(setq-local matrix-url-with-retrieve-async-timeout-timer
(run-with-timer timeout nil
(lambda ()
(when (and (buffer-live-p response-buffer)
(get-buffer-process response-buffer))
(with-current-buffer response-buffer
;; Since we are handling the timeout ourselves, when we kill the
;; process, url.el considers it a "success", and therefore does not kill
;; the buffer (it seems to only kill its own buffers when it detects a
;; HTTP response error code, which we aren't getting). So we first add
;; an errors list to the first element of the callback args (the
;; `status' arg), then we delete the process, causing the process's
;; sentinel to be called, which then calls the callback, which detects
;; the error and calls the error-body-fn.

;; FIXME: Sometimes this seems to stop catching timeouts.
;; When that happens, it seems that the response buffer
;; process does not get deleted, as it remains listed in
;; `list-processes'. Maybe the solution is to bind
;; `url-http-attempt-keepalives' to nil when a timeout is
;; set, because maybe that would prevent processes from
;; being left around, which seems to contribute to the
;; problem.

;; NOTE: This may be loosely relevant: <https://github.com/jorgenschaefer/circe/issues/327>
(setq url-callback-arguments (list (list :error 'timeout) url-callback-arguments))
;; Since `get-buffer-process' is a C function, we just call it again
;; instead of storing the buffer process in a variable.
(delete-process (get-buffer-process response-buffer))
(setq matrix-url-with-retrieve-async-timeout-timer nil))))))))
(unless query-on-exit
(set-process-query-on-exit-flag (get-buffer-process response-buffer) nil))
response-buffer))

(provide 'matrix-macros)

0 comments on commit 21c8af2

Please sign in to comment.