s c h e m a t i c s : c o o k b o o k

/ WebProgramming? / Cookbook.WebFileUpload

This Web


WebHome 
WebChanges 
TOC (with recipes)
NewRecipe 
WebTopicList 
WebStatistics 

Other Webs


Chicken
Cookbook
Erlang
Know
Main
Plugins
Sandbox
Scm
TWiki  

Schematics


Schematics Home
Sourceforge Page
SchemeWiki.org
Original Cookbook
RSS

Scheme Links


Schemers.org
Scheme FAQ
R5RS
SRFIs
Scheme Cross Reference
PLT Scheme SISC
Scheme48 SCM
MIT Scheme scsh
JScheme Kawa
Chicken Guile
Bigloo Tiny
Gambit LispMe
GaucheChez

Lambda the Ultimate
TWiki.org

File Upload

Problem

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.

Solution

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) ;; Most typical case first
                       (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)))) ;; procedure
                         ((multipart message)
                          (set-cdr! p (list
                                       (map process-part (entity-parts ent))))))
                       ;; return pair
                       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
":";exec /home/solsona/scheme/plt/bin/mzscheme -r $0

(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)))
  ;; Process information, and do the actual registration...
  ;; ... and finally, we return to the user (HTML of course)
  (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

 
 
Copyright © 2004 by the contributing authors. All material on the Schematics Cookbook web site is the property of the contributing authors.
The copyright for certain compilations of material taken from this website is held by the SchematicsEditorsGroup - see ContributorAgreement & LGPL.
Other than such compilations, this material can be redistributed and/or modified under the terms of the GNU Lesser General Public License (LGPL), version 2.1, as published by the Free Software Foundation.
Ideas, requests, problems regarding Schematics Cookbook? Send feedback.
/ You are Main.guest