forked from GitHub/gf-core
ac23280320
pgf-server can now act as a standalone HTTP server. To activate this mode, start it with pfg-server http to use the default port number (41296), or give an explicit port number, e.g., pgf-server http 8080 The HTTP server serves PGF files in the same way as the old FastCGI interface. In addition, it also serves static files. The document root for static files is the www subdirectory of the current directory where pgf-server is started. In spite of these addition, backwards compatibility is maintaned. The old FastCGI interface continues to work as before. (It is activated when pgf-server is started without arguments.)
41 lines
1.4 KiB
Haskell
41 lines
1.4 KiB
Haskell
module RunHTTP(runHTTP) where
|
|
import Network.URI(uriPath,uriQuery)
|
|
import Network.CGI(ContentType(..))
|
|
import Network.CGI.Protocol(CGIResult(..),CGIRequest(..),Input(..),
|
|
Headers,HeaderName(..))
|
|
import Network.CGI.Monad(runCGIT)
|
|
import Network.Shed.Httpd(initServer,Request(..),Response(..),queryToArguments)
|
|
import qualified Data.ByteString.Lazy.Char8 as BS(pack,unpack)
|
|
import qualified Data.Map as M(fromList)
|
|
|
|
documentRoot = "www"
|
|
|
|
runHTTP port = initServer port . cgiHandler
|
|
|
|
cgiHandler h = fmap httpResp . runCGIT h . cgiReq
|
|
|
|
httpResp :: (Headers,CGIResult) -> Response
|
|
httpResp (hdrs,r) = Response code (map name hdrs) (body r)
|
|
where
|
|
code = maybe 200 (read.head.words) (lookup (HeaderName "Status") hdrs)
|
|
body CGINothing = ""
|
|
body (CGIOutput s) = BS.unpack s
|
|
|
|
name (HeaderName n,v) = (n,v)
|
|
|
|
cgiReq :: Request -> CGIRequest
|
|
cgiReq (Request method uri hdrs body) = CGIRequest vars inputs body'
|
|
where
|
|
vars = M.fromList [("REQUEST_METHOD",method),
|
|
("REQUEST_URI",show uri),
|
|
("SCRIPT_FILENAME",documentRoot++uriPath uri),
|
|
("QUERY_STRING",qs)]
|
|
qs = case uriQuery uri of
|
|
'?':s -> s
|
|
s -> s
|
|
inputs = map input $ queryToArguments qs -- assumes method=="GET"
|
|
body' = BS.pack body
|
|
|
|
input (name,val) = (name,Input (BS.pack val) Nothing plaintext)
|
|
plaintext = ContentType "plain" "text" []
|
|
|