Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Partial Fix for #543 #1015

Merged
merged 2 commits into from

2 participants

@arunchaganty

I was looking to fix a usability issue; cabal would fail when given an empty http_proxy env variable. I replaced the proxy string extraction code with fetchProxy from HTTP (>=4000.0.8) and perform a check to see if the http_proxy string is empty - and if so, treat it as NoProxy. This should of course be the default behaviour of fetchProxy.

@dcoutts dcoutts merged commit 4e43553 into from
@dcoutts
Collaborator

Looks great, thanks!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
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.