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

db4
Doug Coleman 2008-09-29 21:23:27 -05:00
commit 678e4b4a33
7 changed files with 30 additions and 15 deletions

View File

@ -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
: <cgi-process> ( name -- desc )
<process>
over 1array >>command
swap cgi-variables >>environment ;
swap cgi-variables >>environment
1 minutes >>timeout ;
: serve-cgi ( name -- response )
<raw-response>
200 >>code
"CGI output follows" >>message
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
input-stream get swap (stream-copy)
] with-stream

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

View File

@ -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

View File

@ -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 "/" }
}

View File

@ -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 ) 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 ;

View File

@ -3,7 +3,7 @@
USING: assocs html.parser kernel math sequences strings ascii
arrays generalizations shuffle unicode.case namespaces make
splitting http accessors io combinators http.client urls
fry sequences.lib ;
urls.encoding fry sequences.lib ;
IN: html.parser.analyzer
TUPLE: link attributes clickable ;

View File

@ -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
<configuration>
main-responder set-global ;
: <gitweb> ( path -- responder )
<dispatcher>
swap <static> enable-cgi >>default
URL" /gitweb.cgi" <redirect-responder> "" add-responder ;
: init-production ( -- )
common-configuration
<vhost-dispatcher>
<factor-website> <factor-boilerplate> "concatenative.org" add-responder
<pastebin> <factor-boilerplate> "paste.factorcode.org" add-responder
<planet> <factor-boilerplate> "planet.factorcode.org" add-responder
home "docs" append-path <help-webapp> "docs.factorcode.org" add-responder
<configuration>
<factor-website> <factor-boilerplate> <configuration> "concatenative.org" add-responder
<pastebin> <factor-boilerplate> <configuration> "paste.factorcode.org" add-responder
<planet> <factor-boilerplate> <configuration> "planet.factorcode.org" add-responder
home "docs" append-path <help-webapp> <configuration> "docs.factorcode.org" add-responder
home "cgi" append-path <gitweb> "gitweb.factorcode.org" add-responder
main-responder set-global ;
: <factor-secure-config> ( -- config )