Author: turbo24prg
Date: Sun Sep 10 19:37:43 2006
New Revision: 10908
Modified:
trunk/libraries/koala/sources/koala/server.dylan
trunk/libraries/web-framework/changes.dylan
trunk/libraries/web-framework/library.dylan
Log:
Job: koala
* upload hack
Modified: trunk/libraries/koala/sources/koala/server.dylan
==============================================================================
--- trunk/libraries/koala/sources/koala/server.dylan (original)
+++ trunk/libraries/koala/sources/koala/server.dylan Sun Sep 10 19:37:43 2006
@@ -512,7 +512,7 @@
slot request-responder :: false-or(<function>) = #f;
// For directory responders, this contains the part of the URL after
- // the matched directory prefix and before the & (if any).
+ // the matched directory prefix and before the ? (if any).
slot request-url-tail :: <string> = "";
end class <request>;
@@ -736,9 +736,10 @@
define function process-request-content
(request :: <request>, buffer :: <byte-string>, content-length ::
<integer>)
=> (content :: <string>)
- let content-type = get-header(request, "content-type");
- if (instance?(content-type, <string>)
- & string-equal?("application/x-www-form-urlencoded", content-type))
+ let header-content-type = split(get-header(request, "content-type"),
separator: ";");
+ let content-type = first(header-content-type);
+ if (instance?(content-type, <string>) &
+ string-equal?("application/x-www-form-urlencoded", content-type))
log-debug("Form query string = %=",
copy-sequence(buffer, end: content-length));
// Replace '+' with Space. See RFC 1866 (HTML) section 8.2.
@@ -757,6 +758,20 @@
elseif (member?(content-type, #["text/xml", "text/html", "text/plain"],
test: string-equal?))
request-content(request) := buffer
+ elseif (instance?(content-type, <string>) &
+ element(header-content-type, 1, default: #f) &
+ string-equal?("multipart/form-data", content-type))
+ let boundary = split(second(header-content-type), separator: "=");
+ if (element(boundary, 1, default: #f))
+ let boundary-value = second(boundary);
+ log-debug("boundary: %=", boundary-value);
+ extract-form-data(buffer, boundary-value, request);
+ // ???
+ request-content(request) := buffer
+ else
+ log-error("%=", "content-type is missing the boundary parameter");
+ unsupported-media-type-error();
+ end if
else
unsupported-media-type-error();
end if;
@@ -1004,6 +1019,44 @@
end;
end extract-request-version;
+define method extract-form-data
+ (buffer :: <string>, boundary :: <string>, request :: <request>)
+ // strip everything after end-boundary
+ let buffer = first(split(buffer, separator: concatenate("--", boundary,
"--")));
+ let parts = split(buffer, separator: concatenate("--", boundary));
+ for (part in parts)
+ let part = split(part, separator: "\r\n\r\n");
+ let header = first(part);
+ let header-entries = split(header, separator: "\r\n");
+ let disposition = #f;
+ let name = #f;
+ let type = #f;
+ let filename = #f;
+ for (header-entry in header-entries)
+ let header-entry-parts = split(header-entry, separator: ";");
+ for (header-entry-part in header-entry-parts)
+ let eq-pos = char-position('=', header-entry-part, 0,
size(header-entry-part));
+ let p-pos = char-position(':', header-entry-part, 0,
size(header-entry-part));
+ if (p-pos & (substring(header-entry-part, 0, p-pos) =
"Content-Disposition"))
+ disposition := substring(header-entry-part, p-pos + 2,
size(header-entry-part));
+ elseif (p-pos & (substring(header-entry-part, 0, p-pos) =
"Content-Type"))
+ type := substring(header-entry-part, p-pos + 2,
size(header-entry-part));
+ elseif (eq-pos & (substring(header-entry-part, 0, eq-pos) = "name"))
+ // name unquoted
+ name := substring(header-entry-part, eq-pos + 2,
size(header-entry-part) - 1);
+ elseif (eq-pos & (substring(header-entry-part, 0, eq-pos) =
"filename"))
+ // filename unquoted
+ filename := substring(header-entry-part, eq-pos + 2,
size(header-entry-part) - 1);
+ end if;
+ end for;
+ end for;
+ if (part.size > 1)
+ request.request-query-values[name] := substring(second(part), 0,
size(second(part)) - 1);
+ end if;
+ log-debug("multipart/form-data for %=: %=, %=, %=", name, disposition,
type, filename);
+ end for;
+end method extract-form-data;
+
// Turn a string like "foo=8&bar=&baz=zzz" into a <string-table> with the
"obvious" keys/vals.
// Note that in the above example string "bar" maps to "", not #f.
//---TODO: Find out if the query keys are case-sensitive in the HTTP spec and
make sure this
Modified: trunk/libraries/web-framework/changes.dylan
==============================================================================
--- trunk/libraries/web-framework/changes.dylan (original)
+++ trunk/libraries/web-framework/changes.dylan Sun Sep 10 19:37:43 2006
@@ -40,19 +40,22 @@
define open class <entry> (<object>)
/* slot CommonAttributes */
- slot authors :: <list> = #(),
+ slot authors :: <stretchy-vector> =
+ make(<stretchy-vector>, size: 0),
init-keyword: authors:;
- slot categories :: <list> = #(),
+ slot categories :: <stretchy-vector> =
+ make(<stretchy-vector>, size: 0),
init-keyword: categories:;
slot content :: false-or(<content>) = #f,
init-keyword: content:;
- slot contributors :: <list> = #(),
+ slot contributors :: <stretchy-vector> =
+ make(<stretchy-vector>, size: 0),
init-keyword: contributors:;
slot identifier :: <uri>,
init-keyword: identifier:;
slot links :: <list> = #(),
init-keyword: links:;
- slot published :: <date>,
+ slot published :: <date> = current-date(),
init-keyword: published:;
slot rights :: false-or(<text>) = #f,
init-keyword: rights:;
@@ -69,6 +72,15 @@
/* repeated slot extensionElement */
end;
+define class <comment> (<object>)
+ slot commenter :: <string>,
+ init-keyword: commenter:;
+ slot email :: <email>,
+ init-keyword: email:;
+ slot content :: <content>,
+ init-keyword: content:;
+end;
+
define abstract class <content> (<object>)
/* slot CommonAttributes */
slot type :: <string>, init-keyword: type:;
@@ -77,7 +89,15 @@
define class <raw-content> (<content>)
inherited slot type :: <string> = "raw";
-end class <raw-content>;
+end;
+
+define class <textile-content> (<content>)
+ inherited slot type :: <string> = "textile";
+end;
+
+define class <xhtml-content> (<content>)
+ inherited slot type :: <string> = "xhtml";
+end;
/*
define class <inline-text-content> (<content>)
Modified: trunk/libraries/web-framework/library.dylan
==============================================================================
--- trunk/libraries/web-framework/library.dylan (original)
+++ trunk/libraries/web-framework/library.dylan Sun Sep 10 19:37:43 2006
@@ -176,12 +176,16 @@
text, text-setter;
export <content>,
- <raw-content>;
+ <raw-content>,
+ <textile-content>,
+ <xhtml-content>;
//commands
export <add-command>,
<remove-command>,
<edit-command>;
+
+ export <comment>;
end;
--
Gd-chatter mailing list
Gd-chatter@xxxxxxxxxxxxxxxx
https://www.opendylan.org/mailman/listinfo/gd-chatter
|
