mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-12 09:28:24 +00:00
Code Issues Releases Activity

Fix problem with submitting binary data via HTTP forms

Browse Source 
* lisp/gnus/mm-url.el (mm-url-encode-multipart-form-data):
Document the parameters, clean up the code, and make uploading
binary data really work (which it didn't if the binary bits
were in the last part of the data).
This commit is contained in:
Lars Ingebrigtsen 2016-10-13 21:39:29 +02:00
parent 4c620c20d4
commit a6e0188dff
1 changed files with 42 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
lisp/gnus/mm-url.el
View File

@ -402,43 +402,52 @@ spaces. Die Die Die."
(autoload 'mml-compute-boundary "mml")
(defun mm-url-encode-multipart-form-data (pairs &optional boundary)
"Return PAIRS encoded in multipart/form-data."
(defun mm-url-encode-multipart-form-data (data &optional boundary)
"Return DATA encoded in multipart/form-data.
DATA is a list where the elements can have the following form:
(\"NAME\" . \"VALUE\")
(\"submit\")
(\"file\" . ((\"name\" . \"NAME\")
(\"filename\" . \"FILENAME\")
(\"content-type\" . \"CONTENT-TYPE\")
(\"filedata\" . \"FILEDATA\")))
Lowercase names above are literals and uppercase can
be various values."
;; RFC1867
;; Get a good boundary
(unless boundary
(setq boundary (mml-compute-boundary '())))
(concat
;; Start with the boundary
"--" boundary "\r\n"
;; Create name value pairs
(mapconcat
'identity
;; Delete any returned items that are empty
(delq nil
(mapcar (lambda (data)
(cond ((equal (car data) "file")
;; For each pair
(format
;; Encode the name
"Content-Disposition: form-data; name=%S; filename=%S\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Transfer-Encoding: binary\r\n\r\n%s"
(cdr (assoc "name" (cdr data))) (cdr (assoc "filename" (cdr data)))
(cond ((stringp (cdr (assoc "filedata" (cdr data))))
(cdr (assoc "filedata" (cdr data))))
((integerp (cdr (assoc "filedata" (cdr data))))
(number-to-string (cdr (assoc "filedata" (cdr data))))))))
((equal (car data) "submit")
"Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n")
(t
(format
"Content-Disposition: form-data;name=%S\r\n\r\n%s\r\n"
(car data) (concat (mm-url-form-encode-xwfu (cdr data)))
))))
pairs))
;; use the boundary as a separator
(concat "\r\n--" boundary "\r\n"))
;; put a boundary at the end.
"--" boundary "--\r\n"))
(with-temp-buffer
(set-buffer-multibyte nil)
(cl-loop for (name . value) in data
do (insert "--" boundary "\r\n")
(cond
((equal name "file")
(insert (format "Content-Disposition: form-data; name=%S; filename=%S\r\n"
(or (cdr (assoc "name" value)) name)
(cdr (assoc "filename" value))))
(insert "Content-Transfer-Encoding: binary\r\n")
(insert (format "Content-Type: %s\r\n\r\n"
(or (cdr (assoc "content-type" value))
"text/plain")))
(let ((filedata (cdr (assoc "filedata" value))))
(cond
((stringp filedata)
(insert filedata))
;; How can this possibly be useful?
((integerp filedata)
(insert (number-to-string filedata))))))
((equal name "submit")
(insert
"Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n"))
(t
(insert (format "Content-Disposition: form-data; name=%S\r\n\r\n"
name))
(insert value)))
(unless (bolp)
(insert "\r\n")))
(insert "--" boundary "--\r\n")
(buffer-string)))
(defun mm-url-remove-markup ()
"Remove all HTML markup, leaving just plain text."