IN: multipart-upload USING: io.pathnames io.files sequences arrays math.parser kernel combinators accessors io.encodings.binary io.encodings.string ; ! This is just re-creating a captured example, so it's a specific use case, and should be generalized, according to the spec. ! Things I'm not sure about: 1) if length should be part of it. ! 2) how to combine text with binary. ! right now I convert the text to binary and append the file to it. ! I prefer to have data passed until the last moment, but will use write if the file gets corrupted otherwise. ! EXAMPLE: ! { } "HI I'm the content" "here's the field name!" suffix ! "C:/video/2009/01-January-2009/01/SINGLE NEWS wmv and PHOTOS gif/20090101-01-China_Stocks_Biggest_Loser_in_2008.wmv" ! "file name field" suffix ! "----------l3PMNll8CXjZ5BC7GGnaMo" build-multi-part ! "E:/mimetest2.txt" utf8 set-file-contents TUPLE: text-part { content-disposition initial: "form-data" } field-name content ; TUPLE: file-part file { content-disposition initial: "form-data" } field-name filename mimetype raw ; : content-type-from-ext ( filename -- type ) file-extension { { [ "wmv" = ] [ "video/x-ms-wmv" ] } [ "sorry I don't know this type, please add the correct mimetype" throw ] } cond ; : content-type-by-data ( file -- type ) ! a 'magic number' guesser. binding to 'file' or tap into its magic file. "UNIMPLEMENTED. FUTURE WORK" throw ; : content-type ( file -- type ) content-type-from-ext ; : ( content field-name -- tuple ) text-part new swap >>field-name swap >>content ; : ( file field-name -- tuple ) file-part new swap >>field-name swap [ >>file ] [ [ file-name >>filename ] [ content-type >>mimetype ] [ binary file-contents >>raw ] tri ] bi ; : nl+ ( str -- str ) "\r\n" prepend ; : +nl ( str -- str ) "\r\n" append ; : +2nl ( str -- str ) +nl +nl ; : quote-me ( str -- str ) "\"" dup surround ; : crlf-me ( str -- str ) "\r\n" dup surround ; : dispo+name ( tuple -- dispo name ) [ content-disposition>> "Content-Disposition: " prepend ] [ field-name>> quote-me "name=" prepend ] bi ; : build-file-part ( tuple -- str ) [ [ [ dispo+name ] [ filename>> quote-me "filename=" prepend ] bi 3array "; " join +nl ] [ mimetype>> "Content-Type: " prepend +nl ] bi append +nl binary decode ] [ raw>> ] bi append ; : build-text-part ( tuple -- str ) [ dispo+name 2array "; " join +nl ] [ content>> nl+ ] bi append ; : build-one-part ( tuple -- str ) { { [ dup file-part? ] [ build-file-part ] } { [ dup text-part? ] [ build-text-part ] } [ "ERROR: expected a text-part or a file-part tuple" throw ] } cond ; : content-length-txt ( str -- length-str ) length number>string "Content-Length: " prepend +nl ; : content-type-txt ( boundary -- str ) "Content-Type: multipart/form-data; boundary=" prepend +nl ; : -over ( x y -- y x y ) dup -rot ; : join+before ( seq chars -- str ) [ join ] keep prepend ; : build-multi-part ( parts-seq boundary -- string ) ! seq of tuples and a boundary. swap [ text-part? ] partition append [ build-one-part ] map over "--" prepend crlf-me join+before ! boundary seq -> boundary seq boundary' -> boundary str -over [ content-length-txt ] [ content-type-txt ] [ ] tri* 3append ;