more cleanup for H{ } make.

db4
John Benediktsson 2012-07-19 11:39:56 -07:00
parent 90d0951ada
commit 88e0936618
2 changed files with 26 additions and 26 deletions

View File

@ -3,43 +3,43 @@
USING: namespaces kernel assocs io.files io.streams.duplex USING: namespaces kernel assocs io.files io.streams.duplex
combinators arrays io.launcher io.encodings io.encodings.binary io combinators arrays io.launcher io.encodings io.encodings.binary io
http.server.static http.server http accessors sequences strings http.server.static http.server http accessors sequences strings
math.parser fry urls urls.encoding calendar ; math.parser fry urls urls.encoding calendar make ;
IN: http.server.cgi IN: http.server.cgi
: cgi-variables ( script-path -- assoc ) : cgi-variables ( script-path -- assoc )
#! This needs some work. #! This needs some work.
[ [
"CGI/1.0" "GATEWAY_INTERFACE" set "CGI/1.0" "GATEWAY_INTERFACE" ,,
"HTTP/" request get version>> append "SERVER_PROTOCOL" set "HTTP/" request get version>> append "SERVER_PROTOCOL" ,,
"Factor" "SERVER_SOFTWARE" set "Factor" "SERVER_SOFTWARE" ,,
[ "PATH_TRANSLATED" set ] [ "SCRIPT_FILENAME" set ] bi [ "PATH_TRANSLATED" ,, ] [ "SCRIPT_FILENAME" ,, ] bi
url get path>> "SCRIPT_NAME" set url get path>> "SCRIPT_NAME" ,,
url get host>> "SERVER_NAME" set url get host>> "SERVER_NAME" ,,
url get port>> number>string "SERVER_PORT" set url get port>> number>string "SERVER_PORT" ,,
"" "PATH_INFO" set "" "PATH_INFO" ,,
"" "REMOTE_HOST" set "" "REMOTE_HOST" ,,
"" "REMOTE_ADDR" set "" "REMOTE_ADDR" ,,
"" "AUTH_TYPE" set "" "AUTH_TYPE" ,,
"" "REMOTE_USER" set "" "REMOTE_USER" ,,
"" "REMOTE_IDENT" set "" "REMOTE_IDENT" ,,
request get method>> "REQUEST_METHOD" set request get method>> "REQUEST_METHOD" ,,
url get query>> assoc>query "QUERY_STRING" set url get query>> assoc>query "QUERY_STRING" ,,
request get "cookie" header "HTTP_COOKIE" set request get "cookie" header "HTTP_COOKIE" ,,
request get "user-agent" header "HTTP_USER_AGENT" set request get "user-agent" header "HTTP_USER_AGENT" ,,
request get "accept" header "HTTP_ACCEPT" set request get "accept" header "HTTP_ACCEPT" ,,
post-request? [ post-request? [
request get post-data>> data>> request get post-data>> data>>
[ "CONTENT_TYPE" set ] [ "CONTENT_TYPE" ,, ]
[ length number>string "CONTENT_LENGTH" set ] [ length number>string "CONTENT_LENGTH" ,, ]
bi bi
] when ] when
] H{ } make-assoc ; ] H{ } make ;
: <cgi-process> ( name -- desc ) : <cgi-process> ( name -- desc )
<process> <process>

View File

@ -3,8 +3,8 @@
USING: accessors arrays assocs base64 calendar calendar.format USING: accessors arrays assocs base64 calendar calendar.format
combinators debugger generic hashtables http http.client combinators debugger generic hashtables http http.client
http.client.private io io.encodings.string io.encodings.utf8 http.client.private io io.encodings.string io.encodings.utf8
kernel math math.order math.parser namespaces sequences strings kernel make math math.order math.parser namespaces sequences
xml xml.data xml.syntax xml.traversal xml.writer ; strings xml xml.data xml.syntax xml.traversal xml.writer ;
IN: xml-rpc IN: xml-rpc
! * Sending RPC requests ! * Sending RPC requests
@ -134,12 +134,12 @@ TAG: boolean xml>item
: unstruct-member ( tag -- ) : unstruct-member ( tag -- )
children-tags first2 children-tags first2
first-child-tag xml>item first-child-tag xml>item
[ children>string ] dip swap set ; [ children>string ] dip swap ,, ;
TAG: struct xml>item TAG: struct xml>item
[ [
children-tags [ unstruct-member ] each children-tags [ unstruct-member ] each
] H{ } make-assoc ; ] H{ } make ;
TAG: base64 xml>item TAG: base64 xml>item
children>string base64> <base64> ; children>string base64> <base64> ;