HTTP 4000.2.10 → 4000.2.11

raw patch · 3 files changed

+29/−6 lines, 3 files

Files

HTTP.cabal +2/−2
Network/Browser.hs +25/−2
Network/HTTP/Proxy.hs +2/−2

HTTP.cabal view

@@ -1,5 +1,5 @@ Name: HTTP-Version: 4000.2.10+Version: 4000.2.11 Cabal-Version: >= 1.8 Build-type: Simple License: BSD3@@ -24,7 +24,7 @@  .  The representation of the bytes flowing across is extensible via the use of a type class,  letting you pick the representation of requests and responses that best fits your use.- Some pre-packaged, common instances are provided for you (@ByteString@, @String@.)+ Some pre-packaged, common instances are provided for you (@ByteString@, @String@).  .  Here's an example use:  .

Network/Browser.hs view

@@ -139,9 +139,9 @@ import Data.Maybe (fromMaybe, listToMaybe, catMaybes ) import Control.Applicative (Applicative (..), (<$>)) #ifdef MTL1-import Control.Monad (filterM, when, ap)+import Control.Monad (filterM, forM_, when, ap) #else-import Control.Monad (filterM, when)+import Control.Monad (filterM, forM_, when) #endif import Control.Monad.State (StateT (..), MonadIO (..), modify, gets, withStateT, evalStateT, MonadState (..)) @@ -820,6 +820,8 @@       -- add new cookies to browser state      handleCookies uri (uriAuthToString $ reqURIAuth rq)                         (retrieveHeaders HdrSetCookie rsp)+     -- Deal with "Connection: close" in response.+     handleConnectionClose (reqURIAuth rq) (retrieveHeaders HdrConnection rsp)      mbMxAuths <- getMaxAuthAttempts      case rspCode rsp of       (4,0,1) -- Credentials not sent or refused.@@ -1000,6 +1002,18 @@ defaultMaxPoolSize :: Int defaultMaxPoolSize = 5 +cleanConnectionPool :: HStream hTy+                    => URIAuth -> BrowserAction (HandleStream hTy) ()+cleanConnectionPool uri = do+  let ep = EndPoint (uriRegName uri) (uriAuthPort Nothing uri)+  pool <- gets bsConnectionPool+  bad <- liftIO $ mapM (\c -> c `isTCPConnectedTo` ep) pool+  let tmp = zip bad pool+      newpool = map snd $ filter (not . fst) tmp+      toclose = map snd $ filter fst tmp+  liftIO $ forM_ toclose close+  modify (\b -> b { bsConnectionPool = newpool })+ handleCookies :: URI -> String -> [Header] -> BrowserAction t () handleCookies _   _              [] = return () -- cut short the silliness. handleCookies uri dom cookieHeaders = do@@ -1014,6 +1028,15 @@   mapM_ addCookie newCookies'  where   (errs, newCookies) = processCookieHeaders dom cookieHeaders++handleConnectionClose :: HStream hTy+                      => URIAuth -> [Header]+                      -> BrowserAction (HandleStream hTy) ()+handleConnectionClose _ [] = return ()+handleConnectionClose uri headers = do+  let doClose = any (== "close") $ map headerToConnType headers+  when doClose $ cleanConnectionPool uri+  where headerToConnType (Header _ t) = map toLower t  ------------------------------------------------------------------ ----------------------- Miscellaneous ----------------------------

Network/HTTP/Proxy.hs view

@@ -25,7 +25,7 @@ import Network.HTTP.Utils ( dropWhileTail, chopAtDelim ) import Network.HTTP.Auth import Network.URI-   ( URI(..), URIAuth(..), parseAbsoluteURI )+   ( URI(..), URIAuth(..), parseAbsoluteURI, unEscapeString ) import System.IO ( hPutStrLn, stderr ) import System.Environment @@ -154,7 +154,7 @@    auth =      case auth' of        [] -> Nothing-       as -> Just (AuthBasic "" usr pwd uri)+       as -> Just (AuthBasic "" (unEscapeString usr) (unEscapeString pwd) uri)         where 	 (usr,pwd) = chopAtDelim ':' as