From 21c8af26d899f29885060b3ef52f644a86531a41 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 10 Oct 2018 11:41:12 -0500 Subject: [PATCH] Change: Use request instead of url.el 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 https://github.com/tkf/emacs-request/issues/92, but that only applies to synchronous requests, which we aren't using. --- matrix-api-r0.3.0.el | 38 ++++----- matrix-helpers.el | 152 ----------------------------------- matrix-macros.el | 183 ------------------------------------------- 3 files changed, 16 insertions(+), 357 deletions(-) diff --git a/matrix-api-r0.3.0.el b/matrix-api-r0.3.0.el index 70334c9..233b498 100644 --- a/matrix-api-r0.3.0.el +++ b/matrix-api-r0.3.0.el @@ -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." diff --git a/matrix-helpers.el b/matrix-helpers.el index 0d71030..0fdceef 100644 --- a/matrix-helpers.el +++ b/matrix-helpers.el @@ -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 diff --git a/matrix-macros.el b/matrix-macros.el index 29ac49d..8f7f85b 100644 --- a/matrix-macros.el +++ b/matrix-macros.el @@ -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(#> - ;; "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: - (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)