basis/http/server/cgi/cgi.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: namespaces kernel assocs io.files io.streams.duplex\r
   4 combinators arrays io.launcher io.encodings.binary io\r
   5 http.server.static http.server http accessors sequences strings\r
   6 math.parser fry urls urls.encoding calendar ;\r
   7 IN: http.server.cgi\r
   8 \r
   9 : cgi-variables ( script-path -- assoc )\r
  10     #! This needs some work.\r
  11     [\r
  12         "CGI/1.0" "GATEWAY_INTERFACE" set\r
  13         "HTTP/" request get version>> append "SERVER_PROTOCOL" set\r
  14         "Factor" "SERVER_SOFTWARE" set\r
  15 \r
  16         [ "PATH_TRANSLATED" set ] [ "SCRIPT_FILENAME" set ] bi\r
  17 \r
  18         url get path>> "SCRIPT_NAME" set\r
  19 \r
  20         url get host>> "SERVER_NAME" set\r
  21         url get port>> number>string "SERVER_PORT" set\r
  22         "" "PATH_INFO" set\r
  23         "" "REMOTE_HOST" set\r
  24         "" "REMOTE_ADDR" set\r
  25         "" "AUTH_TYPE" set\r
  26         "" "REMOTE_USER" set\r
  27         "" "REMOTE_IDENT" set\r
  28 \r
  29         request get method>> "REQUEST_METHOD" set\r
  30         url get query>> assoc>query "QUERY_STRING" set\r
  31         request get "cookie" header "HTTP_COOKIE" set \r
  32 \r
  33         request get "user-agent" header "HTTP_USER_AGENT" set\r
  34         request get "accept" header "HTTP_ACCEPT" set\r
  35 \r
  36         post-request? [\r
  37             request get post-data>> raw>>\r
  38             [ "CONTENT_TYPE" set ]\r
  39             [ length number>string "CONTENT_LENGTH" set ]\r
  40             bi\r
  41         ] when\r
  42     ] H{ } make-assoc ;\r
  43 \r
  44 : <cgi-process> ( name -- desc )\r
  45     <process>\r
  46         over 1array >>command\r
  47         swap cgi-variables >>environment\r
  48         1 minutes >>timeout ;\r
  49 \r
  50 : serve-cgi ( name -- response )\r
  51     <raw-response>\r
  52     200 >>code\r
  53     "CGI output follows" >>message\r
  54     swap '[\r
  55         _ output-stream get swap <cgi-process> binary <process-stream> [\r
  56             post-request? [ request get post-data>> raw>> write flush ] when\r
  57             input-stream get swap (stream-copy)\r
  58         ] with-stream\r
  59     ] >>body ;\r
  60 \r
  61 : enable-cgi ( responder -- responder )\r
  62     [ serve-cgi ] "application/x-cgi-script"\r
  63     pick special>> set-at ;\r