Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7ae62bf8eab5ff21289d052c346e263a5ce37374 >--------------------------------------------------------------- commit 7ae62bf8eab5ff21289d052c346e263a5ce37374 Author: jim <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
