1 ! Copyright (C) 2010 Brennan Cheung.
2 ! See http://factorcode.org/license.txt for BSD license.
4 ! This version of the FastCGI library only supports single connections.
5 ! As opposed to multiplexing multiple requests across a single
8 ! It also expects the following FastCGI parameters to be present:
12 ! The following are recommended:
16 USING: accessors alien.enums alien.syntax assocs combinators
17 combinators.smart formatting http http.server
18 http.server.responses io io.binary io.directories
19 io.encodings.binary io.files io.servers io.sockets
20 io.streams.byte-array kernel locals math namespaces pack
21 prettyprint sequences sequences.deep strings threads
33 CONSTANT: fcgi-version 1
34 CONSTANT: socket-path "/chroot/web/var/run/factor.sock"
36 TUPLE: fcgi-header version type request-id content-length
37 padding-length reserved ;
40 ENUM: fcgi-header-types
41 { FCGI_BEGIN_REQUEST 1 }
50 FCGI_GET_VALUES_RESULT
59 ENUM: fcgi-protocol-status
60 { FCGI_REQUEST_COMPLETE 0 }
65 :: debug-print ( print-quot -- )
66 [ print-quot call flush ] with-global ; inline
68 ! read either a 1 byte or 4 byte big endian integer
69 : read-var-int ( -- n/f )
72 [ 127 bitand 3 read swap suffix be> ] when
75 :: store-key-value-param ( key value -- )
76 request tget value key set-header drop ;
80 read-var-int read-var-int 2dup and
88 : delete-if-exists ( file -- )
89 dup exists? [ delete-file ] [ drop ] if ;
91 : make-local-socket ( socket-path -- socket )
92 [ delete-if-exists ] keep
95 : get-header ( -- header )
96 "CCSSCC" read-packed-be
97 [ fcgi-header boa ] input<sequence
98 dup type>> fcgi-header-types number>enum >>type ;
100 : get-content-data ( header -- content )
103 [ padding-length>> ] bi or 0 > ! because 0 read blocks
105 [ content-length>> read ]
106 [ padding-length>> read drop ] bi
109 : begin-request-body ( seq -- )
110 binary [ "SCCCCCC" read-packed-be ] with-byte-reader
111 first2 fcgi-flags tset fcgi-roles
112 number>enum fcgi-role tset ;
114 : process-begin-request ( header -- )
115 get-content-data begin-request-body ;
117 : process-params ( header -- )
118 get-content-data binary [ read-params ] with-byte-reader ;
120 :: make-response-packet ( content -- seq )
122 fcgi-version ! version
123 FCGI_STDOUT enum>number ! type
125 content length ! content length
129 "CCSSCC" pack-be content append ;
131 :: make-end-request-body ( app-status protocol-status -- seq )
132 [ app-status protocol-status 0 0 0 ] output>array
135 : make-end-request ( -- seq )
137 fcgi-version ! version
138 FCGI_END_REQUEST enum>number ! type
140 8 ! content length (always 8 for end-request-body)
143 0 0 make-end-request-body
144 ] output>array flatten ;
146 : write-response ( content -- )
147 make-response-packet write make-end-request write ;
149 :: append-stdin-data ( str -- )
150 stdin-data [ str append ] tchange ;
152 ! process a header and determine whether we are
153 ! expecting more input
154 : dispatch-by-header ( header -- ? )
157 { FCGI_BEGIN_REQUEST [ process-begin-request t ] }
158 { FCGI_PARAMS [ process-params t ] }
159 { FCGI_STDIN [ get-content-data dup append-stdin-data length 0 > ] } ! keep going until STDIN empty
160 { FCGI_DATA [ [ "FCGI_DATA ------------------\n" print ] debug-print get-content-data [ >string . ] debug-print f ] }
161 [ [ "unkown packet type" print ] debug-print drop [ . ] debug-print f ]
164 : make-new-request ( -- )
165 <request> request tset ;
167 : parse-packets ( -- )
168 [ get-header dispatch-by-header ] loop ;
170 : post? ( -- ? ) request tget method>> "POST" = ;
172 :: handle-post-data* ( post-data data params -- )
173 post-data data >>data params >>params
174 request tget swap >>post-data drop ;
176 : handle-post-data ( -- )
178 request tget dup "CONTENT_TYPE" header
179 <post-data> [ >>post-data ] keep nip
180 stdin-data tget >string dup query>assoc
184 : prepare-request ( -- )
186 dup "REQUEST_METHOD" header >>method
187 dup "REQUEST_URI" header >>url
191 : fcgi-handler ( -- )
192 make-new-request parse-packets
194 "/path" main-responder get call-responder*
195 [ content-type>> "\n\n" append ] [ body>> ] bi append write-response ;
197 : <fastcgi-server> ( addr -- server )
201 "fastcgi-server" >>name
202 [ fcgi-handler ] >>handler ;
204 : test-output ( -- str )
206 request tget header>> [ "%s => %s\n" sprintf ] { }
207 assoc>map concat append
210 TUPLE: test-responder ;
211 C: <test-responder> test-responder
212 M: test-responder call-responder* 2drop test-output <html-content> ;
215 <test-responder> main-responder set
216 socket-path [ delete-if-exists ] keep
217 make-local-socket <fastcgi-server> dup fcgi-server set