Fix file uploads by using unlimit-stream for now. Will compare solution to with-combinators tomorrow.
parent
750e61117e
commit
dc4970e234
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue