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

Merge branch 'master' of git://factorcode.org/git/factor

db4
John Benediktsson 2008-09-29 20:18:25 -07:00
parent 73cc902090 90eaffe40c
commit 165b98419a
7 changed files with 34 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/http/server/cgi/cgi.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs io.files io.streams.duplex USING: namespaces kernel assocs io.files io.streams.duplex
combinators arrays io.launcher io http.server.static http.server combinators arrays io.launcher io.encodings.binary io
http accessors sequences strings math.parser fry urls http.server.static http.server http accessors sequences strings
urls.encoding ; math.parser fry urls urls.encoding calendar ;
IN: http.server.cgi IN: http.server.cgi
: cgi-variables ( script-path -- assoc ) : cgi-variables ( script-path -- assoc )
@ -44,14 +44,15 @@ IN: http.server.cgi
: <cgi-process> ( name -- desc ) : <cgi-process> ( name -- desc )
<process> <process>
over 1array >>command over 1array >>command
swap cgi-variables >>environment ; swap cgi-variables >>environment
1 minutes >>timeout ;
: serve-cgi ( name -- response ) : serve-cgi ( name -- response )
<raw-response> <raw-response>
200 >>code 200 >>code
"CGI output follows" >>message "CGI output follows" >>message
swap '[ swap '[
_ output-stream get swap <cgi-process> <process-stream> [ _ output-stream get swap <cgi-process> binary <process-stream> [
post-request? [ request get post-data>> raw>> write flush ] when post-request? [ request get post-data>> raw>> write flush ] when
input-stream get swap (stream-copy) input-stream get swap (stream-copy)
] with-stream ] with-stream

6
basis/urls/encoding/encoding-docs.factor
View File

@ -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." } { $notes "This word is used by the implementation of " { $link "urls" } ". It is also used by the HTTP client to encode POST requests." }
{ $examples { $examples
{ $example { $example
"USING: io urls ;" "USING: io urls.encoding ;"
"{ { \"from\" \"Lead\" } { \"to\" \"Gold, please\" } }" "{ { \"from\" \"Lead\" } { \"to\" \"Gold, please\" } }"
"assoc>query print" "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." } { $notes "This word is used by the implementation of " { $link "urls" } ". It is also used by the HTTP server to parse POST requests." }
{ $examples { $examples
{ $unchecked-example { $unchecked-example
"USING: prettyprint urls ;" "USING: prettyprint urls.encoding ;"
"\"gender=female&agefrom=22&ageto=28&location=Omaha+NE\"" "\"gender=female&agefrom=22&ageto=28&location=Omaha+NE\""
"query>assoc ." "query>assoc ."
<" H{ <" H{

2
basis/urls/encoding/encoding-tests.factor
View File

@ -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{ { "a" { "b" "c" } } } ] [ "a=b;a=c" query>assoc ] unit-test
[ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test [ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test
[ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test [ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test

6
basis/urls/encoding/encoding.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel ascii combinators combinators.short-circuit USING: kernel ascii combinators combinators.short-circuit
sequences splitting fry namespaces make assocs arrays strings sequences splitting fry namespaces make assocs arrays strings
io.sockets io.sockets.secure io.encodings.string io.encodings.string io.encodings.utf8 math math.parser accessors
io.encodings.utf8 math math.parser accessors hashtables present ; hashtables present ;
IN: urls.encoding IN: urls.encoding
: url-quotable? ( ch -- ? ) : url-quotable? ( ch -- ? )
@ -76,7 +76,7 @@ PRIVATE>
: query>assoc ( query -- assoc ) : query>assoc ( query -- assoc )
dup [ dup [
"&" split H{ } clone [ "&;" split H{ } clone [
[ [
[ "=" split1 [ dup [ query-decode ] when ] bi@ swap ] dip [ "=" split1 [ dup [ query-decode ] when ] bi@ swap ] dip
add-query-param add-query-param

5
basis/urls/urls-tests.factor
View File

@ -10,6 +10,7 @@ arrays kernel assocs present accessors ;
{ host "www.apple.com" } { host "www.apple.com" }
{ port 1234 } { port 1234 }
{ path "/a/path" } { path "/a/path" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
{ anchor "foo" } { anchor "foo" }
} }
@ -20,6 +21,7 @@ arrays kernel assocs present accessors ;
{ protocol "http" } { protocol "http" }
{ host "www.apple.com" } { host "www.apple.com" }
{ path "/a/path" } { path "/a/path" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
{ anchor "foo" } { anchor "foo" }
} }
@ -57,6 +59,7 @@ arrays kernel assocs present accessors ;
{ {
T{ url T{ url
{ path "bar" } { path "bar" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
} }
"bar?a=b" "bar?a=b"
@ -210,6 +213,7 @@ urls [
T{ url T{ url
{ protocol "http" } { protocol "http" }
{ host "localhost" } { host "localhost" }
{ raw-query "foo=bar" }
{ query H{ { "foo" "bar" } } } { query H{ { "foo" "bar" } } }
{ path "/" } { path "/" }
} }
@ -220,6 +224,7 @@ urls [
T{ url T{ url
{ protocol "http" } { protocol "http" }
{ host "localhost" } { host "localhost" }
{ raw-query "foo=bar" }
{ query H{ { "foo" "bar" } } } { query H{ { "foo" "bar" } } }
{ path "/" } { path "/" }
} }

6
basis/urls/urls.factor
View File

@ -8,7 +8,7 @@ strings.parser lexer prettyprint.backend hashtables present
peg.ebnf urls.encoding ; peg.ebnf urls.encoding ;
IN: urls 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 ) url new ; : <url> ( -- url ) url new ;
@ -47,7 +47,7 @@ protocol = [a-z]+ => [[ url-decode ]]
username = [^/:@#?]+ => [[ url-decode ]] username = [^/:@#?]+ => [[ url-decode ]]
password = [^/:@#?]+ => [[ url-decode ]] password = [^/:@#?]+ => [[ url-decode ]]
pathname = [^#?]+ => [[ url-decode ]] pathname = [^#?]+ => [[ url-decode ]]
query = [^#]+ => [[ query>assoc ]] query = [^#]+ => [[ >string ]]
anchor = .+ => [[ url-decode ]] anchor = .+ => [[ url-decode ]]
hostname = [^/#?]+ => [[ url-decode ]] hostname = [^/#?]+ => [[ url-decode ]]
@ -80,7 +80,7 @@ M: string >url
] [ f f f f f ] if* ] [ f f f f f ] if*
] ]
[ second ] ! pathname [ second ] ! pathname
[ third ] ! query [ third dup query>assoc ] ! query
[ fourth ] ! anchor [ fourth ] ! anchor
} cleave url boa } cleave url boa
dup host>> [ [ "/" or ] change-path ] when ; dup host>> [ [ "/" or ] change-path ] when ;

17
extra/websites/concatenative/concatenative.factor
View File

@ -8,6 +8,8 @@ html.templates.chloe
http.server http.server
http.server.dispatchers http.server.dispatchers
http.server.redirection http.server.redirection
http.server.static
http.server.cgi
furnace.alloy furnace.alloy
furnace.auth.login furnace.auth.login
furnace.auth.providers.db furnace.auth.providers.db
@ -82,14 +84,19 @@ SYMBOL: dh-file
<configuration> <configuration>
main-responder set-global ; main-responder set-global ;
: <gitweb> ( path -- responder )
<dispatcher>
swap <static> enable-cgi >>default
URL" /gitweb.cgi" <redirect-responder> "" add-responder ;
: init-production ( -- ) : init-production ( -- )
common-configuration common-configuration
<vhost-dispatcher> <vhost-dispatcher>
<factor-website> <factor-boilerplate> "concatenative.org" add-responder <factor-website> <factor-boilerplate> <configuration> "concatenative.org" add-responder
<pastebin> <factor-boilerplate> "paste.factorcode.org" add-responder <pastebin> <factor-boilerplate> <configuration> "paste.factorcode.org" add-responder
<planet> <factor-boilerplate> "planet.factorcode.org" add-responder <planet> <factor-boilerplate> <configuration> "planet.factorcode.org" add-responder
home "docs" append-path <help-webapp> "docs.factorcode.org" add-responder home "docs" append-path <help-webapp> <configuration> "docs.factorcode.org" add-responder
<configuration> home "cgi" append-path <gitweb> "gitweb.factorcode.org" add-responder
main-responder set-global ; main-responder set-global ;
: <factor-secure-config> ( -- config ) : <factor-secure-config> ( -- config )