Fix file uploads by using unlimit-stream for now. Will compare solution to with-combinators tomorrow.

db4
Doug Coleman 2010-09-08 02:49:04 -05:00
parent 750e61117e
commit dc4970e234
3 changed files with 73 additions and 6 deletions

View File

@ -49,12 +49,19 @@ ERROR: no-boundary ;
";" split1 nip
"=" split1 nip [ no-boundary ] unless* ;
SYMBOL: request-limit
request-limit [ 64 1024 * ] initialize
SYMBOL: upload-limit
upload-limit [ 200,000,000 ] initialize
: read-multipart-data ( request -- mime-parts )
[ "content-type" header ]
[ "content-length" header string>number ] bi
upload-limit get min limited-input
unlimited-input
upload-limit get [ min ] when* limited-input
binary decode-input
parse-multipart-form-data parse-multipart ;
@ -276,14 +283,10 @@ LOG: httpd-benchmark DEBUG
TUPLE: http-server < threaded-server ;
SYMBOL: request-limit
request-limit [ 64 1024 * ] initialize
M: http-server handle-client*
drop [
request-limit get limited-input
?refresh-all
request-limit get limited-input
[ read-request ] ?benchmark
[ do-request ] ?benchmark
[ do-response ] ?benchmark

View File

@ -79,3 +79,46 @@ IN: io.streams.limited.tests
"asdf" over stream-write dup stream-flush
3 swap stream-read
] unit-test
[ t ]
[
"abc" <string-reader> 3 limit-stream unlimit-stream
"abc" <string-reader> =
] unit-test
[ t ]
[
"abc" <string-reader> 3 limit-stream unlimit-stream
"abc" <string-reader> =
] unit-test
[ t ]
[
[
"resource:license.txt" utf8 <file-reader> &dispose
3 limit-stream unlimit-stream
"resource:license.txt" utf8 <file-reader> &dispose
[ decoder? ] both?
] with-destructors
] unit-test
[ "asdf" ] [
"asdf" <string-reader> 2 <limited-stream> [
unlimited-input contents
] with-input-stream
] unit-test
[ "asdf" ] [
"asdf" <string-reader> 2 <limited-stream> [
[ contents ] with-unlimited-input
] with-input-stream
] unit-test
[ "gh" ] [
"asdfgh" <string-reader> 4 <limited-stream> [
2 [
[ contents drop ] with-unlimited-input
] with-limited-input
[ contents ] with-unlimited-input
] with-input-stream
] unit-test

View File

@ -33,6 +33,10 @@ M: object limit-stream ( stream limit -- stream' )
: with-limited-stream ( stream limit quot -- )
[ limit-stream ] dip call ; inline
: with-limited-input ( limit quot -- )
[ [ input-stream get ] dip limit-stream input-stream ] dip
with-variable ; inline
ERROR: limit-exceeded n stream ;
<PRIVATE
@ -127,3 +131,20 @@ M: limited-stream dispose stream>> dispose ;
M: limited-stream stream-element-type
stream>> stream-element-type ;
GENERIC: unlimit-stream ( stream -- stream' )
M: decoder unlimit-stream ( stream -- stream' )
[ stream>> ] change-stream ;
M: limited-stream unlimit-stream ( stream -- stream' ) stream>> ;
: unlimited-input ( -- )
input-stream [ unlimit-stream ] change ;
: with-unlimited-stream ( stream quot -- )
[ unlimit-stream ] dip call ; inline
: with-unlimited-input ( quot -- )
[ input-stream get unlimit-stream input-stream ] dip
with-variable ; inline