diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,23 @@ -Version 4004.0.9: release 2009-12-20 +Version 4000.1.0: release 2010-11-09 + * Retroactively fixed CHANGES to refer to 4000.x.x instead of + 4004.x.x. + * Fix problem with close looping on certain URLs due to trying + to munch the rest of the stream even on EOF. Modified from + a fix by Daniel Wagner. + * This involves a new class member for HStream and is thus an + API change, but one that will only affect clients that + define their own payload type to replace String/ByteString. + * Applied patch by Antoine Latter to fix problem with 301 and 307 + redirects. +Version 4000.0.10: release 2010-10-29 + * Bump base dependency to support GHC 7.0. + * Stop using 'fail' from the Either monad and instead build Left + values explicitly; the behaviour of fail is changing in GHC 7.0 + and this avoids being sensitive to the change. + +Version 4000.0.9: release 2009-12-20 + * Export headerMap from Network.HTTP.Headers (suggested by David Leuschner.) * Fix Network.TCP.{isTCPConnectedTo,isConnectedTo} to be useful. @@ -12,7 +30,7 @@ * drop unused type argument from Network.Browser.BrowserEvent; needlessly general. (patch provided by Daniel Wagner.) -Version 4004.0.8: release 2009-08-05 +Version 4000.0.8: release 2009-08-05 * Incorporated proxy setting lookup and parsing contribution by Eric Kow; provided in Network.HTTP.Proxy @@ -34,7 +52,7 @@ header, simply assume / realm and proceed. Preferable than failing, even if server is the wrong. -Version 4004.0.7: release 2009-05-22 +Version 4000.0.7: release 2009-05-22 * Minor release. * Added @@ -46,7 +64,7 @@ for interfacing to pre-existing @Socket@s. Contributed and suggested by . -Version 4004.0.6: release 2009-04-21; changes from 4004.0.5 +Version 4000.0.6: release 2009-04-21; changes from 4000.0.5 * Network.Browser: use HTTP.HandleStream.sendHTTP_notify, not HTTP.sendHTTP_notify when issuing requests. The latter runs the risk of undoing request normalization. @@ -56,7 +74,7 @@ * Network.Browser: don't fail on seeing invalid cookie values, but report them as errors and continue. -Version 4004.0.5: release 2009-03-30; changes from 4004.0.4 +Version 4000.0.5: release 2009-03-30; changes from 4000.0.4 * Get serious about comments and Haddock documentation. * Cleaned up normalization of requests, fixing bugs and bringing together diff --git a/HTTP.cabal b/HTTP.cabal --- a/HTTP.cabal +++ b/HTTP.cabal @@ -1,5 +1,5 @@ Name: HTTP -Version: 4000.0.10 +Version: 4000.1.0 Cabal-Version: >= 1.2 Build-type: Simple License: BSD3 @@ -14,7 +14,7 @@ Copyright 2007 Robin Bate Boerop Copyright 2008- Sigbjorn Finne Author: Warrick Gray -Maintainer: Sigbjorn Finne +Maintainer: Ganesh Sittampalam Homepage: http://projects.haskell.org/http/ Category: Network Synopsis: A library for client-side HTTP @@ -50,7 +50,7 @@ > fmap (take 100) (getResponseBody rsp) > . - Git repository available at + Git repository available at Extra-Source-Files: CHANGES diff --git a/Network/Browser.hs b/Network/Browser.hs --- a/Network/Browser.hs +++ b/Network/Browser.hs @@ -846,8 +846,8 @@ } rq - (3,0,x) | x `elem` [2,3,1,7] -> do -- Redirect using GET request method. - out ("30" ++ show x ++ " - redirect using GET") + (3,0,x) | x /= 5 -> do + out ("30" ++ show x ++ " - redirect") allow_redirs <- allowRedirect rqState case allow_redirs of False -> return (Right (uri,rsp)) @@ -867,13 +867,20 @@ return (Right (uri, rsp)) | otherwise -> do out ("Redirecting to " ++ show newURI_abs ++ " ...") - let rq1 = rq { rqMethod=GET, rqURI=newURI_abs, rqBody=nullVal } + + -- Redirect using GET request method, depending on + -- response code. + let toGet = x `elem` [2,3] + method = if toGet then GET else rqMethod rq + rq1 = rq { rqMethod=method, rqURI=newURI_abs } + rq2 = if toGet then (replaceHeader HdrContentLength "0") (rq1 {rqBody = nullVal}) else rq1 + request' nullVal rqState{ reqDenies = 0 , reqRedirects = succ(reqRedirects rqState) , reqStopOnDeny = True } - (replaceHeader HdrContentLength "0" rq1) + rq2 where newURI_abs = maybe newURI id (newURI `relativeTo` uri) diff --git a/Network/TCP.hs b/Network/TCP.hs --- a/Network/TCP.hs +++ b/Network/TCP.hs @@ -140,6 +140,7 @@ readBlock :: HandleStream bufType -> Int -> IO (Result bufType) writeBlock :: HandleStream bufType -> bufType -> IO (Result ()) close :: HandleStream bufType -> IO () + closeQuick :: HandleStream bufType -> IO () closeOnEnd :: HandleStream bufType -> Bool -> IO () instance HStream Strict.ByteString where @@ -148,7 +149,8 @@ readBlock c n = readBlockBS c n readLine c = readLineBS c writeBlock c str = writeBlockBS c str - close c = closeIt c Strict.null + close c = closeIt c Strict.null True + closeQuick c = closeIt c Strict.null False closeOnEnd c f = closeEOF c f instance HStream Lazy.ByteString where @@ -157,7 +159,8 @@ readBlock c n = readBlockBS c n readLine c = readLineBS c writeBlock c str = writeBlockBS c str - close c = closeIt c Lazy.null + close c = closeIt c Lazy.null True + closeQuick c = closeIt c Lazy.null False closeOnEnd c f = closeEOF c f instance Stream.Stream Connection where @@ -183,8 +186,11 @@ -- allow any of the other Stream functions. Notice that a Connection may close -- at any time before a call to this function. This function is idempotent. -- (I think the behaviour here is TCP specific) - close c = closeIt c null + close c = closeIt c null True + -- Closes a Connection without munching the rest of the stream. + closeQuick c = closeIt c null False + closeOnEnd c f = closeEOF c f -- | @openTCPPort uri port@ establishes a connection to a remote @@ -326,9 +332,11 @@ (connHooks' conn) return x -closeIt :: HStream ty => HandleStream ty -> (ty -> Bool) -> IO () -closeIt c p = do - closeConnection c (readLineBS c >>= \ x -> case x of { Right xs -> return (p xs); _ -> return True}) +closeIt :: HStream ty => HandleStream ty -> (ty -> Bool) -> Bool -> IO () +closeIt c p b = do + closeConnection c (if b + then readLineBS c >>= \ x -> case x of { Right xs -> return (p xs); _ -> return True} + else return True) conn <- readMVar (getRef c) maybe (return ()) (hook_close) @@ -349,7 +357,7 @@ (\ e -> if isEOFError e then do - when (connCloseEOF conn) $ catch (close ref) (\ _ -> return ()) + when (connCloseEOF conn) $ catch (closeQuick ref) (\ _ -> return ()) return (return (buf_empty (connBuffer conn))) else return (failMisc (show e))) @@ -372,7 +380,7 @@ (\ e -> if isEOFError e then do - when (connCloseEOF conn) $ catch (close ref) (\ _ -> return ()) + when (connCloseEOF conn) $ catch (closeQuick ref) (\ _ -> return ()) return (return (buf_empty (connBuffer conn))) else return (failMisc (show e))) where