@@ -3,6 +3,7 @@ module Network.Wai.Handler.CGI
33 ( run
44 , run'
55 , run''
6+ , runSendfile
67 ) where
78
89import Network.Wai
@@ -28,7 +29,17 @@ lookup' key pairs = fromMaybe "" $ lookup key pairs
2829run :: Application -> IO ()
2930run app = do
3031 vars <- getEnvironment
31− run' vars System.IO.stdin System.IO.stdout app
32+ let input = requestBodyHandle System.IO.stdin
33+ output = B.hPut System.IO.stdout
34+ run'' vars input output Nothing app
35+
36+runSendfile :: String -- ^ sendfile header
37+ -> Application -> IO ()
38+runSendfile sf app = do
39+ vars <- getEnvironment
40+ let input = requestBodyHandle System.IO.stdin
41+ output = B.hPut System.IO.stdout
42+ run'' vars input output (Just sf) app
3243
3344run' :: [(String, String)] -- ^ all variables
3445 -> System.IO.Handle -- ^ responseBody of input
@@ -38,14 +49,15 @@ run' :: [(String, String)] -- ^ all variables
3849run' vars inputH outputH app = do
3950 let input = requestBodyHandle inputH
4051 output = B.hPut outputH
41− run'' vars input output app
52+ run'' vars input output Nothing app
4253
4354run'' :: [(String, String)] -- ^ all variables
4455 -> (Int -> Source) -- ^ responseBody of input
4556 -> (B.ByteString -> IO ()) -- ^ destination for output
57+ -> Maybe String -- ^ does the server support the X-Sendfile header?
4658 -> Application
4759 -> IO ()
48−run'' vars inputH outputH app = do
60+run'' vars inputH outputH xsendfile app = do
4961 let rmethod = B.pack $ lookup' "REQUEST_METHOD" vars
5062 pinfo = lookup' "PATH_INFO" vars
5163 qstring = lookup' "QUERY_STRING" vars
@@ -87,9 +99,21 @@ run'' vars inputH outputH app = do
8799 hPut $ statusMessage $ status res
88100 hPut $ B.singleton '\n'
89101 mapM_ (printHeader hPut) h'
90− hPut $ B.singleton '\n'
91− _ <- runEnumerator (fromResponseBody (responseBody res)) (myPut outputH) ()
92− return ()
102+ case (xsendfile, responseBody res) of
103+ (Just sf, ResponseFile fp) ->
104+ hPut $ B.pack $ concat
105+ [ sf
106+ , ": "
107+ , fp
108+ , "\n\n"
109+ , sf
110+ , " not supported"
111+ ]
112+ _ -> do
113+ hPut $ B.singleton '\n'
114+ _ <- runEnumerator (fromResponseBody (responseBody res))
115+ (myPut outputH) ()
116+ return ()
93117
94118myPut :: (B.ByteString -> IO ()) -> () -> B.ByteString -> IO (Either () ())
95119myPut output _ bs = output bs >> return (Right ())