From 050dbf8a609c30eeb1bf3294e2864deb5e6a4126 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 20 Jan 2009 16:35:52 -0600
Subject: [PATCH] http server can upload files. WOW!

---
 basis/http/http.factor          |  8 ++++---
 basis/http/server/server.factor | 40 ++++++++++++++++++++++++---------
 2 files changed, 35 insertions(+), 13 deletions(-)
 mode change 100644 => 100755 basis/http/http.factor
 mode change 100644 => 100755 basis/http/server/server.factor

diff --git a/basis/http/http.factor b/basis/http/http.factor
old mode 100644
new mode 100755
index 4702f88830..b29f5222db
--- a/basis/http/http.factor
+++ b/basis/http/http.factor
@@ -213,12 +213,14 @@ body ;
     raw-response new
         "1.1" >>version ;
 
-TUPLE: post-data raw content content-type ;
+TUPLE: post-data raw content content-type form-variables uploaded-files ;
 
-: <post-data> ( raw content-type -- post-data )
+: <post-data> ( form-variables uploaded-files raw content-type -- post-data )
     post-data new
         swap >>content-type
-        swap >>raw ;
+        swap >>raw
+        swap >>uploaded-files
+        swap >>form-variables ;
 
 : parse-content-type-attributes ( string -- attributes )
     " " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor
old mode 100644
new mode 100755
index 697dec24ce..1c516e9051
--- a/basis/http/server/server.factor
+++ b/basis/http/server/server.factor
@@ -15,6 +15,8 @@ io.streams.limited
 io.servers.connection
 io.timeouts
 fry logging logging.insomniac calendar urls urls.encoding
+mime.multipart
+unicode.categories
 http
 http.parsers
 http.server.responses
@@ -36,17 +38,35 @@ IN: http.server
 : read-request-header ( request -- request )
     read-header >>header ;
 
-: parse-post-data ( post-data -- post-data )
-    [ ] [ raw>> ] [ content-type>> ] tri
-    "application/x-www-form-urlencoded" = [ query>assoc ] when
-    >>content ;
+ERROR: no-boundary ;
+
+: parse-multipart-form-data ( string -- separator )
+    ";" split1 nip
+    "=" split1 nip [ no-boundary ] unless* ;
+
+: read-multipart-data ( request -- form-variables uploaded-files )
+    [ "content-type" header ]
+    [ "content-length" header string>number ] bi
+    unlimit-input
+    stream-eofs limit-input
+    binary decode-input
+    parse-multipart-form-data parse-multipart ;
+
+: read-content ( request -- bytes )
+    "content-length" header string>number read ;
+
+: parse-content ( request content-type -- form-variables uploaded-files raw )
+    {
+        { "multipart/form-data" [ read-multipart-data f ] }
+        { "application/x-www-form-urlencoded" [ read-content [ f f ] dip ] }
+        [ drop read-content [ f f ] dip ]
+    } case ;
 
 : read-post-data ( request -- request )
     dup method>> "POST" = [
-        [ ]
-        [ "content-length" header string>number read ]
-        [ "content-type" header ] tri
-        <post-data> parse-post-data >>post-data
+        dup dup "content-type" header
+        [ ";" split1 drop parse-content ] keep
+        <post-data> >>post-data
     ] when ;
 
 : extract-host ( request -- request )
@@ -80,7 +100,7 @@ GENERIC: write-full-response ( request response -- )
     [ content-type>> "application/octet-stream" or ]
     [ content-charset>> encoding>name ]
     bi
-    [ "; charset=" swap 3append ] when* ;
+    [ "; charset=" glue ] when* ;
 
 : ensure-domain ( cookie -- cookie )
     [
@@ -236,7 +256,7 @@ TUPLE: http-server < threaded-server ;
 M: http-server handle-client*
     drop
     [
-        64 1024 * limit-input
+        64 1024 * stream-throws limit-input
         ?refresh-all
         [ read-request ] ?benchmark
         [ do-request ] ?benchmark