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

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

db4
Doug Coleman 2008-09-29 21:23:27 -05:00
parent 908d41a305 fd7b7511f5
commit 678e4b4a33
7 changed files with 30 additions and 15 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

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

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

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

2
extra/html/parser/analyzer/analyzer.factor
View File

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

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 )