From 1f2ebe94c647fef509e06e9ef6f79697ef98a356 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 12:57:41 +0200 Subject: first test merge of hdurer's WIP: Posting of images --- lisp/mastodon-http.el | 64 +++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 55 insertions(+), 9 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index bc48e8d..85ee588 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -90,29 +90,75 @@ Message status and JSON error from RESPONSE if unsuccessful." (let ((json-response (mastodon-http--process-json))) (message "Error %s: %s" status (cdr (assoc 'error json-response)))))))) +(defun mastodon-http--encode-multipart-form-data (boundary fields) + "Encode FIELDS suitable to post as multipart/form-data. + +It uses BOUNDARY as the boundary for the values. +FIELDS should be a list of either 2-element (name contents) lists +or 4-element list of (name file-name content-type contents)." + (with-temp-buffer + (dolist (field fields) + (insert "--" boundary "\r\n") + (if (= (length field) 2) + ;; a 2-element list is a simple name=value item: + (insert "Content-Disposition: form-data; name=\"" + (url-hexify-string (car field)) + "\"\r\n" + "\r\n" + (cadr field) "\r\n") + ;; a 4-element list ist a file to be attached: + (insert "Content-Disposition: form-data; name=\"" + (url-hexify-string (car field)) + "\"; filename=\"" + (url-hexify-string (cadr field)) + "\"\r\n" + "Content-type: " (caddr field) "\r\n" + "\r\n" + (cadddr field) "\r\n"))) + ;; Finally add the terminating boundary and another empty line: + (insert "--" boundary "--\r\n" + "\r\n") + (string-to-unibyte (buffer-string)))) + (defun mastodon-http--post (url args headers &optional unauthenticed-p) "POST synchronously to URL with ARGS and HEADERS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (let ((url-request-method "POST") - (url-request-data - (when args - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cdr arg)))) - args - "&"))) + (let* ((url-request-method "POST") + (boundary (md5 (format "b%s-%s-%s-%s" + (random 1000000000) (random 1000000000) + (random 1000000000) (random 1000000000)))) + (needs-multi-form (> (apply #'max (mapcar #'length args)) 2)) + (url-request-data + (when args + (if needs-multi-form + (mastodon-http--encode-multipart-form-data boundary args) + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cadr arg)))) + args + "&")))) (url-request-extra-headers (append + (when needs-multi-form + `(("Content-Type" . + ,(concat "multipart/form-data; boundary=\"" boundary "\"")))) (unless unauthenticed-p `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) headers))) + (message "Posting to %s with %d bytes of request data and headers %s" url (length url-request-data) url-request-extra-headers) (with-temp-buffer (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) (url-retrieve-synchronously url nil nil mastodon-http--timeout))))) +(defun mastodon-http--read-file-as-string (filename) + "" + (with-temp-buffer + (insert-file-contents filename) + (string-to-unibyte (buffer-string)))) + (defun mastodon-http--get (url) "Make synchronous GET request to URL. -- cgit v1.2.3 From ff76a83fc57817731c407da3cf8a6ef6a71434c5 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 14:59:03 +0200 Subject: revert mastodon-http changes - we will keep my old implementation of attachment uploading, as it already works with the media_ids[] of the API. --- lisp/mastodon-http.el | 58 ++++++++------------------------------------------- 1 file changed, 9 insertions(+), 49 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 85ee588..052218c 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -90,64 +90,24 @@ Message status and JSON error from RESPONSE if unsuccessful." (let ((json-response (mastodon-http--process-json))) (message "Error %s: %s" status (cdr (assoc 'error json-response)))))))) -(defun mastodon-http--encode-multipart-form-data (boundary fields) - "Encode FIELDS suitable to post as multipart/form-data. - -It uses BOUNDARY as the boundary for the values. -FIELDS should be a list of either 2-element (name contents) lists -or 4-element list of (name file-name content-type contents)." - (with-temp-buffer - (dolist (field fields) - (insert "--" boundary "\r\n") - (if (= (length field) 2) - ;; a 2-element list is a simple name=value item: - (insert "Content-Disposition: form-data; name=\"" - (url-hexify-string (car field)) - "\"\r\n" - "\r\n" - (cadr field) "\r\n") - ;; a 4-element list ist a file to be attached: - (insert "Content-Disposition: form-data; name=\"" - (url-hexify-string (car field)) - "\"; filename=\"" - (url-hexify-string (cadr field)) - "\"\r\n" - "Content-type: " (caddr field) "\r\n" - "\r\n" - (cadddr field) "\r\n"))) - ;; Finally add the terminating boundary and another empty line: - (insert "--" boundary "--\r\n" - "\r\n") - (string-to-unibyte (buffer-string)))) - (defun mastodon-http--post (url args headers &optional unauthenticed-p) "POST synchronously to URL with ARGS and HEADERS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (let* ((url-request-method "POST") - (boundary (md5 (format "b%s-%s-%s-%s" - (random 1000000000) (random 1000000000) - (random 1000000000) (random 1000000000)))) - (needs-multi-form (> (apply #'max (mapcar #'length args)) 2)) - (url-request-data - (when args - (if needs-multi-form - (mastodon-http--encode-multipart-form-data boundary args) - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) - "=" - (url-hexify-string (cadr arg)))) - args - "&")))) + (let ((url-request-method "POST") + (url-request-data + (when args + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cdr arg)))) + args + "&"))) (url-request-extra-headers (append - (when needs-multi-form - `(("Content-Type" . - ,(concat "multipart/form-data; boundary=\"" boundary "\"")))) (unless unauthenticed-p `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) headers))) - (message "Posting to %s with %d bytes of request data and headers %s" url (length url-request-data) url-request-extra-headers) (with-temp-buffer (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) -- cgit v1.2.3