2d97818 · typeable/wai

git.iko.soy/typeable/wai

ResponseBuilder and SockAddr for remoteHost

commit2d97818390bb96a0609e44b60a82489d0059adf2 authorMichael Snoyman <michael@snoyman.com> dateMon 10 Jan 2011, 19:47 (16 years ago) parent06e26c0

3 files changed+22−6

compare with master

unifiedsplit

Network/Wai/Handler/CGI.hs+9−3 Network/Wai/Middleware/Autohead.hs+2−1 Network/Wai/Middleware/Jsonp.hs+11−2

Network/Wai/Handler/CGI.hs+9−3

@@ -8,6 +8,7 @@ module Network.Wai.Handler.CGI

88 ) where

1010import Network.Wai

11+import Network.Socket (getAddrInfo, addrAddress)

1112import System.Environment (getEnvironment)

1213import Data.Maybe (fromMaybe)

1314import qualified Data.ByteString.Char8 as B

@@ -76,16 +77,21 @@ run'' vars inputH outputH xsendfile app = do

7677 serverport = safeRead 80 $ lookup' "SERVER_PORT" vars

7778 contentLength = safeRead 0 $ lookup' "CONTENT_LENGTH" vars

7879 remoteHost' =

79− case lookup "REMOTE_HOST" vars of

80+ case lookup "REMOTE_ADDR" vars of

8081 Just x -> x

8182 Nothing ->

82− case lookup "REMOTE_ADDR" vars of

83+ case lookup "REMOTE_HOST" vars of

8384 Just x -> x

8485 Nothing -> ""

8586 isSecure' =

8687 case map toLower $ lookup' "SERVER_PROTOCOL" vars of

8788 "https" -> True

8889 _ -> False

90+ addrs <- getAddrInfo Nothing (Just remoteHost') Nothing

91+ let addr =

92+ case addrs of

93+ a:_ -> addrAddress a

94+ [] -> error $ "Invalid REMOTE_ADDR or REMOTE_HOST: " ++ remoteHost'

8995 let env = Request

9096 { requestMethod = rmethod

9197 , pathInfo = B.pack pinfo

@@ -95,7 +101,7 @@ run'' vars inputH outputH xsendfile app = do

95101 , requestHeaders = map (cleanupVarName *** B.pack) vars

96102 , isSecure = isSecure'

97103 , errorHandler = System.IO.hPutStr System.IO.stderr

98− , remoteHost = B.pack remoteHost'

104+ , remoteHost = addr

99105 , httpVersion = "1.1" -- FIXME

100106 }

101107 -- FIXME worry about exception?

Network/Wai/Middleware/Autohead.hs+2−1

@@ -12,7 +12,8 @@ autohead app req

1212 | requestMethod req == "HEAD" = do

1313 res <- app req { requestMethod = "GET" }

1414 case res of

15− ResponseFile s hs _ -> return $ responseBuilder s hs mempty

15+ ResponseFile s hs _ -> return $ ResponseBuilder s hs mempty

16+ ResponseBuilder s hs _ -> return $ ResponseBuilder s hs mempty

1617 ResponseEnumerator e -> do

1718 let helper f =

1819 let helper' s hs = enumEOF $$ f s hs

Network/Wai/Middleware/Jsonp.hs+11−2

@@ -19,8 +19,9 @@ import Network.Wai

1919import qualified Data.ByteString.Char8 as B8

2020import Data.Maybe (fromMaybe)

2121import Data.Enumerator (($$), enumList, Step (..), Enumerator, Iteratee, Enumeratee, joinI, checkDone, continue, Stream (..), (>>==))

22−import Blaze.ByteString.Builder (fromByteString, Builder)

22+import Blaze.ByteString.Builder (copyByteString, Builder)

2323import Blaze.ByteString.Builder.Char8 (fromChar)

24+import Data.Monoid (mappend)

2425

2526takeCallback :: B8.ByteString -> Maybe B8.ByteString

2627takeCallback bs | B8.null bs = Nothing

@@ -66,6 +67,14 @@ jsonp app env = do

6667 Just c -> go c res

6768 where

6869 go c r@(ResponseFile _ hs _) = go' c r hs

70+ go c r@(ResponseBuilder s hs b) =

71+ case checkJSON hs of

72+ Nothing -> return r

73+ Just hs' -> return $ ResponseBuilder s hs' $

74+ copyByteString c

75+ `mappend` fromChar '('

76+ `mappend` b

77+ `mappend` fromChar ')'

6978 go c (ResponseEnumerator e) = addCallback c e

7079 go' c r hs =

7180 case checkJSON hs of

@@ -90,7 +99,7 @@ jsonp app env = do

9099 Nothing -> f s hs

91100 wrap :: Step Builder IO b -> Iteratee Builder IO b

92101 wrap step = joinI $ after (enumList 1 [fromChar ')'])

93− $$ enumList 1 [fromByteString cb, fromChar '('] step

102+ $$ enumList 1 [copyByteString cb, fromChar '('] step

94103 after :: Enumerator Builder IO b -> Enumeratee Builder Builder IO b

95104 after enum =

96105 loop