Skip to content

Partial Fix for #543 #1015

Merged
merged 2 commits into from Oct 29, 2012
View
123 cabal-install/Distribution/Client/HttpUtils.hs
@@ -13,31 +13,18 @@ module Distribution.Client.HttpUtils (
import Network.HTTP
( Request (..), Response (..), RequestMethod (..)
, Header(..), HeaderName(..) )
+import Network.HTTP.Proxy ( Proxy(..), fetchProxy)
import Network.URI
( URI (..), URIAuth (..), parseAbsoluteURI )
-import Network.Stream
- ( Result, ConnError(..) )
import Network.Browser
- ( Proxy (..), Authority (..), BrowserAction, browse
+ ( Authority (..), BrowserAction, browse
, setOutHandler, setErrHandler, setProxy, setAuthorityGen, request)
+import Network.Stream
+ ( Result, ConnError(..) )
import Control.Monad
( mplus, join, liftM, liftM2 )
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Data.ByteString.Lazy (ByteString)
-#ifdef WIN32
-import System.Win32.Types
- ( DWORD, HKEY )
-import System.Win32.Registry
- ( hKEY_CURRENT_USER, regOpenKey, regCloseKey
- , regQueryValue, regQueryValueEx )
-import Control.Exception
- ( bracket )
-import Distribution.Compat.Exception
- ( handleIO )
-import Foreign
- ( toBool, Storable(peek, sizeOf), castPtr, alloca )
-#endif
-import System.Environment (getEnvironment)
import qualified Paths_cabal_install (version)
import Distribution.Verbosity (Verbosity)
@@ -46,102 +33,26 @@ import Distribution.Simple.Utils
, copyFileVerbose, writeFileAtomic )
import Distribution.Text
( display )
+import Data.Char ( isSpace )
import qualified System.FilePath.Posix as FilePath.Posix
( splitDirectories )
--- FIXME: all this proxy stuff is far too complicated, especially parsing
--- the proxy strings. Network.Browser should have a way to pick up the
--- proxy settings hiding all this system-dependent stuff below.
-
--- try to read the system proxy settings on windows or unix
-proxyString, envProxyString, registryProxyString :: IO (Maybe String)
-#ifdef WIN32
--- read proxy settings from the windows registry
-registryProxyString = handleIO (\_ -> return Nothing) $
- bracket (regOpenKey hive path) regCloseKey $ \hkey -> do
- enable <- fmap toBool $ regQueryValueDWORD hkey "ProxyEnable"
- if enable
- then fmap Just $ regQueryValue hkey (Just "ProxyServer")
- else return Nothing
- where
- -- some sources say proxy settings should be at
- -- HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows
- -- \CurrentVersion\Internet Settings\ProxyServer
- -- but if the user sets them with IE connection panel they seem to
- -- end up in the following place:
- hive = hKEY_CURRENT_USER
- path = "Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings"
-
- regQueryValueDWORD :: HKEY -> String -> IO DWORD
- regQueryValueDWORD hkey name = alloca $ \ptr -> do
- regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD))
- peek ptr
-#else
-registryProxyString = return Nothing
-#endif
-
--- read proxy settings by looking for an env var
-envProxyString = do
- env <- getEnvironment
- return (lookup "http_proxy" env `mplus` lookup "HTTP_PROXY" env)
-
-proxyString = liftM2 mplus envProxyString registryProxyString
-
+-- Trime
+trim :: String -> String
+trim = f . f
+ where f = reverse . dropWhile isSpace
-- |Get the local proxy settings
+--TODO: print info message when we're using a proxy based on verbosity
proxy :: Verbosity -> IO Proxy
proxy verbosity = do
- mstr <- proxyString
- case mstr of
- Nothing -> return NoProxy
- Just str -> case parseHttpProxy str of
- Nothing -> do
- warn verbosity $ "invalid http proxy uri: " ++ show str
- warn verbosity $ "proxy uri must be http with a hostname"
- warn verbosity $ "ignoring http proxy, trying a direct connection"
- return NoProxy
- Just p -> return p
---TODO: print info message when we're using a proxy
-
--- | We need to be able to parse non-URIs like @\"wwwcache.example.com:80\"@
--- which lack the @\"http://\"@ URI scheme. The problem is that
--- @\"wwwcache.example.com:80\"@ is in fact a valid URI but with scheme
--- @\"wwwcache.example.com:\"@, no authority part and a path of @\"80\"@.
---
--- So our strategy is to try parsing as normal uri first and if it lacks the
--- 'uriAuthority' then we try parsing again with a @\"http://\"@ prefix.
---
-parseHttpProxy :: String -> Maybe Proxy
-parseHttpProxy str = join
- . fmap uri2proxy
- $ parseHttpURI str
- `mplus` parseHttpURI ("http://" ++ str)
- where
- parseHttpURI str' = case parseAbsoluteURI str' of
- Just uri@URI { uriAuthority = Just _ }
- -> Just (fixUserInfo uri)
- _ -> Nothing
-
-fixUserInfo :: URI -> URI
-fixUserInfo uri = uri{ uriAuthority = f `fmap` uriAuthority uri }
- where
- f a@URIAuth{ uriUserInfo = s } =
- a{ uriUserInfo = case reverse s of
- '@':s' -> reverse s'
- _ -> s
- }
-uri2proxy :: URI -> Maybe Proxy
-uri2proxy uri@URI{ uriScheme = "http:"
- , uriAuthority = Just (URIAuth auth' host port)
- } = Just (Proxy (host ++ port) auth)
- where auth = if null auth'
- then Nothing
- else Just (AuthBasic "" usr pwd uri)
- (usr,pwd') = break (==':') auth'
- pwd = case pwd' of
- ':':cs -> cs
- _ -> pwd'
-uri2proxy _ = Nothing
+ p <- fetchProxy True
+ -- Handle empty proxy strings
+ return $ case p of
+ Proxy uri auth ->
+ let uri' = trim uri in
+ if uri' == "" then NoProxy else Proxy uri' auth
+ _ -> p
mkRequest :: URI -> Request ByteString
mkRequest uri = Request{ rqURI = uri
View
2 cabal-install/cabal-install.cabal
@@ -112,7 +112,7 @@ Executable cabal
Cabal >= 1.17.0 && < 1.18,
filepath >= 1.0 && < 1.4,
network >= 1 && < 3,
- HTTP >= 4000.0.2 && < 4001,
+ HTTP >= 4000.0.8 && < 4001,
zlib >= 0.4 && < 0.6,
time >= 1.1 && < 1.5,
mtl >= 2.0 && < 3
Something went wrong with that request. Please try again.