From 8520659c0908a553a7c646fe788bbc64deea903b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 09:22:25 +0200 Subject: refactor concat-params-to-url, replace append-query string --- lisp/mastodon-http.el | 56 ++++++++++++++++++--------------------------------- 1 file changed, 20 insertions(+), 36 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 49ffbf8..9d9b6e4 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -147,19 +147,21 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))) unauthenticated-p)) +(defun mastodon-http--concat-params-to-url (url params) + "Build a query string with PARAMS and concat to URL." + (if params + (concat url "?" + (mastodon-http--build-params-string params)) + url)) (defun mastodon-http--get (url &optional params silent) "Make synchronous GET request to URL. PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." - (mastodon-http--authorized-request - "GET" - ;; url-request-data doesn't seem to work with GET requests: - (let ((url (if params - (concat url "?" - (mastodon-http--build-params-string params)) - url))) - (mastodon-http--url-retrieve-synchronously url silent)))) + (mastodon-http--authorized-request "GET" + ;; url-request-data doesn't seem to work with GET requests?: + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--url-retrieve-synchronously url silent)))) (defun mastodon-http--get-response (url &optional params no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. @@ -232,15 +234,10 @@ Callback to `mastodon-http--get-response-async', usually "Make DELETE request to URL. PARAMS is an alist of any extra parameters to send with the request." ;; url-request-data only works with POST requests? - (let ((url - (if params - (concat url "?" - (mastodon-http--build-params-string params)) - url))) - (mastodon-http--authorized-request - "DELETE" - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))))) + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--authorized-request "DELETE" + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))))) (defun mastodon-http--put (url &optional params headers) "Make PUT request to URL. @@ -258,12 +255,6 @@ HEADERS is an alist of any extra headers to send with the request." headers))) (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) -(defun mastodon-http--append-query-string (url params) - "Append PARAMS to URL as query strings and return it. -PARAMS should be an alist as required by `url-build-query-string'." - (let ((query-string (url-build-query-string params))) - (concat url "?" query-string))) - ;; profile update functions (defun mastodon-http--patch-json (url &optional params) @@ -275,12 +266,9 @@ Optionally specify the PARAMS to send." (defun mastodon-http--patch (base-url &optional params) "Make synchronous PATCH request to BASE-URL. Optionally specify the PARAMS to send." - (mastodon-http--authorized-request - "PATCH" - (let ((url - (concat base-url "?" - (mastodon-http--build-params-string params)))) - (mastodon-http--url-retrieve-synchronously url)))) + (mastodon-http--authorized-request "PATCH" + (let ((url (mastodon-http--concat-params-to-url base-url params))) + (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions @@ -288,13 +276,9 @@ Optionally specify the PARAMS to send." "Make GET request to URL. Pass response buffer to CALLBACK function with args CBARGS. PARAMS is an alist of any extra parameters to send with the request." - (let ((url (if params - (concat url "?" - (mastodon-http--build-params-string params)) - url))) - (mastodon-http--authorized-request - "GET" - (url-retrieve url callback cbargs)))) + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--authorized-request "GET" + (url-retrieve url callback cbargs)))) (defun mastodon-http--get-response-async (url &optional params callback &rest cbargs) "Make GET request to URL. Call CALLBACK with http response and CBARGS. -- cgit v1.2.3 From 0326fb24ff527cd67916f9392387068037068b7c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 09:23:25 +0200 Subject: audit http.el --- lisp/mastodon-http.el | 95 +++++++++++++++++++++++---------------------------- 1 file changed, 43 insertions(+), 52 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 9d9b6e4..ba79bd0 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -86,8 +86,6 @@ Message status and JSON error from RESPONSE if unsuccessful." (mastodon-http--status)))) (if (string-prefix-p "2" status) (funcall success) - ;; don't switch to buffer, just with-current-buffer the response: - ;; (switch-to-buffer response) ;; 404 sometimes returns http response so --process-json fails: (if (string-prefix-p "404" status) (message "Error %s: page not found" status) @@ -104,7 +102,8 @@ Message status and JSON error from RESPONSE if unsuccessful." (defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p) "Make a METHOD type request using BODY, with Mastodon authorization. Unless UNAUTHENTICATED-P is non-nil." - (declare (debug 'body)) + (declare (debug 'body) + (indent 1)) `(let ((url-request-method ,method) (url-request-extra-headers (unless ,unauthenticated-p @@ -115,14 +114,12 @@ Unless UNAUTHENTICATED-P is non-nil." (defun mastodon-http--build-params-string (params) "Build a request parameters string from parameters alist PARAMS." ;; (url-build-query-string args nil)) - ;; url-build-query-string adds 'nil' to empty params so lets stay with our + ;; url-build-query-string adds 'nil' for empty params so lets stick with our ;; own: (mapconcat (lambda (p) (concat (url-hexify-string (car p)) - "=" - (url-hexify-string (cdr p)))) - params - "&")) + "=" (url-hexify-string (cdr p)))) + params "&")) (defun mastodon-http--build-array-params-alist (param-str array) "Return parameters alist using PARAM-STR and ARRAY param values. @@ -133,20 +130,18 @@ Used for API form data parameters that take an array." (defun mastodon-http--post (url &optional params headers unauthenticated-p) "POST synchronously to URL, optionally with PARAMS and HEADERS. Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." - (mastodon-http--authorized-request - "POST" - (let ((url-request-data - (when params - (mastodon-http--build-params-string params))) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - ;; pleroma compat: - (unless (assoc "Content-Type" headers) - '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))) - unauthenticated-p)) + (mastodon-http--authorized-request "POST" + (let ((url-request-data (when params + (mastodon-http--build-params-string params))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + (unless (assoc "Content-Type" headers) ; pleroma compat: + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))) + unauthenticated-p)) + (defun mastodon-http--concat-params-to-url (url params) "Build a query string with PARAMS and concat to URL." (if params @@ -199,17 +194,14 @@ Callback to `mastodon-http--get-response-async', usually (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-array-type (if vector 'vector 'list)) - (json-string - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8))) + (json-string (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8))) (kill-buffer) - ;; (unless (or (string-empty-p json-string) (null json-string)) (cond ((or (string-empty-p json-string) (null json-string)) nil) - ;; if we don't have json, maybe we have a plain string error - ;; message (misskey works like this for instance, but there are - ;; probably less dunce ways to do this): + ;; if no json, maybe we have a plain string error message (misskey + ;; does this, but there are probably better ways to do this): ;; FIXME: friendica at least sends plain html if endpoint not found. ((not (or (string-prefix-p "\n{" json-string) (string-prefix-p "\n[" json-string))) @@ -243,17 +235,15 @@ PARAMS is an alist of any extra parameters to send with the request." "Make PUT request to URL. PARAMS is an alist of any extra parameters to send with the request. HEADERS is an alist of any extra headers to send with the request." - (mastodon-http--authorized-request - "PUT" - (let ((url-request-data - (when params (mastodon-http--build-params-string params))) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - ;; pleroma compat: - (unless (assoc "Content-Type" headers) - '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) - (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) + (mastodon-http--authorized-request "PUT" + (let ((url-request-data + (when params (mastodon-http--build-params-string params))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + (unless (assoc "Content-Type" headers) ; pleroma compat: + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) ;; profile update functions @@ -287,7 +277,7 @@ PARAMS is an alist of any extra parameters to send with the request." url params (lambda (status) - (when status ;; only when we actually get sth? + (when status ; for flakey servers (apply callback (mastodon-http--process-response) cbargs))))) (defun mastodon-http--get-json-async (url &optional params callback &rest cbargs) @@ -304,14 +294,12 @@ PARAMS is an alist of any extra parameters to send with the request." "POST asynchronously to URL with PARAMS and HEADERS. Then run function CALLBACK with arguements CBARGS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (mastodon-http--authorized-request - "POST" - (let ((request-timeout 5) - (url-request-data - (when params - (mastodon-http--build-params-string params)))) - (with-temp-buffer - (url-retrieve url callback cbargs))))) + (mastodon-http--authorized-request "POST" + (let ((request-timeout 5) + (url-request-data (when params + (mastodon-http--build-params-string params)))) + (with-temp-buffer + (url-retrieve url callback cbargs))))) ;; TODO: test for curl first? (defun mastodon-http--post-media-attachment (url filename caption) @@ -353,9 +341,12 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." ;; handle mastodon api errors ;; they have the form (error http 401) ((= (car (last error-thrown)) 401) - (message "Got error: %s Unauthorized: The access token is invalid" error-thrown)) + (message "Got error: %s Unauthorized: The access token is invalid" + error-thrown)) ((= (car (last error-thrown)) 422) - (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown)) + (message "Got error: %s Unprocessable entity: file or file\ + type is unsupported or invalid" + error-thrown)) (t (message "Got error: %s Shit went south" error-thrown)))))))) -- cgit v1.2.3 From 6d05cf81ff5a84aa12735aeab2ac99a083c15033 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 11 May 2023 19:58:01 +0200 Subject: use url-http-end-of-headers in http.el --- lisp/mastodon-http.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index ba79bd0..6f472bc 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -192,7 +192,7 @@ Callback to `mastodon-http--get-response-async', usually (let ((headers (unless no-headers (mastodon-http--process-headers)))) (goto-char (point-min)) - (re-search-forward "^$" nil 'move) + (goto-char url-http-end-of-headers) (let ((json-array-type (if vector 'vector 'list)) (json-string (decode-coding-string (buffer-substring-no-properties (point) (point-max)) @@ -215,7 +215,7 @@ Callback to `mastodon-http--get-response-async', usually (goto-char (point-min)) (let* ((head-str (buffer-substring-no-properties (point-min) - (re-search-forward "^$" nil 'move))) + (goto-char url-http-end-of-headers))) (head-list (split-string head-str "\n"))) (mapcar (lambda (x) (let ((list (split-string x ": "))) -- cgit v1.2.3 From dfe1fb7aabe43bb8dbad198f31752c92d191e7d0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 10:32:33 +0200 Subject: http docstring --- lisp/mastodon-http.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 6f472bc..a2094be 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -80,8 +80,9 @@ SILENT means don't message." (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout))) (defun mastodon-http--triage (response success) - "Determine if RESPONSE was successful. Call SUCCESS if successful. -Message status and JSON error from RESPONSE if unsuccessful." + "Determine if RESPONSE was successful. +Call SUCCESS if successful. Message status and JSON error from +RESPONSE if unsuccessful." (let ((status (with-current-buffer response (mastodon-http--status)))) (if (string-prefix-p "2" status) -- cgit v1.2.3 From 14a5358806407a881748b9bbe9bdd113743a2acf Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 10:32:43 +0200 Subject: Revert "use url-http-end-of-headers in http.el" To fix tests This reverts commit 6d05cf81ff5a84aa12735aeab2ac99a083c15033. --- lisp/mastodon-http.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index a2094be..5dd4fda 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -193,7 +193,7 @@ Callback to `mastodon-http--get-response-async', usually (let ((headers (unless no-headers (mastodon-http--process-headers)))) (goto-char (point-min)) - (goto-char url-http-end-of-headers) + (re-search-forward "^$" nil 'move) (let ((json-array-type (if vector 'vector 'list)) (json-string (decode-coding-string (buffer-substring-no-properties (point) (point-max)) @@ -216,7 +216,7 @@ Callback to `mastodon-http--get-response-async', usually (goto-char (point-min)) (let* ((head-str (buffer-substring-no-properties (point-min) - (goto-char url-http-end-of-headers))) + (re-search-forward "^$" nil 'move))) (head-list (split-string head-str "\n"))) (mapcar (lambda (x) (let ((list (split-string x ": "))) -- cgit v1.2.3 From e97dc9dbf258d3cee1f0a0a0d1bfa1e733aa0f62 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 26 May 2023 09:21:11 +0200 Subject: rough rendering for 404 html error responses. --- lisp/mastodon-http.el | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 5dd4fda..dc007f3 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -87,7 +87,6 @@ RESPONSE if unsuccessful." (mastodon-http--status)))) (if (string-prefix-p "2" status) (funcall success) - ;; 404 sometimes returns http response so --process-json fails: (if (string-prefix-p "404" status) (message "Error %s: page not found" status) (let ((json-response (with-current-buffer response @@ -181,6 +180,15 @@ Callback to `mastodon-http--get-json-async', usually `mastodon-tl--init*', is run on the result." (car (mastodon-http--process-response :no-headers))) +(defun mastodon-http--render-html-err (string) + "Render STRING as HTML in a temp buffer. +STRING should be a HTML for a 404 errror." + (with-temp-buffer + (insert json-string) + (shr-render-buffer (current-buffer)) + (view-mode) ; for 'q' to kill buffer and window + (error ""))) ; stop subsequent processing + (defun mastodon-http--process-response (&optional no-headers vector) "Process http response. Return a cons of JSON list and http response headers. @@ -201,9 +209,14 @@ Callback to `mastodon-http--get-response-async', usually (kill-buffer) (cond ((or (string-empty-p json-string) (null json-string)) nil) - ;; if no json, maybe we have a plain string error message (misskey - ;; does this, but there are probably better ways to do this): - ;; FIXME: friendica at least sends plain html if endpoint not found. + ;; if we get html, just render it and error: + ;; ideally we should handle the status code in here rather than + ;; this crappy hack? + ((string-prefix-p "\n Date: Tue, 20 Jun 2023 18:58:26 +0200 Subject: fix html render on error in process-json --- lisp/mastodon-http.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index dc007f3..4a8e76a 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -184,7 +184,7 @@ Callback to `mastodon-http--get-json-async', usually "Render STRING as HTML in a temp buffer. STRING should be a HTML for a 404 errror." (with-temp-buffer - (insert json-string) + (insert string) (shr-render-buffer (current-buffer)) (view-mode) ; for 'q' to kill buffer and window (error ""))) ; stop subsequent processing @@ -212,7 +212,7 @@ Callback to `mastodon-http--get-response-async', usually ;; if we get html, just render it and error: ;; ideally we should handle the status code in here rather than ;; this crappy hack? - ((string-prefix-p "\n Date: Wed, 12 Jul 2023 18:05:52 +0200 Subject: message wait/done to attachment uploads, to avoid issues. See #478. --- lisp/mastodon-http.el | 6 +----- lisp/mastodon-toot.el | 3 ++- 2 files changed, 3 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 4a8e76a..64f59ca 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -338,11 +338,7 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." (when data (push (alist-get 'id data) mastodon-toot--media-attachment-ids) ; add ID to list - (message "%s file %s with id %S and caption '%s' uploaded!" - (capitalize (alist-get 'type data)) - file - (alist-get 'id data) - (alist-get 'description data)) + (message "Uploading %s... (done)" file) (mastodon-toot--update-status-fields)))) :error (cl-function (lambda (&key error-thrown &allow-other-keys) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 88ee34b..14b9d68 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1172,7 +1172,8 @@ which is used to attach it to a toot when posting." (let* ((filename (expand-file-name (alist-get :filename attachment))) (caption (alist-get :description attachment)) (url (concat mastodon-instance-url "/api/v2/media"))) - (message "Uploading %s..." (file-name-nondirectory filename)) + (message "Uploading %s... (please wait before starting further uploads)" + (file-name-nondirectory filename)) (mastodon-http--post-media-attachment url filename caption))) (defun mastodon-toot--refresh-attachments-display () -- cgit v1.2.3 From 5f095822e92872ddcb76fc9fe98c0cf985849f3b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 13 Jul 2023 10:23:11 +0200 Subject: fix indent of media attachments --- lisp/mastodon-http.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 64f59ca..551d4fd 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -347,10 +347,10 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." ;; because the '=' test below fails for them ;; they have the form (error . error message 24) ((not (proper-list-p error-thrown)) ; not dotted list - (message "Got error: %s. Shit went south." (cdr error-thrown))) + (message "Got error: %s. Shit went south." (cdr error-thrown))) ;; handle mastodon api errors ;; they have the form (error http 401) - ((= (car (last error-thrown)) 401) + ((= (car (last error-thrown)) 401) (message "Got error: %s Unauthorized: The access token is invalid" error-thrown)) ((= (car (last error-thrown)) 422) -- cgit v1.2.3