HTTP server fixes

db4
Slava Pestov 2008-02-25 15:24:48 -06:00
parent d8e19ccb95
commit cc89218af1
7 changed files with 833350 additions and 8 deletions

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -61,5 +61,5 @@ SYMBOL: realms
#! Check if the user is authenticated in the given realm
#! to run the specified quotation. If not, use Basic
#! Authentication to ask for authorization details.
over "Authorization" header-param authorization-ok?
over "authorization" header-param authorization-ok?
[ nip call ] [ drop authentication-error ] if ;

View File

@ -77,7 +77,7 @@ SYMBOL: max-post-request
1024 256 * max-post-request set-global
: content-length ( header -- n )
"content-length" peek at string>number dup [
"content-length" peek-at string>number dup [
dup max-post-request get > [
"Content-Length > max-post-request" throw
] when

View File

@ -31,13 +31,13 @@ SYMBOL: cgi-root
"method" get >upper "REQUEST_METHOD" set
"raw-query" get "QUERY_STRING" set
"Cookie" header-param "HTTP_COOKIE" set
"cookie" header-param "HTTP_COOKIE" set
"User-Agent" header-param "HTTP_USER_AGENT" set
"Accept" header-param "HTTP_ACCEPT" set
"user-agent" header-param "HTTP_USER_AGENT" set
"accept" header-param "HTTP_ACCEPT" set
post? [
"Content-Type" header-param "CONTENT_TYPE" set
"content-type" header-param "CONTENT_TYPE" set
"raw-response" get length number>string "CONTENT_LENGTH" set
] when
] H{ } make-assoc ;

View File

@ -25,7 +25,7 @@ SYMBOL: doc-root
: last-modified-matches? ( filename -- bool )
file-http-date dup [
"If-Modified-Since" header-param =
"if-modified-since" header-param =
] when ;
: not-modified-response ( -- )

View File

@ -25,7 +25,7 @@ IN: webapps.fjsc
: compile-url ( url -- )
#! Compile the factor code at the given url, return the javascript.
dup "http:" head? [ "Unable to access remote sites." throw ] when
"http://" "Host" header-param rot 3append http-get compile "();" write flush ;
"http://" "host" header-param rot 3append http-get compile "();" write flush ;
\ compile-url {
{ "url" v-required }