You already know how to write complex, and useful
CGIs in scheme,
however you need to upload a file (any kind of file) from the user
computer, and into your server. Unfortunately the
cgi.ss library
does not provide any procedures to do that.
Here we will construct a (partial) but useful implementation of
RFC 2388, Returning Values from
Forms: multipart/form-data , that will extend the current
functionality of the
cgi.ss library to allow you to upload files.
This extension involves MIME to analyze responses from clients via the
HTTP protocol. Fortunately, PLT Scheme has its own
mime.ss library,
so this poses no problems at all.
Just to be clear, once the user fills out the form, and clicks the
Submit button, the browser packs the information and sends it to the
server. How does a browser packs that information? The same way as
any other MIME aware app would do with multipart/mixed document: it
writes every name/value pair in a separate part (MIME part if you
prefer), opens a connection to the Web server, and delivers the
standard HTTP headers followed by the MIME message.
So, the trick in our code is to realize that if we add the header:
Content-type: multipart/form-data to the stream delivered by the
browser we will have, indeed, a well-formed MIME message, one that can
be handled by the
mime-analyze procedure from the
mime.ss library.
(let ((in (current-input-port)))
(let-values ([(new-in raw) (make-pipe)])
(fprintf raw "Content-type: ~a~n~n" (getenv "CONTENT_TYPE"))
(let loop ((ln (read-line in)))
(unless (eof-object? ln)
(fprintf raw "~a~n" ln)
(loop (read-line in))))
(let* ((msg (mime-analyze new-in))
(ent (message-entity msg)))
(when (and (eq? (entity-type ent) 'multipart)
(eq? (entity-subtype ent) 'form-data))
(map process-part (entity-parts ent))))))
Note that we don't actually insert
multipart/form-data, and that's
because we need to know what the
boundary, used to separate different
parts, is. This
boundary is a parameter specified also in the
CONTENT_TYPE environment variable.
It would be nice if this was (as I promise it would be) an extension
of the
cgi.ss library, wouldn't it? To do so, the
process-part
procedure, in the last line above, has to return a list of name/value
pairs,
ala get-bindings/post , only this time values can be either
strings, or lists of the form
(filename type subtype procedure). We
could then wrap the whole thing in a
get-bindings/mime costume, and
off you go:
(define get-bindings/mime
(lambda ()
(letrec ((process-part
(lambda (part)
(let* ((ent (message-entity part))
(disp (entity-disposition ent))
(p (cons 'dummy 'pair)))
(case (disposition-type disp)
((form-data) (set-car! p (form-data-name (disposition-params disp)))
(case (entity-type ent)
((text)
(let ((out (open-output-string)))
(set-cdr! p (begin ((entity-body ent) out) (get-output-string out)))))
((image audio video application)
(set-cdr! p (list (filename-sans-directory
(disposition-filename disp))
(entity-type ent) (entity-subtype ent)
(entity-body ent)))) ((multipart message)
(set-cdr! p (list
(map process-part (entity-parts ent))))))
p)
((attachment)
(list (filename-sans-directory (disposition-filename disp))
(entity-type ent)
(entity-subtype ent)
(entity-body ent)))
(else
(generate-error-output
(list "Client generated malformed MIME encapsulation for form data:"
(format
"Invalid Content-disposition type: `~a'."
(disposition-type disp))))))))))
(let ((in (current-input-port)))
(let-values ([(new-in raw) (make-pipe)])
(fprintf raw "Content-type: ~a~n~n" (getenv "CONTENT_TYPE"))
(let loop ((ln (read-line in)))
(unless (eof-object? ln)
(fprintf raw "~a~n" ln)
(loop (read-line in))))
(let* ((msg (mime-analyze new-in))
(ent (message-entity msg)))
(when (and (eq? (entity-type ent) 'multipart)
(eq? (entity-subtype ent) 'form-data))
(map process-part (entity-parts ent)))))))))
Alright, that does not look as friendly as it sounds. But fear not
because this is a very, and I mean
very standard MIME message (see,
for instance, a raw version of a common e-mail message you
received... sure: one of those with pictures, and stuff). In our
case, browsers send MIME messages that can have two kinds of parts:
form-data, or
attachment. Attachments are, plain and simple,
files of one of these types: image, audio, video, application, or
file.
form-data, OTOH, can be text, attachments (files), or other
multipart messages!. (As you can surely guess, a usual name/value
pair, such as "Name"/"Foo Bar" is added as a MIME part
form-data
with type
text.)
The code above uses a couple of auxiliary procedures, and other
libraries that we won't discuss here. You can get them all, neatly
wrapped in a PLT module, at the
Schematics
site.
Let's use the beast, shall we? In the following example, you are
trying to register a new user to your site, but you require her name,
e-mail address, and picture:
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head><title>Registration</title></head>
<body>
<h1>Registration</h1>
<p>To register as a new user, simply fill out this form:</p>
<form action="/cgi-bin/doregister-with-picture.ss" method="post" enctype="multipart/form-data">
<table border="0">
<tr><td align="right"> First & last name: </td>
<td><input type="text" name="Name" size="40" value=""/></td></tr>
<tr><td align="right"> Email address: </td>
<td><input type="text" name="Email" size="40" value="" /></td></tr>
<tr><td align="right"> Picture: </td>
<td><input type="file" name="Picture" /> </td></tr>
<tr><td colspan="2" align="center"> <input type="submit" value=" Submit " /></td></tr>
</table>
</form>
</body>
</html>
Important: note the
enctype="multipart/form-data", it is crucial!.
And finally, our scheme script to eat the form information including,
of course, the picture provided by the user:
#!/bin/sh
":"
(require (lib "cgi.ss" "net")
(lib "file-upload.ss" "net"))
(let* ((b (get-bindings/mime))
(name (extract-binding/single "Name" b))
(email (extract-binding/single "Email" b))
(picture (extract-binding/single "Picture" b)))
(let ((image (car picture))
(writeme (cadddr picture)))
(call-with-output-file (build-path "/usr/local/www/data/images/" image) writeme)
(generate-html-output
"Thank you!"
(list (format "Dear ~a, " name)
"We have received your information, and this completes the registration process."
"Thank you!."
"<br />"
(format "<img src=\"/images/~a\" border=\"1\">" image))))
)
--
FranciscoSolsona - 07 Apr 2004
RSS