{-# 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 =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 =doenv <-getEnvironmentreturn(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(MaybeString)proxyString =liftM2mplusenvProxyString windowsProxyString windowsProxyString::IO(MaybeString)#if !defined(WIN32)
windowsProxyString =returnNothing#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 warnIfIllformed =domstr <-proxyString casemstr ofNothing->returnNoProxy Juststr ->caseparseProxy str ofJustp ->returnp Nothing->dowhenwarnIfIllformed $System.IO.hPutStrLnSystem.IO.stderr$unlines["invalid http proxy uri: "++showstr ,"proxy uri must be http with a hostname","ignoring http proxy, trying a direct connection"]returnNoProxy -- | @parseProxy str@ translates a proxy server string into a @Proxy@ value;-- returns @Nothing@ if not well-formed.parseProxy::String->MaybeProxy parseProxy ""=NothingparseProxystr =join.fmapuri2proxy $parseHttpURI str `mplus`parseHttpURI ("http://"++str )whereparseHttpURI str' =caseparseAbsoluteURIstr' ofJusturi @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->URIfixUserInfo uri =uri {uriAuthority=f `fmap`uriAuthorityuri }wheref a @URIAuth{uriUserInfo=s }=a {uriUserInfo=dropWhileTail (=='@')s }-- uri2proxy::URI->MaybeProxy uri2proxy uri @URI{uriScheme="http:",uriAuthority=Just(URIAuthauth' hst prt )}=Just(Proxy (hst ++prt )auth )whereauth =caseauth' of[]->Nothingas->Just(AuthBasic ""(unEscapeStringusr )(unEscapeStringpwd )uri )where(usr ,pwd )=chopAtDelim ':'asuri2proxy_=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