http-proxy 0.0.8 → 0.0.9
raw patch · 3 files changed
+26/−77 lines, 3 filesdep +bytestring-lexingdep +tlsdep ~http-conduit
Dependencies added: bytestring-lexing, tls
Dependency ranges changed: http-conduit
Files
- Network/HTTP/Proxy.hs +22/−16
- Network/HTTP/Proxy/ReadInt.hs +0/−58
- http-proxy.cabal +4/−3
Network/HTTP/Proxy.hs view
@@ -92,9 +92,10 @@ import qualified Network.HTTP.Types as H import qualified Data.CaseInsensitive as CI import System.IO (hPutStrLn, stderr)-import Network.HTTP.Proxy.ReadInt (readInt64) import qualified Data.IORef as I import Data.String (IsString (..))+import qualified Data.ByteString.Lex.Integral as LI+import Network.TLS (TLSCertificateUsage (..)) #if WINDOWS import Control.Concurrent (threadDelay)@@ -159,9 +160,16 @@ addrs <- getAddrInfo (Just hints) host port -- Choose an IPv6 socket if exists. This ensures the socket can -- handle both IPv4 and IPv6 if v6only is false.- let addrs' = filter (\x -> addrFamily x == AF_INET6) addrs ++ filter (\x -> addrFamily x /= AF_INET6) addrs+ let addrs4 = filter (\x -> addrFamily x /= AF_INET6) addrs+ addrs6 = filter (\x -> addrFamily x == AF_INET6) addrs+ addrs' =+ case s of+ HostIPv4 -> addrs4 ++ addrs6+ HostIPv6 -> addrs6 ++ addrs4+ _ -> addrs - tryAddrs (addr1:rest@(_:_)) = catch+ tryAddrs (addr1:rest@(_:_)) =+ catch (theBody addr1) (\(_ :: IOException) -> tryAddrs rest) tryAddrs (addr1:[]) = theBody addr1@@ -171,7 +179,6 @@ (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) sClose (\sock -> do- putStrLn $ show addr ++ " out of " ++ show addrs setSocketOption sock ReuseAddr 1 bindSocket sock (addrAddress addr) listen sock maxListenQueue@@ -221,13 +228,14 @@ let onE = proxyOnException set port = proxyPort set tm <- T.initialize $ proxyTimeout set * 1000000- mgr <- HC.newManager HC.def forever $ do (conn, addr) <- getConn _ <- forkIO $ do+ mgr <- HC.newManager managerSettingsNoCheck th <- T.registerKillThread tm serveConnection set th tm onE port conn addr mgr T.cancel th+ HC.closeManager mgr return () serveConnection :: Settings@@ -260,14 +268,14 @@ Just s -> do let (hs, ps) = case S.split 58 s of -- ':' [h] -> (h, if isSecure req then 443 else 80)- [h, p] -> (h, readInt p)+ [h, p] -> (h, LI.readDecimal_ p) _ -> (serverName req, serverPort req) modReq <- liftIO $ proxyRequestModifier settings req { serverName = hs, serverPort = ps } proxyPlain th conn mgr modReq >>= \keepAlive -> when keepAlive $ serveConnection'' fromClient _ | requestMethod req == "CONNECT" -> case B.split ':' (rawPathInfo req) of- [h, p] -> proxyConnect th tm conn h (readInt p) req+ [h, p] -> proxyConnect th tm conn h (LI.readDecimal_ p) req >>= \keepAlive -> when keepAlive $ serveConnection'' fromClient _ -> failRequest th conn req "Bad request" ("Bad request '" `mappend` rawPathInfo req `mappend` "'.") >>= \keepAlive -> when keepAlive $ serveConnection'' fromClient@@ -331,7 +339,7 @@ let len0 = case lookup "content-length" heads of Nothing -> 0- Just bs -> readInt bs+ Just bs -> LI.readDecimal_ bs let serverName' = takeUntil 58 host -- ':' rbody <- if len0 == 0@@ -643,7 +651,7 @@ Just x -> go x Nothing -> when (go' $ fromException e)- $ hPutStrLn stderr $ show e+ $ hPutStrLn stderr $ "ProxyEx: " ++ show e , proxyTimeout = 30 , proxyRequestModifier = return . id }@@ -716,11 +724,7 @@ else pos {-# INLINE checkCR #-} -readInt :: Integral a => ByteString -> a-readInt bs = fromIntegral $ readInt64 bs-{-# INLINE readInt #-} - serverHeader :: H.RequestHeaders -> H.RequestHeaders serverHeader hdrs = case lookup key hdrs of Nothing -> server : hdrs@@ -753,12 +757,13 @@ -- liftIO $ putStrLn $ B.unpack (requestMethod req) ++ " " ++ B.unpack urlStr let contentLength = if requestMethod req == "GET" then 0- else readInt . fromMaybe "0" . lookup "content-length" . requestHeaders $ req+ else LI.readDecimal_ . fromMaybe "0" . lookup "content-length" . requestHeaders $ req url <- (\u -> u { HC.method = requestMethod req , HC.requestHeaders = outHdrs , HC.rawBody = True+ , HC.secure = isSecure req , HC.requestBody = HC.RequestBodySource contentLength $ fmap copyByteString $ requestBody req@@ -855,5 +860,6 @@ _ -> firstSuccessful ps --+managerSettingsNoCheck :: HC.ManagerSettings+managerSettingsNoCheck =+ HC.def { HC.managerCheckCerts = \ _ _ -> return CertificateUsageAccept }
− Network/HTTP/Proxy/ReadInt.hs
@@ -1,58 +0,0 @@-{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-}---- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>--- License : BSD3--module Network.HTTP.Proxy.ReadInt (readInt64) where---- This function lives in its own file because the MagicHash pragma interacts--- poorly with the CPP pragma.--import Data.ByteString (ByteString)-import Data.Int (Int64)-import GHC.Prim-import GHC.Types--import qualified Data.ByteString.Char8 as B-import qualified Data.Char as C---- This function is used to parse the Content-Length field of HTTP headers and--- is a performance hot spot. It should only be replaced with something--- significantly and provably faster.------ It needs to be able work correctly on 32 bit CPUs for file sizes > 2G so we--- use Int64 here and then make a generic 'readInt' that allows conversion to--- Int and Integer.--readInt64 :: ByteString -> Int64-readInt64 bs =- B.foldl' (\i c -> i * 10 + fromIntegral (mhDigitToInt c)) 0- $ B.takeWhile C.isDigit bs-{- NOINLINE readInt64MH #-}--data Table = Table !Addr#--{- NOINLINE mhDigitToInt #-}-mhDigitToInt :: Char -> Int-mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))- where- !(Table addr) = table- table :: Table- table = Table- "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#-
http-proxy.cabal view
@@ -1,5 +1,5 @@ Name: http-proxy-Version: 0.0.8+Version: 0.0.9 License: BSD3 License-file: LICENSE Author: Michael Snoyman, Stephen Blackheath, Erik de Castro Lopo@@ -33,13 +33,15 @@ , bytestring >= 0.9.1.4 && < 0.10 , wai >= 1.1 && < 1.2 , conduit >= 0.2 && < 0.3- , http-conduit >= 1.2 && < 1.3+ , http-conduit >= 1.2.6 && < 1.3 , transformers >= 0.2.2 && < 0.3 , blaze-builder >= 0.2.1.4 && < 0.4 , http-types >= 0.6 && < 0.7 , case-insensitive >= 0.4 && < 0.5 , lifted-base >= 0.1 && < 0.2 , blaze-builder-conduit >= 0.2 && < 0.3+ , tls >= 0.9 && < 0.10+ , bytestring-lexing >= 0.4 && < 0.5 , ghc-prim if flag(network-bytestring) build-depends: network >= 2.2.1.5 && < 2.2.3@@ -48,7 +50,6 @@ build-depends: network >= 2.3 && < 2.4 Exposed-modules: Network.HTTP.Proxy Other-modules: Network.HTTP.Proxy.Timeout- Network.HTTP.Proxy.ReadInt ghc-options: -Wall -fwarn-tabs if os(windows)