From 6191b9029c542732e3cd49c982accd963d5867b4 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Tue, 5 Jan 2016 16:56:43 +0100 Subject: [PATCH] Remove obsolete content compression functionality --- example-client/example-client.cabal | 13 +---- example-client/src/ExampleClient/Options.hs | 12 ----- example-client/src/Main.hs | 10 +--- .../Client/Repository/HttpLib/HTTP.hs | 48 ++++--------------- .../Client/Repository/HttpLib/HttpClient.hs | 14 +----- hackage-security/ChangeLog.md | 2 +- .../Security/Client/Repository/HttpLib.hs | 14 ------ .../Security/Client/Repository/Remote.hs | 36 +++----------- hackage-security/tests/TestSuite/HttpMem.hs | 13 +---- 9 files changed, 21 insertions(+), 141 deletions(-) diff --git a/example-client/example-client.cabal b/example-client/example-client.cabal index 86b439be..b364fc95 100644 --- a/example-client/example-client.cabal +++ b/example-client/example-client.cabal @@ -11,10 +11,6 @@ category: Distribution build-type: Simple cabal-version: >=1.10 -flag base45 - description: Are we using base 4.5 or later? - manual: False - flag use-network-uri description: Are we using network-uri? manual: False @@ -32,7 +28,8 @@ executable example-client time >= 1.2, hackage-security >= 0.5, hackage-security-HTTP, - hackage-security-curl + hackage-security-curl, + hackage-security-http-client hs-source-dirs: src default-language: Haskell2010 default-extensions: DeriveDataTypeable @@ -43,12 +40,6 @@ executable example-client other-extensions: CPP ghc-options: -Wall - -- http-client only supported on base 4.5 and later - if flag(base45) - build-depends: base >= 4.5, hackage-security-http-client - else - build-depends: base < 4.5 - -- see comments in hackage-security.cabal if flag(use-network-uri) build-depends: network-uri >= 2.6 && < 2.7, diff --git a/example-client/src/ExampleClient/Options.hs b/example-client/src/ExampleClient/Options.hs index 29e9d4ca..468fef6d 100644 --- a/example-client/src/ExampleClient/Options.hs +++ b/example-client/src/ExampleClient/Options.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module ExampleClient.Options ( GlobalOpts(..) , Command(..) @@ -39,9 +38,6 @@ data GlobalOpts = GlobalOpts { -- | Should we check expiry times? , globalCheckExpiry :: Bool - -- | Should we disable content compression? (For the security paranoid) - , globalDisallowCompression :: Bool - -- | Command to execute , globalCommand :: Command } @@ -119,11 +115,7 @@ parseGlobalOptions = GlobalOpts , metavar "CLIENT" , value "HTTP" , showDefault -#ifdef MIN_VERSION_hackage_security_http_client , help "HTTP client to use (currently supported: HTTP, http-conduit, curl)" -#else - , help "HTTP client to use (currently supported: HTTP, curl)" -#endif ]) <*> (many . option readKeyId $ mconcat [ long "root-key" @@ -134,10 +126,6 @@ parseGlobalOptions = GlobalOpts long "ignore-expiry" , help "Don't check expiry dates (should only be used in exceptional circumstances)" ]) - <*> (switch $ mconcat [ - long "disallow-content-compression" - , help "Disallow HTTP content compression (for the security paranoid)" - ]) <*> (subparser $ mconcat [ command "bootstrap" $ info (helper <*> parseBootstrap) $ progDesc "Get the initial root information. If using a key threshold larger than 0, you will need to use the --root-key option to specify one or more trusted root keys." diff --git a/example-client/src/Main.hs b/example-client/src/Main.hs index ed2bc577..7dcbb4ae 100644 --- a/example-client/src/Main.hs +++ b/example-client/src/Main.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module Main where -- stdlib @@ -21,10 +20,7 @@ import qualified Hackage.Security.Client.Repository.Local as Local import qualified Hackage.Security.Client.Repository.Remote as Remote import qualified Hackage.Security.Client.Repository.HttpLib.HTTP as HttpLib.HTTP import qualified Hackage.Security.Client.Repository.HttpLib.Curl as HttpLib.Curl - -#ifdef MIN_VERSION_hackage_security_http_client import qualified Hackage.Security.Client.Repository.HttpLib.HttpClient as HttpLib.HttpClient -#endif -- example-client import ExampleClient.Options @@ -147,9 +143,7 @@ withRepo GlobalOpts{..} = \callback -> callback repoOpts :: Remote.RepoOpts - repoOpts = Remote.defaultRepoOpts { - Remote.repoAllowContentCompression = not globalDisallowCompression - } + repoOpts = Remote.defaultRepoOpts withClient :: (HttpLib -> IO a) -> IO a withClient act = @@ -163,11 +157,9 @@ withRepo GlobalOpts{..} = \callback -> "curl" -> HttpLib.Curl.withClient $ \httpLib -> act httpLib -#ifdef MIN_VERSION_hackage_security_http_client "http-client" -> HttpLib.HttpClient.withClient proxyConfig $ \_manager httpLib -> act httpLib -#endif otherClient -> error $ "unsupported HTTP client " ++ show otherClient diff --git a/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs b/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs index 6df7f342..7f829207 100644 --- a/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs +++ b/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs @@ -21,16 +21,11 @@ import Control.Monad import Data.List (intercalate) import Data.Typeable (Typeable) import Network.URI -import qualified Data.ByteString.Lazy as BS.L -import qualified Control.Monad.State as State -import qualified Codec.Compression.GZip as GZip -import qualified Network.Browser as HTTP -import qualified Network.HTTP as HTTP -import qualified Network.HTTP.Proxy as HTTP - -#if MIN_VERSION_zlib(0,6,0) -import qualified Codec.Compression.Zlib.Internal as GZip (DecompressError) -#endif +import qualified Data.ByteString.Lazy as BS.L +import qualified Control.Monad.State as State +import qualified Network.Browser as HTTP +import qualified Network.HTTP as HTTP +import qualified Network.HTTP.Proxy as HTTP import Hackage.Security.Client import Hackage.Security.Client.Repository.HttpLib @@ -107,33 +102,15 @@ withResponse :: Throws SomeRemoteError -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a withResponse response callback = wrapCustomEx $ do - br <- bodyReaderFromBS $ decompress (HTTP.rspBody response) - callback responseHeaders $ wrapCustomEx (checkDecompressError br) + br <- bodyReaderFromBS $ HTTP.rspBody response + callback responseHeaders $ wrapCustomEx br where - responseHeaders = getResponseHeaders response - needsDecompression = HttpResponseContentCompression `elem` responseHeaders - decompress = if needsDecompression then GZip.decompress else id + responseHeaders = getResponseHeaders response {------------------------------------------------------------------------------- Custom exception types -------------------------------------------------------------------------------} -#if MIN_VERSION_zlib(0,6,0) -wrapCustomEx :: ( ( Throws UnexpectedResponse - , Throws IOException - , Throws GZip.DecompressError - ) => IO a) - -> (Throws SomeRemoteError => IO a) -wrapCustomEx act = handleChecked (\(ex :: UnexpectedResponse) -> go ex) - $ handleChecked (\(ex :: IOException) -> go ex) - $ handleChecked (\(ex :: GZip.DecompressError) -> go ex) - $ act - where - go ex = throwChecked (SomeRemoteError ex) - -checkDecompressError :: Throws GZip.DecompressError => IO a -> IO a -checkDecompressError = handle $ \(ex :: GZip.DecompressError) -> throwChecked ex -#else wrapCustomEx :: ( ( Throws UnexpectedResponse , Throws IOException ) => IO a) @@ -144,10 +121,6 @@ wrapCustomEx act = handleChecked (\(ex :: UnexpectedResponse) -> go ex) where go ex = throwChecked (SomeRemoteError ex) -checkDecompressError :: IO a -> IO a -checkDecompressError = id -#endif - data UnexpectedResponse = UnexpectedResponse URI (Int, Int, Int) deriving (Typeable) @@ -275,8 +248,6 @@ setRequestHeaders = trOpt (insert HTTP.HdrCacheControl ["max-age=0"] acc) os trOpt acc (HttpRequestNoTransform:os) = trOpt (insert HTTP.HdrCacheControl ["no-transform"] acc) os - trOpt acc (HttpRequestContentCompression:os) = - trOpt (insert HTTP.HdrAcceptEncoding ["gzip"] acc) os -- Some headers are comma-separated, others need multiple headers for -- multiple options. @@ -300,7 +271,4 @@ getResponseHeaders response = concat [ [ HttpResponseAcceptRangesBytes | "bytes" `elem` map HTTP.hdrValue (HTTP.retrieveHeaders hAcceptRanges response) ] - , [ HttpResponseContentCompression - | HTTP.findHeader HTTP.HdrContentEncoding response == Just "gzip" - ] ] diff --git a/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs b/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs index d9687d2c..a1fec1e1 100644 --- a/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs +++ b/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs @@ -137,15 +137,8 @@ setRequestHeaders opts req = req { trOpt (insert HttpClient.hCacheControl ["max-age=0"] acc) os trOpt acc (HttpRequestNoTransform:os) = trOpt (insert HttpClient.hCacheControl ["no-transform"] acc) os - trOpt acc (HttpRequestContentCompression:os) = - trOpt (insert hAcceptEncoding ["gzip"] acc) os - - -- http-client deals with decompression completely transparently, so we - -- don't actually need to manually decompress the response stream (we do - -- still need to report to the `hackage-security` library however that the - -- response stream had been compressed). However, we do have to make sure - -- that we allow for compression _only_ when explicitly requested because - -- the default is that it's always enabled. + + -- disable content compression (potential security issue) disallowCompressionByDefault :: [(HttpClient.HeaderName, [ByteString])] disallowCompressionByDefault = [(hAcceptEncoding, [])] @@ -166,9 +159,6 @@ getResponseHeaders response = concat [ [ HttpResponseAcceptRangesBytes | (hAcceptRanges, "bytes") `elem` headers ] - , [ HttpResponseContentCompression - | (HttpClient.hContentEncoding, "gzip") `elem` headers - ] ] where headers = HttpClient.responseHeaders response diff --git a/hackage-security/ChangeLog.md b/hackage-security/ChangeLog.md index ba454487..599c5222 100644 --- a/hackage-security/ChangeLog.md +++ b/hackage-security/ChangeLog.md @@ -6,7 +6,7 @@ * Build tar-index incrementally (#22) * Generalize 'Repository' over the representation of downloaded remote files. * Update index incrementally by downloading delta of `.tar.gz` and writing only - tail of local `.tar` file (#101) + tail of local `.tar` file (#101). Content compression no longer used. * Take a lock on the cache directory before updating it, and no longer use atomic file ops (pointless since we now update some files incrementally) * Code refactoring/simplification. diff --git a/hackage-security/src/Hackage/Security/Client/Repository/HttpLib.hs b/hackage-security/src/Hackage/Security/Client/Repository/HttpLib.hs index 59caad60..e78ef21b 100644 --- a/hackage-security/src/Hackage/Security/Client/Repository/HttpLib.hs +++ b/hackage-security/src/Hackage/Security/Client/Repository/HttpLib.hs @@ -70,16 +70,6 @@ data HttpRequestHeader = -- | Set @Cache-Control: no-transform@ | HttpRequestNoTransform - - -- | Request transport compression (@Accept-Encoding: gzip@) - -- - -- It is the responsibility of the 'HttpLib' to do compression - -- (and report whether the original server reply was compressed or not). - -- - -- NOTE: Clients should NOT allow for compression unless explicitly - -- requested (since decompression happens before signature verification, it - -- is a potential security concern). - | HttpRequestContentCompression deriving (Eq, Ord, Show) -- | HTTP status code @@ -97,10 +87,6 @@ data HttpStatus = data HttpResponseHeader = -- | Server accepts byte-range requests (@Accept-Ranges: bytes@) HttpResponseAcceptRangesBytes - - -- | Original server response was compressed - -- (the 'HttpLib' however must do decompression) - | HttpResponseContentCompression deriving (Eq, Ord, Show) -- | Proxy configuration diff --git a/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs b/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs index 3fd0da25..5208562a 100644 --- a/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs +++ b/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs @@ -111,26 +111,18 @@ fileSizeWithinBounds sz (FileSizeBound sz') = sz <= sz' -- -- Clients should use 'defaultRepositoryOpts' and override required settings. data RepoOpts = RepoOpts { - -- | Should we allow HTTP content compression? - -- - -- Since content compression happens before signature verification, users - -- who are concerned about potential exploits of the decompression - -- algorithm may prefer to disallow content compression. - repoAllowContentCompression :: Bool - -- | Allow additional mirrors? -- -- If this is set to True (default), in addition to the (out-of-band) -- specified mirrors we will also use mirrors reported by those -- out-of-band mirrors (that is, @mirrors.json@). - , repoAllowAdditionalMirrors :: Bool + repoAllowAdditionalMirrors :: Bool } -- | Default repository options defaultRepoOpts :: RepoOpts defaultRepoOpts = RepoOpts { - repoAllowContentCompression = True - , repoAllowAdditionalMirrors = True + repoAllowAdditionalMirrors = True } -- | Initialize the repository (and cleanup resources afterwards) @@ -243,30 +235,14 @@ getRemote remoteConfig selectedMirror attemptNr remoteFile = do -- mess things up with respect to hashes etc). Additionally, after a validation -- error we want to make sure caches get files upstream in case the validation -- error was because the cache updated files out of order. -httpRequestHeaders :: RemoteConfig - -> AttemptNr - -> DownloadMethod fs typ - -> [HttpRequestHeader] -httpRequestHeaders RemoteConfig{..} attemptNr method = +httpRequestHeaders :: RemoteConfig -> AttemptNr -> [HttpRequestHeader] +httpRequestHeaders RemoteConfig{..} attemptNr = if attemptNr == 0 then defaultHeaders else HttpRequestMaxAge0 : defaultHeaders where -- Headers we provide for _every_ attempt, first or not defaultHeaders :: [HttpRequestHeader] - defaultHeaders = concat [ - [ HttpRequestNoTransform ] - , [ HttpRequestContentCompression - | repoAllowContentCompression cfgOpts && not (isRangeRequest method) - ] - ] - - -- If we are doing a range request, we must not request content compression: - -- servers such as Apache interpret this range against the _compressed_ - -- stream, making it near useless for our purposes here. - isRangeRequest :: DownloadMethod fs typ -> Bool - isRangeRequest NeverUpdated{} = False - isRangeRequest CannotUpdate{} = False - isRangeRequest Update{} = True + defaultHeaders = [HttpRequestNoTransform] -- | Mirror selection withMirror :: forall a. @@ -400,7 +376,7 @@ getFile cfg@RemoteConfig{..} attemptNr remoteFile method = update updateFormat updateInfo updateLocal updateTail headers :: [HttpRequestHeader] - headers = httpRequestHeaders cfg attemptNr method + headers = httpRequestHeaders cfg attemptNr -- Get any file from the server, without using incremental updates download :: Throws SomeRemoteError => HasFormat fs f diff --git a/hackage-security/tests/TestSuite/HttpMem.hs b/hackage-security/tests/TestSuite/HttpMem.hs index c227f013..1db588fe 100644 --- a/hackage-security/tests/TestSuite/HttpMem.hs +++ b/hackage-security/tests/TestSuite/HttpMem.hs @@ -40,18 +40,7 @@ get :: forall a. Throws SomeRemoteError get InMemRepo{..} requestHeaders uri callback = do Some inMemFile <- inMemRepoGetPath $ castRoot (uriPath uri) br <- bodyReaderFromBS $ inMemFileRender inMemFile - - -- We pretend that we used content compression (the HttpLib spec - -- explicitly states that it is the responsibility of the HttpLib - -- implementation to decode compressed content), and indicate that we can - -- use range requests - let responseHeaders = concat [ - [ HttpResponseAcceptRangesBytes ] - , [ HttpResponseContentCompression - | HttpRequestContentCompression <- requestHeaders - ] - ] - callback responseHeaders br + callback [HttpResponseAcceptRangesBytes] br -- | Download a byte range --