{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Network.HTTP.Proxy -- Copyright : See LICENSE file -- License : BSD -- -- Maintainer : Ganesh Sittampalam <ganesh@earth.li> -- Stability : experimental -- Portability : non-portable (not tested) -- -- Handling proxy server settings and their resolution. -- ----------------------------------------------------------------------------- module Network.HTTP.Proxy ( Proxy(..) , noProxy -- :: Proxy , fetchProxy -- :: Bool -> IO Proxy , parseProxy -- :: String -> Maybe Proxy ) where {- #if !defined(WIN32) && defined(mingw32_HOST_OS) #define WIN32 1 #endif -} import Control.Monad ( when, mplus, join, liftM2) #if defined(WIN32) import Network.HTTP.Base ( catchIO ) #endif import Network.HTTP.Utils ( dropWhileTail, chopAtDelim ) import Network.HTTP.Auth import Network.URI ( URI(..), URIAuth(..), parseAbsoluteURI, unEscapeString ) import System.IO ( hPutStrLn, stderr ) import System.Environment {- #if !defined(WIN32) && defined(mingw32_HOST_OS) #define WIN32 1 #endif -} #if defined(WIN32) import System.Win32.Types ( DWORD, HKEY ) import System.Win32.Registry( hKEY_CURRENT_USER, regOpenKey, regCloseKey, regQueryValue, regQueryValueEx ) import Control.Exception ( bracket ) import Foreign ( toBool, Storable(peek, sizeOf), castPtr, alloca ) #endif -- | HTTP proxies (or not) are represented via 'Proxy', specifying if a -- proxy should be used for the request (see 'Network.Browser.setProxy') data Proxy = NoProxy -- ^ Don't use a proxy. | Proxy String (Maybe Authority) -- ^ Use the proxy given. Should be of the -- form "http:\/\/host:port", "host", "host:port", or "http:\/\/host". -- Additionally, an optional 'Authority' for authentication with the proxy. noProxy :: Proxy noProxy = NoProxy -- | @envProxyString@ locates proxy server settings by looking -- up env variable @HTTP_PROXY@ (or its lower-case equivalent.) -- If no mapping found, returns @Nothing@. envProxyString :: IO (Maybe String) envProxyString = do env <- getEnvironment return (lookup "http_proxy" env `mplus` lookup "HTTP_PROXY" env) -- | @proxyString@ tries to locate the user's proxy server setting. -- Consults environment variable, and in case of Windows, by querying -- the Registry (cf. @registryProxyString@.) proxyString :: IO (Maybe String) proxyString = liftM2 mplus envProxyString registryProxyString registryProxyString :: IO (Maybe String) #if !defined(WIN32) registryProxyString = return Nothing #else registryProxyLoc :: (HKEY,String) registryProxyLoc = (hive, path) 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" -- read proxy settings from the windows registry; this is just a best -- effort and may not work on all setups. registryProxyString = catchIO (bracket (uncurry regOpenKey registryProxyLoc) regCloseKey $ \hkey -> do enable <- fmap toBool $ regQueryValueDWORD hkey "ProxyEnable" if enable then fmap Just $ regQueryValue hkey (Just "ProxyServer") else return Nothing) (\_ -> return Nothing) #endif -- | @fetchProxy flg@ gets the local proxy settings and parse the string -- into a @Proxy@ value. If you want to be informed of ill-formed proxy -- configuration strings, supply @True@ for @flg@. -- Proxy settings are sourced from the @HTTP_PROXY@ environment variable, -- and in the case of Windows platforms, by consulting IE/WinInet's proxy -- setting in the Registry. fetchProxy :: Bool -> IO Proxy fetchProxy warnIfIllformed = do mstr <- proxyString case mstr of Nothing -> return NoProxy Just str -> case parseProxy str of Just p -> return p Nothing -> do when warnIfIllformed $ System.IO.hPutStrLn System.IO.stderr $ unlines [ "invalid http proxy uri: " ++ show str , "proxy uri must be http with a hostname" , "ignoring http proxy, trying a direct connection" ] return NoProxy -- | @parseProxy str@ translates a proxy server string into a @Proxy@ value; -- returns @Nothing@ if not well-formed. parseProxy :: String -> Maybe Proxy parseProxy 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 -- Note: 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. -- -- | tidy up user portion, don't want the trailing "\@". fixUserInfo :: URI -> URI fixUserInfo uri = uri{ uriAuthority = f `fmap` uriAuthority uri } where f a@URIAuth{uriUserInfo=s} = a{uriUserInfo=dropWhileTail (=='@') s} -- uri2proxy :: URI -> Maybe Proxy uri2proxy uri@URI{ uriScheme = "http:" , uriAuthority = Just (URIAuth auth' hst prt) } = Just (Proxy (hst ++ prt) auth) where auth = case auth' of [] -> Nothing as -> Just (AuthBasic "" (unEscapeString usr) (unEscapeString pwd) uri) where (usr,pwd) = chopAtDelim ':' as uri2proxy _ = Nothing -- utilities #if defined(WIN32) regQueryValueDWORD :: HKEY -> String -> IO DWORD regQueryValueDWORD hkey name = alloca $ \ptr -> do -- TODO: this throws away the key type returned by regQueryValueEx -- we should check it's what we expect instead _ <- regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD)) peek ptr #endif