[Gd-chatter] r11191 - trunk/libraries/network/koala/sources/koala
turbo24prg at gwydiondylan.org
turbo24prg at gwydiondylan.org
Mon Feb 19 01:10:14 CET 2007
Author: turbo24prg
Date: Mon Feb 19 01:10:11 2007
New Revision: 11191
Modified:
trunk/libraries/network/koala/sources/koala/dsp.dylan
trunk/libraries/network/koala/sources/koala/library-unix.dylan
trunk/libraries/network/koala/sources/koala/library.dylan
trunk/libraries/network/koala/sources/koala/server.dylan
Log:
Job: koala
* generic content-type support
Modified: trunk/libraries/network/koala/sources/koala/dsp.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/dsp.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/dsp.dylan Mon Feb 19 01:10:11 2007
@@ -101,19 +101,21 @@
end;
end process-page;
-define method respond-to (request :: <symbol>, page :: <page>, request :: <request>, response :: <response>)
+define open generic respond-to (request-method :: <symbol>, page :: <page>, request :: <request>, response :: <response>);
+
+define method respond-to (request-method :: <symbol>, page :: <page>, request :: <request>, response :: <response>)
unsupported-request-method-error()
end;
-define method respond-to (request == #"GET", page :: <page>, request :: <request>, response :: <response>)
+define method respond-to (request-method == #"GET", page :: <page>, request :: <request>, response :: <response>)
respond-to-get(page, request, response);
end;
-define method respond-to (request == #"POST", page :: <page>, request :: <request>, response :: <response>)
+define method respond-to (request-method == #"POST", page :: <page>, request :: <request>, response :: <response>)
respond-to-post(page, request, response);
end;
-define method respond-to (request == #"HEAD", page :: <page>, request :: <request>, response :: <response>)
+define method respond-to (request-method == #"HEAD", page :: <page>, request :: <request>, response :: <response>)
respond-to-head(page, request, response);
end;
@@ -815,7 +817,7 @@
// process-template explicitly.
//
define method respond-to-get
- (page :: <dylan-server-page>, request :: <request>, response :: <response>)
+ (page :: <dylan-server-page>, request :: <request>, response :: <response>)
process-template(page, request, response);
end;
Modified: trunk/libraries/network/koala/sources/koala/library-unix.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library-unix.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/library-unix.dylan Mon Feb 19 01:10:11 2007
@@ -372,6 +372,7 @@
respond-to-get, // Implement this for your page to handle GET requests
respond-to-post, // Implement this for your page to handle POST requests
respond-to-head, // Implement this for your page to handle HEAD requests
+ respond-to,
page-source,
page-source-setter,
Modified: trunk/libraries/network/koala/sources/koala/library.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/library.dylan Mon Feb 19 01:10:11 2007
@@ -364,6 +364,7 @@
respond-to-get, // Implement this for your page to handle GET requests
respond-to-post, // Implement this for your page to handle POST requests
respond-to-head, // Implement this for your page to handle HEAD requests
+ respond-to,
page-source,
page-source-setter,
Modified: trunk/libraries/network/koala/sources/koala/server.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/server.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/server.dylan Mon Feb 19 01:10:11 2007
@@ -702,7 +702,8 @@
let n = kludge-read-into!(request-socket(request), content-length, buffer);
assert(n == content-length, "Unexpected incomplete read");
request-content(request)
- := process-request-content(request, buffer, content-length);
+ := process-request-content(as(<symbol>, first(split(get-header(request, "content-type"), separator: ";"))),
+ request, buffer, content-length);
end
end read-request-content;
@@ -735,46 +736,59 @@
end;
end;
-define function process-request-content
- (request :: <request>, buffer :: <byte-string>, content-length :: <integer>)
+define open generic process-request-content
+ (content-type :: <symbol>, request :: <request>, buffer :: <byte-string>, content-length :: <integer>)
+ => (content :: <string>);
+
+define method process-request-content
+ (content-type :: <symbol>, request :: <request>,
+ buffer :: <byte-string>, content-length :: <integer>)
=> (content :: <string>)
- 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.
- // Must do this before calling decode-url.
- for (i from 0 below buffer.size)
- iff(buffer[i] == '+',
- buffer[i] := ' ');
- end;
- let content = decode-url(buffer, 0, content-length);
- // By the time we get here request-query-values has already been bound to a <string-table>
- // containing the URL query values. Now we augment it with any form values.
- extract-query-values(buffer, 0, content-length,
- request.request-query-values);
- request-content(request) := content
+ unsupported-media-type-error()
+end;
+
+define method process-request-content
+ (content-type == #"application/x-www-form-urlencoded", request :: <request>,
+ buffer :: <byte-string>, content-length :: <integer>)
+ => (content :: <string>)
+ log-debug("Form query string = %=",
+ copy-sequence(buffer, end: content-length));
+ // Replace '+' with Space. See RFC 1866 (HTML) section 8.2.
+ // Must do this before calling decode-url.
+ for (i from 0 below buffer.size)
+ iff(buffer[i] == '+',
+ buffer[i] := ' ');
+ end;
+ let content = decode-url(buffer, 0, content-length);
+ // By the time we get here request-query-values has already been bound to a <string-table>
+ // containing the URL query values. Now we augment it with any form values.
+ extract-query-values(buffer, 0, content-length,
+ request.request-query-values);
+ request-content(request) := content
// ---TODO: Deal with content types intelligently. For now this'll have to do.
- elseif (member?(content-type, #["text/xml", "text/html", "text/plain"],
- test: string-equal?))
+end;
+
+define method process-request-content
+ (content-type :: one-of(#"text/xml", #"text/html", #"text/plain"), request :: <request>,
+ buffer :: <byte-string>, content-length :: <integer>)
+ => (content :: <string>)
+ request-content(request) := buffer
+end;
+
+define method process-request-content
+ (content-type == #"multipart/form-data", request :: <request>,
+ buffer :: <byte-string>, content-length :: <integer>)
+ => (content :: <string>)
+ let header-content-type = split(get-header(request, "content-type"), separator: ";");
+ 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
- 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
+ log-error("%=", "content-type is missing the boundary parameter");
unsupported-media-type-error();
end if;
end;
More information about the chatter
mailing list