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

Fix environment variables and post support in webapps.cgi

db4
Chris Double 2008-01-17 16:33:11 +13:00
parent e3b89f1f12
commit f694a832d5
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
extra/webapps/cgi/cgi.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs io.files combinators USING: namespaces kernel assocs io.files combinators
arrays io.launcher io http.server.responders webapps.file arrays io.launcher io http.server.responders webapps.file
sequences strings ; sequences strings math.parser ;
IN: webapps.cgi IN: webapps.cgi
SYMBOL: cgi-root SYMBOL: cgi-root
@ -12,6 +12,8 @@ SYMBOL: cgi-root
: cgi-variables ( name -- assoc ) : cgi-variables ( name -- assoc )
#! This needs some work. #! This needs some work.
[ [
cgi-root get over path+ "PATH_TRANSLATED" set
cgi-root get over path+ "SCRIPT_FILENAME" set
"SCRIPT_NAME" set "SCRIPT_NAME" set
"CGI/1.0" "GATEWAY_INTERFACE" set "CGI/1.0" "GATEWAY_INTERFACE" set
@ -29,13 +31,14 @@ SYMBOL: cgi-root
"method" get >upper "REQUEST_METHOD" set "method" get >upper "REQUEST_METHOD" set
"raw-query" get "QUERY_STRING" set "raw-query" get "QUERY_STRING" set
"Cookie" "header" get at "HTTP_COOKIE" set
"User-Agent" header-param "HTTP_USER_AGENT" set "User-Agent" header-param "HTTP_USER_AGENT" set
"Accept" header-param "HTTP_ACCEPT" set "Accept" header-param "HTTP_ACCEPT" set
post? [ post? [
"Content-Type" header-param "CONTENT_TYPE" set "Content-Type" header-param "CONTENT_TYPE" set
"raw-response" get length "CONTENT_LENGTH" set "raw-response" get length number>string "CONTENT_LENGTH" set
] when ] when
] H{ } make-assoc ; ] H{ } make-assoc ;
@ -49,8 +52,7 @@ SYMBOL: cgi-root
"200 CGI output follows" response "200 CGI output follows" response
stdio get swap cgi-descriptor <process-stream> [ stdio get swap cgi-descriptor <process-stream> [
post? [ post? [
"raw-response" get "raw-response" get write flush
stream-write stream-flush
] when ] when
stdio get swap (stream-copy) stdio get swap (stream-copy)
] with-stream ; ] with-stream ;