[REBOL] Re: need example of upload
From: andreas:bolka:gmx at: 12-Sep-2003 17:39
Thursday, September 11, 2003, 6:27:15 AM, Tim wrote:
[on parsing MIME multipart/form-data entities]
> It is called 'decode-multipart and if Andres isn't monitoring this
> thread, I would be happy to provide it.
Thanks Tim :) Regarding Patrick's original request: I'd suggest you
take a look at/do a search thru the list archives, as there have been
various threads discussing "HTTP file uploading." (search for e.g.
decode-multipart-form-data)
A simple example of how to achieve what you want:
; decodes the POST data
data: decode-multipart-form-data
system/options/cgi/content-type
read-post-data
; "thefile" is the name of your input field
file: select data to-set-word "thefile"
fname: last parse/all to-rebol-file data/filename "/\"
write/binary fname file/content
However, this does not contain any kind of validation. You need two
functions (read-post-data and decode-multipart-form-data) for this to
work, which are attached below - beware of eventual line wrappings.
I am currently quite busy with getting my websites back up and
running. Once this is done, I will eventually write a short tutorial
on this sort of CGI stuff. I fear that decode-multipart-form-data is
too large for typical cookbook recipes, but maybe it will become part
of REBOL/Core one day.
--- snip - read-post-data ---
read-post-data: func [
{Reads the HTTP entity body}
/safe "Disables evaluation of content-length header."
/local len data tmp
] [
len: load any [ all [safe "65536"] system/options/cgi/content-length "0" ]
data: make string! len
tmp: make string! len
while [ 0 < read-io system/ports/input tmp len ] [
insert tail data tmp
clear tmp
]
data
]
--- snap ---
--- snip - decode-multipart-form-data ---
REBOL [
Title:
"decode-multipart-form-data"
Authors:
[ "Andreas Bolka" ]
Contributors:
[ ]
Date:
2003-02-22
History:
[ 2002-06-18 abolka "initial release"
2003-02-21 abolka "major bugfixes and cleanup. example improved."
2003-02-22 abolka "another parsing bug fixed"
2003-09-12 abolka "fixed n/v-handling bug, noted by Marc Meurrens"
]
Rights: {
Copyright (C) 2002-2003 by Andreas Bolka
Licensed under the Academic Free License version 1.1.
See: <URL:http://earl.strain.at/license/afl> or
<URL:http://www.rosenlaw.com/afl.html>
}
Version:
1.4
Purpose: {
Decodes POST-data encoded as "multipart/form-data" as defined by
RFC 2388.
The output is compatible to 'decode-cgi wherever possible. So
the output contains a list of set-word's and values, one pair
for each data field. example:
[ field1: "foo" field2: "bar" ]
Parts of the form-data with content-type text/plain and no
filename attribute in the content dispostition will be
translated to basic name value pairs as in the example above.
Parts having with a content-type different from text/plain
and/or a filename attribute in their content disposition will
be translated to object!'s with the following fields:
filename, type, content.
An example. Imagine an HTML form like the following:
<form method="post" enctype="multipart/form-data">
<input type="text" name="field1" value="foo" />
<input type="file" name="field2" />
</form>
Once this form is submitted with "foo" in field1 and a file
called "bar.txt" containing the three bytes "nuf" in field2,
this will result in the following to be returned from
'decode-multipart-form-data:
[ field1: "foo"
field2: make object! [
filename: "bar.txt"
type: "text/plain"
content: "nuf"
]
]
}
]
decode-multipart-form-data: func [
p-content-type
p-post-data
/local list ct bd delim-beg delim-end non-cr non-lf non-crlf mime-part
] [
list: copy []
if not found? find p-content-type "multipart/form-data" [ return list ]
ct: copy p-content-type
bd: join "--" copy find/tail ct "boundary="
delim-beg: join bd crlf
delim-end: join crlf bd
non-cr: complement charset reduce [ cr ]
non-lf: complement charset reduce [ newline ]
non-crlf: [ non-cr | cr non-lf ]
mime-part: [
( ct-dispo: content: none ct-type: "text/plain" )
delim-beg ; mime-part start delimiter
"content-disposition: " copy ct-dispo any non-crlf crlf
opt [ "content-type: " copy ct-type any non-crlf crlf ]
crlf ; content delimiter
copy content
to delim-end crlf ; mime-part end delimiter
( handle-mime-part ct-dispo ct-type content )
]
handle-mime-part: func [
p-ct-dispo
p-ct-type
p-content
/local tmp name value val-p
] [
p-ct-dispo: parse p-ct-dispo {;="}
name: to-set-word (select p-ct-dispo "name")
either (none? tmp: select p-ct-dispo "filename")
and (found? find p-ct-type "text/plain") [
value: content
] [
value: make object! [
filename: copy tmp
type: copy p-ct-type
content: either none? p-content [ none ] [ copy p-content ]
]
]
either val-p: find list name
[ change/only next val-p compose [ (first next val-p) (value) ] ]
[ append list compose [ (to-set-word name) (value) ] ]
]
use [ ct-dispo ct-type content ] [
parse/all p-post-data [ some mime-part "--" crlf ]
]
list
]
--- snap ---
--
Best regards,
Andreas
