diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor index fb24fec8d9..e618249ff4 100755 --- a/basis/http/server/cgi/cgi.factor +++ b/basis/http/server/cgi/cgi.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs io.files io.streams.duplex -combinators arrays io.launcher io http.server.static http.server -http accessors sequences strings math.parser fry urls -urls.encoding ; +combinators arrays io.launcher io.encodings.binary io +http.server.static http.server http accessors sequences strings +math.parser fry urls urls.encoding calendar ; IN: http.server.cgi : cgi-variables ( script-path -- assoc ) @@ -44,14 +44,15 @@ IN: http.server.cgi : ( name -- desc ) over 1array >>command - swap cgi-variables >>environment ; + swap cgi-variables >>environment + 1 minutes >>timeout ; : serve-cgi ( name -- response ) 200 >>code "CGI output follows" >>message swap '[ - _ output-stream get swap [ + _ output-stream get swap binary [ post-request? [ request get post-data>> raw>> write flush ] when input-stream get swap (stream-copy) ] with-stream diff --git a/basis/urls/encoding/encoding-docs.factor b/basis/urls/encoding/encoding-docs.factor index 5ba94ea1bc..f8b435441f 100644 --- a/basis/urls/encoding/encoding-docs.factor +++ b/basis/urls/encoding/encoding-docs.factor @@ -19,10 +19,10 @@ HELP: assoc>query { $notes "This word is used by the implementation of " { $link "urls" } ". It is also used by the HTTP client to encode POST requests." } { $examples { $example - "USING: io urls ;" + "USING: io urls.encoding ;" "{ { \"from\" \"Lead\" } { \"to\" \"Gold, please\" } }" "assoc>query print" - "from=Lead&to=Gold%2c+please" + "from=Lead&to=Gold%2c%20please" } } ; @@ -32,7 +32,7 @@ HELP: query>assoc { $notes "This word is used by the implementation of " { $link "urls" } ". It is also used by the HTTP server to parse POST requests." } { $examples { $unchecked-example - "USING: prettyprint urls ;" + "USING: prettyprint urls.encoding ;" "\"gender=female&agefrom=22&ageto=28&location=Omaha+NE\"" "query>assoc ." <" H{ diff --git a/basis/urls/encoding/encoding-tests.factor b/basis/urls/encoding/encoding-tests.factor index 2217ec8a28..87b1812ef8 100644 --- a/basis/urls/encoding/encoding-tests.factor +++ b/basis/urls/encoding/encoding-tests.factor @@ -21,6 +21,8 @@ USING: urls.encoding tools.test arrays kernel assocs present accessors ; [ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test +[ H{ { "a" { "b" "c" } } } ] [ "a=b;a=c" query>assoc ] unit-test + [ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test [ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test diff --git a/basis/urls/encoding/encoding.factor b/basis/urls/encoding/encoding.factor index 2f89084488..fa882609a5 100644 --- a/basis/urls/encoding/encoding.factor +++ b/basis/urls/encoding/encoding.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel ascii combinators combinators.short-circuit sequences splitting fry namespaces make assocs arrays strings -io.sockets io.sockets.secure io.encodings.string -io.encodings.utf8 math math.parser accessors hashtables present ; +io.encodings.string io.encodings.utf8 math math.parser accessors +hashtables present ; IN: urls.encoding : url-quotable? ( ch -- ? ) @@ -76,7 +76,7 @@ PRIVATE> : query>assoc ( query -- assoc ) dup [ - "&" split H{ } clone [ + "&;" split H{ } clone [ [ [ "=" split1 [ dup [ query-decode ] when ] bi@ swap ] dip add-query-param diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index cac206bf3c..c98802657b 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -10,6 +10,7 @@ arrays kernel assocs present accessors ; { host "www.apple.com" } { port 1234 } { path "/a/path" } + { raw-query "a=b" } { query H{ { "a" "b" } } } { anchor "foo" } } @@ -20,6 +21,7 @@ arrays kernel assocs present accessors ; { protocol "http" } { host "www.apple.com" } { path "/a/path" } + { raw-query "a=b" } { query H{ { "a" "b" } } } { anchor "foo" } } @@ -57,6 +59,7 @@ arrays kernel assocs present accessors ; { T{ url { path "bar" } + { raw-query "a=b" } { query H{ { "a" "b" } } } } "bar?a=b" @@ -210,6 +213,7 @@ urls [ T{ url { protocol "http" } { host "localhost" } + { raw-query "foo=bar" } { query H{ { "foo" "bar" } } } { path "/" } } @@ -220,6 +224,7 @@ urls [ T{ url { protocol "http" } { host "localhost" } + { raw-query "foo=bar" } { query H{ { "foo" "bar" } } } { path "/" } } diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 5ebcabede8..fb56e274da 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -8,7 +8,7 @@ strings.parser lexer prettyprint.backend hashtables present peg.ebnf urls.encoding ; IN: urls -TUPLE: url protocol username password host port path query anchor ; +TUPLE: url protocol username password host port path raw-query query anchor ; : ( -- url ) url new ; @@ -47,7 +47,7 @@ protocol = [a-z]+ => [[ url-decode ]] username = [^/:@#?]+ => [[ url-decode ]] password = [^/:@#?]+ => [[ url-decode ]] pathname = [^#?]+ => [[ url-decode ]] -query = [^#]+ => [[ query>assoc ]] +query = [^#]+ => [[ >string ]] anchor = .+ => [[ url-decode ]] hostname = [^/#?]+ => [[ url-decode ]] @@ -80,7 +80,7 @@ M: string >url ] [ f f f f f ] if* ] [ second ] ! pathname - [ third ] ! query + [ third dup query>assoc ] ! query [ fourth ] ! anchor } cleave url boa dup host>> [ [ "/" or ] change-path ] when ; diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 71fc1116b3..72eb483066 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -8,6 +8,8 @@ html.templates.chloe http.server http.server.dispatchers http.server.redirection +http.server.static +http.server.cgi furnace.alloy furnace.auth.login furnace.auth.providers.db @@ -82,14 +84,19 @@ SYMBOL: dh-file main-responder set-global ; +: ( path -- responder ) + + swap enable-cgi >>default + URL" /gitweb.cgi" "" add-responder ; + : init-production ( -- ) common-configuration - "concatenative.org" add-responder - "paste.factorcode.org" add-responder - "planet.factorcode.org" add-responder - home "docs" append-path "docs.factorcode.org" add-responder - + "concatenative.org" add-responder + "paste.factorcode.org" add-responder + "planet.factorcode.org" add-responder + home "docs" append-path "docs.factorcode.org" add-responder + home "cgi" append-path "gitweb.factorcode.org" add-responder main-responder set-global ; : ( -- config )