{-# 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.-------------------------------------------------------------------------------moduleNetwork.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
-}importControl.Monad(when,mplus,join,liftM2)
#if defined(WIN32)
importNetwork.HTTP.Base(catchIO)importControl.Monad(liftM)importData.List(isPrefixOf)
#endif
importNetwork.HTTP.Utils (dropWhileTail ,chopAtDelim )importNetwork.HTTP.Auth importNetwork.URI(URI(..),URIAuth(..),parseAbsoluteURI,unEscapeString)importSystem.IO(hPutStrLn,stderr)importSystem.Environment{-
#if !defined(WIN32) && defined(mingw32_HOST_OS)
#define WIN32 1
#endif
-}
#if defined(WIN32)
importSystem.Win32.Types(DWORD,HKEY)importSystem.Win32.Registry(hKEY_CURRENT_USER,regOpenKey,regCloseKey,regQueryValueEx)importControl.Exception(bracket)importForeign(toBool,Storable(peek,sizeOf),castPtr,alloca)
#if MIN_VERSION_Win32(2,8,0)
importSystem.Win32.Registry(regQueryDefaultValue)
#else
importSystem.Win32.Registry(regQueryValue)
#endif
#endif
-- | HTTP proxies (or not) are represented via 'Proxy', specifying if a-- proxy should be used for the request (see 'Network.Browser.setProxy')dataProxy =NoProxy -- ^ Don't use a proxy.|Proxy String(MaybeAuthority )-- ^ 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 :: Proxy
noProxy =Proxy
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(MaybeString)envProxyString :: IO (Maybe String)
envProxyString =do[(String, String)]
env <-IO [(String, String)]
getEnvironmentMaybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookupString
"http_proxy"[(String, String)]
env Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookupString
"HTTP_PROXY"[(String, String)]
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(MaybeString)proxyString :: IO (Maybe String)
proxyString =(Maybe String -> Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplusIO (Maybe String)
envProxyString IO (Maybe String)
windowsProxyString windowsProxyString ::IO(MaybeString)
#if !defined(WIN32)
windowsProxyString :: IO (Maybe String)
windowsProxyString =Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
returnMaybe String
forall a. Maybe a
Nothing
#else
windowsProxyString=liftM(>>=parseWindowsProxy)registryProxyStringregistryProxyLoc::(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_USERpath="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::IO(MaybeString)registryProxyString=catchIO(bracket(uncurryregOpenKeyregistryProxyLoc)regCloseKey$\hkey->doenable<-fmaptoBool$regQueryValueDWORDhkey"ProxyEnable"ifenable
#if MIN_VERSION_Win32(2,8,0)
thenfmapJust$regQueryDefaultValuehkey"ProxyServer"
#elif MIN_VERSION_Win32(2,6,0)
thenfmapJust$regQueryValuehkey"ProxyServer"
#else
thenfmapJust$regQueryValuehkey(Just"ProxyServer")
#endif
elsereturnNothing)(\_->returnNothing)-- the proxy string is in the format "http=x.x.x.x:yyyy;https=...;ftp=...;socks=..."-- even though the following article indicates otherwise-- https://support.microsoft.com/en-us/kb/819961---- to be sure, parse strings where each entry in the ';'-separated list above is-- either in the format "protocol=..." or "protocol://..."---- only return the first "http" of them, if it existsparseWindowsProxy::String->MaybeStringparseWindowsProxys=caseproxiesofx:_->Justx_->Nothingwhereparts=split';'sprx=casebreak(=='=')xof(p,[])->p-- might be in format http://(p,u)->p++"://"++drop1uproxies=filter(isPrefixOf"http://").mappr$partssplit::Eqa=>a->[a]->[[a]]split_[]=[]splitaxs=casebreak(a==)xsof(ys,[])->[ys](ys,_:zs)->ys:splitazs
#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->IOProxy fetchProxy :: Bool -> IO Proxy
fetchProxy Bool
warnIfIllformed =doMaybe String
mstr <-IO (Maybe String)
proxyString caseMaybe String
mstr ofMaybe String
Nothing->Proxy -> IO Proxy
forall (m :: * -> *) a. Monad m => a -> m a
returnProxy
NoProxy JustString
str ->caseString -> Maybe Proxy
parseProxy String
str ofJustProxy
p ->Proxy -> IO Proxy
forall (m :: * -> *) a. Monad m => a -> m a
returnProxy
p Maybe Proxy
Nothing->doBool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenBool
warnIfIllformed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$Handle -> String -> IO ()
System.IO.hPutStrLnHandle
System.IO.stderr(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$[String] -> String
unlines[String
"invalid http proxy uri: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
showString
str ,String
"proxy uri must be http with a hostname",String
"ignoring http proxy, trying a direct connection"]Proxy -> IO Proxy
forall (m :: * -> *) a. Monad m => a -> m a
returnProxy
NoProxy -- | @parseProxy str@ translates a proxy server string into a @Proxy@ value;-- returns @Nothing@ if not well-formed.parseProxy ::String->MaybeProxy parseProxy :: String -> Maybe Proxy
parseProxy String
""=Maybe Proxy
forall a. Maybe a
NothingparseProxy String
str =Maybe (Maybe Proxy) -> Maybe Proxy
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join(Maybe (Maybe Proxy) -> Maybe Proxy)
-> (Maybe URI -> Maybe (Maybe Proxy)) -> Maybe URI -> Maybe Proxy
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URI -> Maybe Proxy) -> Maybe URI -> Maybe (Maybe Proxy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapURI -> Maybe Proxy
uri2proxy (Maybe URI -> Maybe Proxy) -> Maybe URI -> Maybe Proxy
forall a b. (a -> b) -> a -> b
$String -> Maybe URI
parseHttpURI String
str Maybe URI -> Maybe URI -> Maybe URI
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`String -> Maybe URI
parseHttpURI (String
"http://"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
str )whereparseHttpURI :: String -> Maybe URI
parseHttpURI String
str' =caseString -> Maybe URI
parseAbsoluteURIString
str' ofJusturi :: URI
uri @URI{uriAuthority :: URI -> Maybe URIAuth
uriAuthority=Just{}}->URI -> Maybe URI
forall a. a -> Maybe a
Just(URI -> URI
fixUserInfo URI
uri )Maybe URI
_->Maybe URI
forall a. Maybe a
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->URIfixUserInfo :: URI -> URI
fixUserInfo URI
uri =URI
uri {uriAuthority :: Maybe URIAuth
uriAuthority=URIAuth -> URIAuth
f (URIAuth -> URIAuth) -> Maybe URIAuth -> Maybe URIAuth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`URI -> Maybe URIAuth
uriAuthorityURI
uri }wheref :: URIAuth -> URIAuth
f a :: URIAuth
a @URIAuth{uriUserInfo :: URIAuth -> String
uriUserInfo=String
s }=URIAuth
a {uriUserInfo :: String
uriUserInfo=(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileTail (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'@')String
s }--uri2proxy ::URI->MaybeProxy uri2proxy :: URI -> Maybe Proxy
uri2proxy uri :: URI
uri @URI{uriScheme :: URI -> String
uriScheme=String
"http:",uriAuthority :: URI -> Maybe URIAuth
uriAuthority=Just(URIAuthString
auth' String
hst String
prt )}=Proxy -> Maybe Proxy
forall a. a -> Maybe a
Just(String -> Maybe Authority -> Proxy
Proxy (String
hst String -> String -> String
forall a. [a] -> [a] -> [a]
++String
prt )Maybe Authority
auth )whereauth :: Maybe Authority
auth =caseString
auth' of[]->Maybe Authority
forall a. Maybe a
NothingString
as ->Authority -> Maybe Authority
forall a. a -> Maybe a
Just(String -> String -> String -> URI -> Authority
AuthBasic String
""(String -> String
unEscapeStringString
usr )(String -> String
unEscapeStringString
pwd )URI
uri )where(String
usr ,String
pwd )=Char -> String -> (String, String)
forall a. Eq a => a -> [a] -> ([a], [a])
chopAtDelim Char
':'String
as uri2proxy URI
_=Maybe Proxy
forall a. Maybe a
Nothing-- utilities
#if defined(WIN32)
regQueryValueDWORD::HKEY->String->IODWORDregQueryValueDWORDhkeyname=alloca$\ptr->do-- TODO: this throws away the key type returned by regQueryValueEx-- we should check it's what we expect instead_<-regQueryValueExhkeyname(castPtrptr)(sizeOf(undefined::DWORD))peekptr
#endif