New patches: [Added support for users behind proxy servers, reading system settings from the env var on unix or registry on windows **20071221201500] { addfile ./Hackage/HttpUtils.hs hunk ./Hackage/Fetch.hs 25 -import Network.HTTP (ConnError(..), Request (..), simpleHTTP - , Response(..), RequestMethod (..)) +import Network.HTTP (ConnError(..), Response(..)) hunk ./Hackage/Fetch.hs 35 +import Hackage.HttpUtils (getHTTP) hunk ./Hackage/Fetch.hs 50 - eitherResult <- simpleHTTP (Request uri GET [] "") + eitherResult <- getHTTP uri hunk ./Hackage/Fetch.hs 65 - eitherResult <- simpleHTTP request + eitherResult <- getHTTP uri hunk ./Hackage/Fetch.hs 72 - where request = Request uri GET [] "" - - - + hunk ./Hackage/HttpUtils.hs 1 +{-# 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) hunk ./Hackage/Upload.hs 8 +import Hackage.HttpUtils (proxy) hunk ./Hackage/Upload.hs 14 - setOutHandler, setErrHandler) + setOutHandler, setErrHandler, setProxy) hunk ./Hackage/Upload.hs 53 + p <- proxy hunk ./Hackage/Upload.hs 55 - (_,resp) <- browse (setErrHandler ignoreMsg + (_,resp) <- browse (setProxy p + >> setErrHandler ignoreMsg hunk ./cabal-install.cabal 38 + Hackage.HttpUtils hunk ./cabal-install.cabal 63 + if os(windows) + build-depends: Win32 >= 2 + cpp-options: -DWIN32 + else + build-depends: unix >= 1 + } Context: [Initial attempt at command line completion Lennart Kolmodin **20071219215747] [Added dependency on random. Needed by Hackage.Upload. bjorn@bringert.net**20071218111220] [Improve 'cabal info pkg' message when there is nothing to install Duncan Coutts **20071218004724 "All requested packages already installed. Nothing to do." rather than: "These packages would be installed:\n" followed by ... nothing. ] [Make logging and verboisty a bit more consistent Duncan Coutts **20071218004604 Use the Distribution.Simple.Utils functions and eliminate use of printf ] [Don't append '.' to filename in message. Make config file end in a new line. Duncan Coutts **20071217234934] [Get the saved hackage username and password from the config file Duncan Coutts **20071217234649 rather than from the old ~/.cabal-upload/auth file. Now uses ~/.cabal/config with: hackage-username: hackage-password: ] [Add Bjorn Bringert to authors and copyright list Duncan Coutts **20071217224227 Since much recent cabal-install work is his and he wrote cabal-upload which was just integrated. ] [Remove unnecessary use of a type alias Duncan Coutts **20071217223913] [Initial integration of upload feature Duncan Coutts **20071217223748 It still uses it's own config file, but now uses the same command line stuff ] [Fix usage message, swap program and sub-command names Duncan Coutts **20071217223620] [Remove redundant parameters Duncan Coutts **20071217211141] [Add the cabal-setup commands: configure, build etc Duncan Coutts **20071217210621 So we now have the complete set of commands in one tool. This uses the new Command infrastructure to do two way conversion between flags as strings and as a structured parsed form. ] [Add Upload module direct copy of cabal-upload Duncan Coutts **20071217205813] [Add a verbosity flag to the info list update and fetch commands Duncan Coutts **20071217190035] [Add command listing support Duncan Coutts **20071217185912 first step to shell command line completion ] [installCommand only ever needs to use defaultProgramConfiguration Duncan Coutts **20071217185811 So don't bother making it a parameter ] [Add in more global help text like that of Setup.hs Duncan Coutts **20071217185605] [Replace command line handling Duncan Coutts **20071215194603 Use the new cabal command line handling infrastructure. Use proper flag types rather than strings. Drop support for per-package command line flags as it was generally agreed to be confusing. ] [Read/write binary files using ByteString without .Char8 modules Duncan Coutts **20071022222115 ByteString.Char8 treats files as text files, which are really different on windows. We were getting CRLF translation in Windows which was messing everything up, like saving & reading the index file. So now only use BS.Char8 where necessary. ] [Remove old non-existant copyright file from extra-source-files Duncan Coutts **20071021174954 We only have one LICENCE file ] [TAG 0.4.0 Duncan Coutts **20071021143856] Patch bundle hash: d809fd4867ed700f61706d1d7fad917fc3a9d712