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.
! 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

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." }
{ $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{

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

5
basis/urls/urls-tests.factor
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 "/" }
}

6
basis/urls/urls.factor
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 ;

17
extra/websites/concatenative/concatenative.factor
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 )