[commit: Cabal] master: Added support for users behind proxy servers, reading system settings from the env var on unix or registry on windows (cc2f67f)
Ian Lynagh
igloo at earth.li
Fri Jun 24 01:49:01 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/cc2f67f98fbc246f010516c71722d5c3432e0a2b
>---------------------------------------------------------------
commit cc2f67f98fbc246f010516c71722d5c3432e0a2b
Author: <jim at sdf-eu.org>
Date: Fri Dec 21 20:15:00 2007 +0000
Added support for users behind proxy servers, reading system settings from the env var on unix or registry on windows
>---------------------------------------------------------------
cabal-install/Hackage/Fetch.hs | 11 ++----
cabal-install/Hackage/HttpUtils.hs | 69 ++++++++++++++++++++++++++++++++++++
cabal-install/Hackage/Upload.hs | 7 +++-
cabal-install/cabal-install.cabal | 7 ++++
4 files changed, 85 insertions(+), 9 deletions(-)
diff --git a/cabal-install/Hackage/Fetch.hs b/cabal-install/Hackage/Fetch.hs
index 7e1a78e..ec2b6d9 100644
--- a/cabal-install/Hackage/Fetch.hs
+++ b/cabal-install/Hackage/Fetch.hs
@@ -22,8 +22,7 @@ module Hackage.Fetch
) where
import Network.URI (URI,parseURI,uriScheme,uriPath)
-import Network.HTTP (ConnError(..), Request (..), simpleHTTP
- , Response(..), RequestMethod (..))
+import Network.HTTP (ConnError(..), Response(..))
import Control.Exception (bracket)
import Control.Monad (filterM)
@@ -33,6 +32,7 @@ import Hackage.Types (ConfigFlags (..), UnresolvedDependency (..), Repo(..), Pkg
import Hackage.Config (repoCacheDir, packageFile, packageDir, pkgURL)
import Hackage.Dependency (resolveDependencies, packagesToInstall)
import Hackage.Utils
+import Hackage.HttpUtils (getHTTP)
import Distribution.Package (showPackageId)
import Distribution.Simple.Compiler (Compiler)
@@ -47,7 +47,7 @@ readURI :: URI -> IO String
readURI uri
| uriScheme uri == "file:" = (readFile $ uriPath uri)
| otherwise = do
- eitherResult <- simpleHTTP (Request uri GET [] "")
+ eitherResult <- getHTTP uri
case eitherResult of
Left err -> die $ "Failed to download '" ++ show uri ++ "': " ++ show err
Right rsp
@@ -62,16 +62,13 @@ downloadURI path uri
copyFile (uriPath uri) path
return Nothing
| otherwise = do
- eitherResult <- simpleHTTP request
+ eitherResult <- getHTTP uri
case eitherResult of
Left err -> return (Just err)
Right rsp
| rspCode rsp == (2,0,0) -> withBinaryFile path WriteMode (`hPutStr` rspBody rsp)
>> return Nothing
| otherwise -> return (Just (ErrorMisc ("Invalid HTTP code: " ++ show (rspCode rsp))))
- where request = Request uri GET [] ""
-
-
downloadFile :: FilePath
-> String
diff --git a/cabal-install/Hackage/HttpUtils.hs b/cabal-install/Hackage/HttpUtils.hs
new file mode 100644
index 0000000..df233c1
--- /dev/null
+++ b/cabal-install/Hackage/HttpUtils.hs
@@ -0,0 +1,69 @@
+{-# OPTIONS -cpp #-}
+-----------------------------------------------------------------------------
+-- | Separate module for HTTP actions, using a proxy server if one exists
+-----------------------------------------------------------------------------
+module Hackage.HttpUtils (getHTTP, proxy) where
+
+import Network.HTTP (Request (..), Response (..), RequestMethod (..), Header(..), HeaderName(..))
+import Network.URI (URI (..), URIAuth (..), parseURI)
+import Network.Stream (Result)
+import Network.Browser (Proxy (..), Authority (..), browse, setProxy, request)
+import Data.Maybe (fromJust)
+#ifdef WIN32
+import System.Win32.Registry (hKEY_CURRENT_USER, regOpenKey, regQueryValue, regCloseKey)
+#else
+import System.Posix.Env (getEnv)
+#endif
+
+-- try to read the system proxy settings on windows or unix
+proxyURI :: IO (Maybe URI)
+#ifdef WIN32
+-- read proxy settings from the windows registry
+proxyURI = do hKey <- return key
+ uri <- regOpenKey hKey path
+ >>= flip regQueryValue (Just "ProxyServer")
+ >>= return . parseURI
+ regCloseKey hKey
+ return uri
+ 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 within HKEY_CURRENT_USER. -}
+ key = hKEY_CURRENT_USER
+ path = "Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings"
+#else
+-- read proxy settings by looking for an env var
+proxyURI = getEnv "http_proxy" >>= maybe (getEnv "HTTP_PROXY"
+ >>= parseURIM) (parseURIM . Just)
+ where parseURIM :: Maybe String -> IO (Maybe URI)
+ parseURIM = return . maybe Nothing parseURI
+#endif
+
+-- |Get the local proxy settings
+proxy :: IO Proxy
+proxy = proxyURI >>= return . uri2proxy
+
+mkRequest :: URI -> IO Request
+mkRequest uri = return Request{ rqURI = uri
+ , rqMethod = GET
+ , rqHeaders = [Header HdrUserAgent "Cabal"]
+ , rqBody = "" }
+
+uri2proxy :: Maybe URI -> Proxy
+uri2proxy = maybe NoProxy (\uri ->
+ let (URIAuth auth' host _) = fromJust $ uriAuthority uri
+ auth = if null auth' then Nothing
+ else Just (AuthBasic "" usr pwd uri)
+ (usr,pwd') = break (==':') auth'
+ pwd = case pwd' of
+ ':':cs -> cs
+ _ -> pwd'
+ in
+ Proxy host auth)
+
+-- |Carry out a GET request, using the local proxy settings
+getHTTP :: URI -> IO (Result Response)
+getHTTP uri = do p <- proxy
+ req <- mkRequest uri
+ (_, resp) <- browse (setProxy p >> request req)
+ return (Right resp)
diff --git a/cabal-install/Hackage/Upload.hs b/cabal-install/Hackage/Upload.hs
index 69b8113..f7361eb 100644
--- a/cabal-install/Hackage/Upload.hs
+++ b/cabal-install/Hackage/Upload.hs
@@ -5,12 +5,13 @@ module Hackage.Upload (upload) where
import Hackage.Setup (UploadFlags(..))
import Hackage.Types (ConfigFlags(..))
+import Hackage.HttpUtils (proxy)
import Distribution.Simple.Utils (debug, notice)
import Distribution.Simple.Setup (toFlag, fromFlag, flagToMaybe)
import Network.Browser (BrowserAction, browse, request,
Authority(..), addAuthority,
- setOutHandler, setErrHandler)
+ setOutHandler, setErrHandler, setProxy)
import Network.HTTP (Header(..), HeaderName(..), Request(..),
RequestMethod(..), Response(..))
import Network.URI (URI, parseURI)
@@ -49,8 +50,10 @@ handlePackage flags path =
(fromFlag (uploadUsername flags))
(fromFlag (uploadPassword flags)))
req <- mkRequest uri path
+ p <- proxy
debug verbosity $ "\n" ++ show req
- (_,resp) <- browse (setErrHandler ignoreMsg
+ (_,resp) <- browse (setProxy p
+ >> setErrHandler ignoreMsg
>> setOutHandler ignoreMsg
>> auth
>> request req)
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index c311713..7065be7 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -37,6 +37,7 @@ Executable cabal
Hackage.Config
Hackage.Dependency
Hackage.Fetch
+ Hackage.HttpUtils
Hackage.Index
Hackage.Info
Hackage.Install
@@ -61,3 +62,9 @@ Executable cabal
build-depends: base >= 2.0 && < 2.2
else
build-depends: base < 2.0 || >= 3.0, bytestring >= 0.9
+
+ if os(windows)
+ build-depends: Win32 >= 2
+ cpp-options: -DWIN32
+ else
+ build-depends: unix >= 1
More information about the Cvs-libraries
mailing list