steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix information leakage

db4
Slava Pestov 2008-06-16 01:35:06 -05:00
parent 00e9725729
commit a943a237d9
3 changed files with 25 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/http/http-tests.factor
View File

@ -276,3 +276,7 @@ SYMBOL: a
[ 4 ] [ a get-global ] unit-test [ 4 ] [ a get-global ] unit-test
[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test [ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
! Test cloning
[ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
[ f ] [ <404> dup clone "b" "a" <cookie> put-cookie drop "a" get-cookie ] unit-test

14
extra/http/http.factor
View File

@ -6,7 +6,8 @@ assocs sequences splitting sorting sets debugger
strings vectors hashtables quotations arrays byte-arrays strings vectors hashtables quotations arrays byte-arrays
math.parser calendar calendar.format present math.parser calendar calendar.format present
io io.encodings.iana io.encodings.binary io.encodings.8-bit io io.encodings io.encodings.iana io.encodings.binary
io.encodings.8-bit
unicode.case unicode.categories qualified unicode.case unicode.categories qualified
@ -298,6 +299,11 @@ body ;
latin1 >>content-charset latin1 >>content-charset
V{ } clone >>cookies ; V{ } clone >>cookies ;
M: response clone
call-next-method
[ clone ] change-header
[ clone ] change-cookies ;
: read-response-version ( response -- response ) : read-response-version ( response -- response )
" \t" read-until " \t" read-until
[ "Bad response: version" throw ] unless [ "Bad response: version" throw ] unless
@ -363,7 +369,11 @@ M: response write-response ( respose -- )
M: response write-full-response ( request response -- ) M: response write-full-response ( request response -- )
dup write-response dup write-response
swap method>> "HEAD" = [ write-response-body ] unless ; swap method>> "HEAD" = [
[ content-charset>> encode-output ]
[ write-response-body ]
bi
] unless ;
: get-cookie ( request/response name -- cookie/f ) : get-cookie ( request/response name -- cookie/f )
[ cookies>> ] dip '[ , _ name>> = ] find nip ; [ cookies>> ] dip '[ , _ name>> = ] find nip ;

17
extra/http/server/server.factor
View File

@ -60,23 +60,16 @@ main-responder global [ <404> <trivial-responder> or ] change-at
swap development? get [ '[ , http-error. ] >>body ] [ drop ] if ; swap development? get [ '[ , http-error. ] >>body ] [ drop ] if ;
: do-response ( response -- ) : do-response ( response -- )
[ write-response ] [ request get swap write-full-response ]
[ [
request get method>> "HEAD" = [ drop ] [ [ \ do-response log-error ]
'[
,
[ content-charset>> encode-output ]
[ write-response-body ]
bi
]
[ [
utf8 [ utf8 [
development? get development? get
[ http-error. ] [ drop "Response error" rethrow ] if [ http-error. ] [ drop "Response error" write ] if
] with-encoded-output ] with-encoded-output
] recover ] bi
] if ] recover ;
] bi ;
LOG: httpd-hit NOTICE LOG: httpd-hit NOTICE