Fix problem with submitting binary data via HTTP forms

* 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).

1 files changed, 42 insertions, 33 deletions

diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index cbea134b544..d5debdb3704 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -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."