http-client-0.4.26.2/0000755000000000000000000000000012636306172012372 5ustar0000000000000000http-client-0.4.26.2/ChangeLog.md0000644000000000000000000001045112636306172014544 0ustar0000000000000000## 0.4.26.2 * Fix compilation for GHC 7.4 ## 0.4.26.1 * Fix compilation for GHC < 7.10 ## 0.4.26 * Make sure we never read from or write to closed socket [#170](https://github.com/snoyberg/http-client/pull/170) ## 0.4.25 * Don't error out when response body flushing fails [#169](https://github.com/snoyberg/http-client/issues/169) ## 0.4.24 * Use a new `TlsExceptionHostPort` exception to indicate the host and port of the server we were trying to connect to when a TLS exception occurred. See [commercialhaskell/stack#1010](https://github.com/commercialhaskell/stack/issues/1010) ## 0.4.23 * Case insensitive cookie domains [#158](https://github.com/snoyberg/http-client/issues/158) ## 0.4.22 * ProxyConnectException now returns Right HttpException. [#155](https://github.com/snoyberg/http-client/pull/155) ## 0.4.21 * Support `no_proxy` environment variable. [#140](https://github.com/snoyberg/http-client/issues/140) [#145](https://github.com/snoyberg/http-client/pull/145) ## 0.4.20 * Expose `brReadSome` ## 0.4.19 * Move HasHttpManager from http-conduit to http-client [#147](https://github.com/snoyberg/http-client/pull/147) * Chunked request bodies use less TCP packets [#149](https://github.com/snoyberg/http-client/issues/149) ## 0.4.18 * Deprecate closeManager [#136](https://github.com/snoyberg/http-client/issues/136) [#137](https://github.com/snoyberg/http-client/issues/137) ## 0.4.17 * Case insensitive proxy environment variables [#135](https://github.com/snoyberg/http-client/issues/135) ## 0.4.16 * Proxy auth for HTTPS [#132](https://github.com/snoyberg/http-client/issues/132) ## 0.4.15 * Support proxy authentication in environment variables [#129](https://github.com/snoyberg/http-client/issues/129) ## 0.4.14 * Ignore empty `http_proxy` [#128](https://github.com/snoyberg/http-client/pull/128) ## 0.4.13 * Support for auth via url [#124](https://github.com/snoyberg/http-client/pull/124) ## 0.4.12 * Added `IsString RequestBody` instance [#126](https://github.com/snoyberg/http-client/pull/126) ## 0.4.11.3 * Fix getUri to insert "?" to uriQuery when necessary. [#123](https://github.com/snoyberg/http-client/pull/123) ## 0.4.11.2 * Removed publicsuffixlist dependency, see [Github discussion](https://github.com/litherum/publicsuffixlist/pull/7) ## 0.4.11.1 * Disable custom timeout code [#116](https://github.com/snoyberg/http-client/issues/116) ## 0.4.11 * Ignore the 'Content-Length' header if the body contains chunked data [#115](https://github.com/snoyberg/http-client/pull/115) ## 0.4.10 * Expect: 100-continue [#114](https://github.com/snoyberg/http-client/pull/114) ## 0.4.9 * Add RequestBody smart constructors `streamFile` and `streamFileObserved`, the latter with accompanying type `StreamFileStatus`. ## 0.4.8.1 * Automatically call withSocketsDo everywhere [#107](https://github.com/snoyberg/http-client/issues/107) ## 0.4.8 * Add the `ResponseLengthAndChunkingBothUsed` exception constructor [#108](https://github.com/snoyberg/http-client/issues/108) ## 0.4.7.2 * Improved `timeout` implementation for high contention cases [#98](https://github.com/snoyberg/http-client/issues/98) ## 0.4.7.1 * Fix for shared connections in proxy servers [#103](https://github.com/snoyberg/http-client/issues/103) ## 0.4.7 * [Support http\_proxy and https\_proxy environment variables](https://github.com/snoyberg/http-client/issues/94) ## 0.4.6.1 Separate tests not requiring internet access. [#93](https://github.com/snoyberg/http-client/pull/93) ## 0.4.6 Add `onRequestBodyException` to `Request` to allow for recovering from exceptions when sending the request. Most useful for servers which terminate the connection after sending a response body without flushing the request body. ## 0.4.5 Add `openSocketConnectionSize` and increase default chunk size to 8192. ## 0.4.4 Add `managerModifyRequest` field to `ManagerSettings`. ## 0.4.3 Add `requestVersion` field to `Request`. ## 0.4.2 The reaper thread for a manager will go to sleep completely when there are no connection to manage. See: https://github.com/snoyberg/http-client/issues/70 ## 0.4.1 * Provide the `responseOpenHistory`/`withResponseHistory` API. See: https://github.com/snoyberg/http-client/pull/79 ## 0.4.0 * Hide the `Part` constructor, and allow for additional headers. See: https://github.com/snoyberg/http-client/issues/76 http-client-0.4.26.2/http-client.cabal0000644000000000000000000001126412636306172015615 0ustar0000000000000000name: http-client version: 0.4.26.2 synopsis: An HTTP client engine, intended as a base layer for more user-friendly packages. description: Hackage documentation generation is not reliable. For up to date documentation, please see: . homepage: https://github.com/snoyberg/http-client license: MIT license-file: LICENSE author: Michael Snoyman maintainer: michael@snoyman.com category: Network build-type: Simple extra-source-files: README.md ChangeLog.md cabal-version: >=1.10 flag network-uri description: Get Network.URI from the network-uri package default: True library hs-source-dirs: ., publicsuffixlist exposed-modules: Network.HTTP.Client Network.HTTP.Client.MultipartFormData Network.HTTP.Client.Internal other-modules: Network.HTTP.Client.Body Network.HTTP.Client.Connection Network.HTTP.Client.Cookies Network.HTTP.Client.Core Network.HTTP.Client.Headers Network.HTTP.Client.Manager Network.HTTP.Client.Request Network.HTTP.Client.Response Network.HTTP.Client.Types Network.HTTP.Client.Util Network.PublicSuffixList.Lookup Network.PublicSuffixList.Types Network.PublicSuffixList.Serialize Network.PublicSuffixList.DataStructure build-depends: base >= 4.5 && < 5 , bytestring >= 0.9 , text >= 0.11 , http-types >= 0.8 , blaze-builder >= 0.3 , data-default-class , time >= 1.2 , network >= 2.3 , streaming-commons >= 0.1.0.2 && < 0.2 , containers , transformers , deepseq >= 1.3 && <1.5 , case-insensitive >= 1.0 , base64-bytestring >= 1.0 && <1.1 , cookie , exceptions >= 0.4 , array , random , filepath , mime-types , ghc-prim if flag(network-uri) build-depends: network >= 2.6, network-uri >= 2.6 else build-depends: network < 2.6 default-language: Haskell2010 test-suite spec main-is: Spec.hs type: exitcode-stdio-1.0 hs-source-dirs: test default-language: Haskell2010 other-modules: Network.HTTP.ClientSpec build-depends: base , http-client , hspec , monad-control , bytestring , text , http-types , blaze-builder , time , network , containers , transformers , deepseq , case-insensitive , base64-bytestring , zlib , async , streaming-commons >= 0.1.1 test-suite spec-nonet main-is: Spec.hs type: exitcode-stdio-1.0 hs-source-dirs: test-nonet default-language: Haskell2010 other-modules: Network.HTTP.ClientSpec Network.HTTP.Client.ResponseSpec Network.HTTP.Client.BodySpec Network.HTTP.Client.HeadersSpec Network.HTTP.Client.RequestSpec Network.HTTP.Client.RequestBodySpec Network.HTTP.Client.CookieSpec build-depends: base , http-client , hspec , monad-control , bytestring , text , http-types , blaze-builder , time , network , network-uri , containers , transformers , deepseq , case-insensitive , base64-bytestring , zlib , async , streaming-commons >= 0.1.1 , directory http-client-0.4.26.2/LICENSE0000644000000000000000000000207212636306172013400 0ustar0000000000000000The MIT License (MIT) Copyright (c) 2013 Michael Snoyman Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. http-client-0.4.26.2/README.md0000644000000000000000000000172612636306172013657 0ustar0000000000000000http-client =========== An HTTP client engine, intended as a base layer for more user-friendly packages. This codebase has been refactored from [http-conduit](http://www.stackage.org/package/http-conduit). Below is a series of cookbook recipes. A number of recipes exist elsewhere, including `Network.HTTP.Client` and `Network.HTTP.Conduit`. The goal is to expand this list over time. ## Proxy environment variable Use the following approach to get proxy settings from the `http_proxy` and `https_proxy` environment variables. ```haskell {-# LANGUAGE OverloadedStrings #-} import Network.HTTP.Client main :: IO () main = do let settings = managerSetProxy (proxyEnvironment Nothing) defaultManagerSettings man <- newManager settings let req = "http://httpbin.org" -- Note that the following settings will be completely ignored. { proxy = Just $ Proxy "localhost" 1234 } httpLbs req man >>= print ``` http-client-0.4.26.2/Setup.hs0000644000000000000000000000005612636306172014027 0ustar0000000000000000import Distribution.Simple main = defaultMain http-client-0.4.26.2/Network/0000755000000000000000000000000012636306172014023 5ustar0000000000000000http-client-0.4.26.2/Network/HTTP/0000755000000000000000000000000012636306172014602 5ustar0000000000000000http-client-0.4.26.2/Network/HTTP/Client.hs0000644000000000000000000002533012636306172016357 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -- | This is the main entry point for using http-client. Used by itself, this -- module provides low-level access for streaming request and response bodies, -- and only non-secure HTTP connections. Helper packages such as http-conduit -- provided higher level streaming approaches, while other helper packages like -- http-client-tls provide secure connections. -- -- There are three core components to be understood here: requests, responses, -- and managers. A 'Manager' keeps track of open connections to various hosts, -- and when requested, will provide either an existing open connection or -- create a new connection on demand. A 'Manager' also automatically reaps -- connections which have been unused for a certain period of time. A 'Manager' -- allows for more efficient HTTP usage by allowing for keep-alive connections. -- Secure HTTP connections can be allowed by modifying the settings used for -- creating a manager. The simplest way to create a 'Manager' is with: -- -- @ -- 'newManager' 'defaultManagerSettings' -- @ -- -- While generally speaking it is a good idea to share a single 'Manager' -- throughout your application, there are cases where it makes more sense to -- create and destroy 'Manager's more frequently. As an example, if you have an -- application which will make a large number of requests to different hosts, -- and will never make more than one connection to a single host, then sharing -- a 'Manager' will result in idle connections being kept open longer than -- necessary. In such a situation, it makes sense to use 'withManager' around -- each new request, to avoid running out of file descriptors. (Note that the -- 'managerIdleConnectionCount' setting mitigates the risk of leaking too many -- file descriptors.) -- -- The next core component is a 'Request', which represents a single HTTP -- request to be sent to a specific server. 'Request's allow for many settings -- to control exact how they function, but usually the simplest approach for -- creating a 'Request' is to use 'parseUrl'. -- -- Finally, a 'Response' is the result of sending a single 'Request' to a -- server, over a connection which was acquired from a 'Manager'. Note that you -- must close the response when you're done with it to ensure that the -- connection is recycled to the 'Manager' to either be used by another -- request, or to be reaped. Usage of 'withResponse' will ensure that this -- happens automatically. -- -- Helper packages may provide replacements for various recommendations listed -- above. For example, if using http-client-tls, instead of using -- 'defaultManagerSettings', you would want to use 'tlsManagerSettings'. Be -- sure to read the relevant helper library documentation for more information. -- -- A note on exceptions: for the most part, all actions that perform I/O should -- be assumed to throw an 'HttpException' in the event of some problem, and all -- pure functions will be total. For example, 'withResponse', 'httpLbs', and -- 'BodyReader' can all throw exceptions. Functions like 'responseStatus' and -- 'applyBasicAuth' are guaranteed to be total (or there\'s a bug in the -- library). -- -- One thing to be cautioned about: the type of 'parseUrl' allows it to work in -- different monads. If used in the 'IO' monad, it will throw an exception in -- the case of an invalid URI. In addition, if you leverage the @IsString@ -- instance of the 'Request' value via @OverloadedStrings@, an invalid URI will -- result in a partial value. Caveat emptor! -- -- Non-2xx responses: the default behavior of all functions in http-client is -- to automatically perform up to 10 redirects (response codes 301, 302, 303, -- and 307), and to throw a 'StatusCodeException' on all responses whose status -- are not in the 2xx range. These behaviors can be overridden by the -- 'redirectCount' and 'checkStatus' settings on a request, respectively. module Network.HTTP.Client ( -- $example1 -- * Performing requests withResponse , httpLbs , httpNoBody , responseOpen , responseClose -- ** Tracking redirect history , withResponseHistory , responseOpenHistory , HistoriedResponse , hrRedirects , hrFinalRequest , hrFinalResponse -- * Connection manager , Manager , newManager , closeManager , withManager , HasHttpManager(..) -- ** Connection manager settings , ManagerSettings , defaultManagerSettings , managerConnCount , managerRawConnection , managerTlsConnection , managerResponseTimeout , managerRetryableException , managerWrapIOException , managerIdleConnectionCount , managerModifyRequest -- *** Manager proxy settings , managerSetProxy , managerSetInsecureProxy , managerSetSecureProxy , ProxyOverride , proxyFromRequest , noProxy , useProxy , proxyEnvironment , proxyEnvironmentNamed , defaultProxy -- *** Helpers , rawConnectionModifySocket -- * Request , parseUrl , applyBasicAuth , urlEncodedBody , getUri , setQueryString -- ** Request type and fields , Request , method , secure , host , port , path , queryString , requestHeaders , requestBody , proxy , applyBasicProxyAuth , decompress , redirectCount , checkStatus , responseTimeout , cookieJar , requestVersion -- ** Request body , RequestBody (..) , Popper , NeedsPopper , GivesPopper , streamFile , observedStreamFile , StreamFileStatus (..) -- * Response , Response , responseStatus , responseVersion , responseHeaders , responseBody , responseCookieJar -- ** Response body , BodyReader , brRead , brReadSome , brConsume -- * Misc , HttpException (..) , Cookie (..) , CookieJar , Proxy (..) -- * Cookies , module Network.HTTP.Client.Cookies ) where import Network.HTTP.Client.Body import Network.HTTP.Client.Cookies import Network.HTTP.Client.Core import Network.HTTP.Client.Manager import Network.HTTP.Client.Request import Network.HTTP.Client.Response import Network.HTTP.Client.Types import Data.Text (Text) import Data.IORef (newIORef, writeIORef, readIORef, modifyIORef) import qualified Data.ByteString.Lazy as L import Data.Foldable (Foldable) import Data.Traversable (Traversable) import Network.HTTP.Types (statusCode) import GHC.Generics (Generic) import Data.Typeable (Typeable) import Control.Exception (bracket) -- | A datatype holding information on redirected requests and the final response. -- -- Since 0.4.1 data HistoriedResponse body = HistoriedResponse { hrRedirects :: [(Request, Response L.ByteString)] -- ^ Requests which resulted in a redirect, together with their responses. -- The response contains the first 1024 bytes of the body. -- -- Since 0.4.1 , hrFinalRequest :: Request -- ^ The final request performed. -- -- Since 0.4.1 , hrFinalResponse :: Response body -- ^ The response from the final request. -- -- Since 0.4.1 } deriving (Functor, Traversable, Foldable, Show, Typeable, Generic) -- | A variant of @responseOpen@ which keeps a history of all redirects -- performed in the interim, together with the first 1024 bytes of their -- response bodies. -- -- Since 0.4.1 responseOpenHistory :: Request -> Manager -> IO (HistoriedResponse BodyReader) responseOpenHistory req0 man = do reqRef <- newIORef req0 historyRef <- newIORef id let go req = do res <- httpRaw req man case getRedirectedRequest req (responseHeaders res) (responseCookieJar res) (statusCode $ responseStatus res) of Nothing -> return (res, Nothing) Just req' -> do writeIORef reqRef req' body <- brReadSome (responseBody res) 1024 modifyIORef historyRef (. ((req, res { responseBody = body }):)) return (res, Just req') res <- httpRedirect (redirectCount req0) go req0 reqFinal <- readIORef reqRef history <- readIORef historyRef return HistoriedResponse { hrRedirects = history [] , hrFinalRequest = reqFinal , hrFinalResponse = res } -- | A variant of @withResponse@ which keeps a history of all redirects -- performed in the interim, together with the first 1024 bytes of their -- response bodies. -- -- Since 0.4.1 withResponseHistory :: Request -> Manager -> (HistoriedResponse BodyReader -> IO a) -> IO a withResponseHistory req man = bracket (responseOpenHistory req man) (responseClose . hrFinalResponse) -- | Set the proxy override value, only for HTTP (insecure) connections. -- -- Since 0.4.7 managerSetInsecureProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings managerSetInsecureProxy po m = m { managerProxyInsecure = po } -- | Set the proxy override value, only for HTTPS (secure) connections. -- -- Since 0.4.7 managerSetSecureProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings managerSetSecureProxy po m = m { managerProxySecure = po } -- | Set the proxy override value, for both HTTP (insecure) and HTTPS -- (insecure) connections. -- -- Since 0.4.7 managerSetProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings managerSetProxy po = managerSetInsecureProxy po . managerSetSecureProxy po -- $example1 -- = Example Usage -- -- === Making a GET request -- -- > import Network.HTTP.Client -- > import Network.HTTP.Types.Status (statusCode) -- > -- > main :: IO () -- > main = do -- > manager <- newManager defaultManagerSettings -- > -- > request <- parseUrl "http://httpbin.org/post" -- > response <- httpLbs request manager -- > -- > putStrLn $ "The status code was: " ++ (show $ statusCode $ responseStatus response) -- > print $ responseBody response -- -- -- === Posting JSON to a server -- -- > {-# LANGUAGE OverloadedStrings #-} -- > import Network.HTTP.Client -- > import Network.HTTP.Types.Status (statusCode) -- > import Data.Aeson (object, (.=), encode) -- > -- > main :: IO () -- > main = do -- > manager <- newManager defaultManagerSettings -- > -- > -- Create the request -- > let requestObject = object ["name" .= "Michael", "age" .= 30] -- > initialRequest <- parseUrl "http://httpbin.org/post" -- > let request = initialRequest { method = "POST", requestBody = RequestBodyLBS $ encode requestObject } -- > -- > response <- httpLbs request manager -- > putStrLn $ "The status code was: " ++ (show $ statusCode $ responseStatus response) -- > print $ responseBody response -- http-client-0.4.26.2/Network/HTTP/Client/0000755000000000000000000000000012636306172016020 5ustar0000000000000000http-client-0.4.26.2/Network/HTTP/Client/Body.hs0000644000000000000000000001443212636306172017255 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Client.Body ( makeChunkedReader , makeLengthReader , makeGzipReader , makeUnlimitedReader , brConsume , brEmpty , brAddCleanup , brReadSome , brRead ) where import Network.HTTP.Client.Connection import Network.HTTP.Client.Types import Control.Exception (throwIO, assert) import Data.ByteString (ByteString, empty, uncons) import Data.IORef import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Control.Monad (unless, when) import qualified Data.Streaming.Zlib as Z -- ^ Get a single chunk of data from the response body, or an empty -- bytestring if no more data is available. -- -- Note that in order to consume the entire request body, you will need to -- repeatedly call this function until you receive an empty @ByteString@ as a -- result. -- -- Since 0.1.0 brRead :: BodyReader -> IO S.ByteString brRead = id -- | Continuously call 'brRead', building up a lazy ByteString until a chunk is -- constructed that is at least as many bytes as requested. -- -- Since 0.4.20 brReadSome :: BodyReader -> Int -> IO L.ByteString brReadSome brRead = loop id where loop front rem | rem <= 0 = return $ L.fromChunks $ front [] | otherwise = do bs <- brRead if S.null bs then return $ L.fromChunks $ front [] else loop (front . (bs:)) (rem - S.length bs) brEmpty :: BodyReader brEmpty = return S.empty brAddCleanup :: IO () -> BodyReader -> BodyReader brAddCleanup cleanup brRead = do bs <- brRead when (S.null bs) cleanup return bs -- | Strictly consume all remaining chunks of data from the stream. -- -- Since 0.1.0 brConsume :: BodyReader -> IO [S.ByteString] brConsume brRead = go id where go front = do x <- brRead if S.null x then return $ front [] else go (front . (x:)) makeGzipReader :: BodyReader -> IO BodyReader makeGzipReader brRead = do inf <- Z.initInflate $ Z.WindowBits 31 istate <- newIORef Nothing let goPopper popper = do res <- popper case res of Z.PRNext bs -> do writeIORef istate $ Just popper return bs Z.PRDone -> do bs <- Z.flushInflate inf if S.null bs then start else do writeIORef istate Nothing return bs Z.PRError e -> throwIO $ HttpZlibException e start = do bs <- brRead if S.null bs then return S.empty else do popper <- Z.feedInflate inf bs goPopper popper return $ do state <- readIORef istate case state of Nothing -> start Just popper -> goPopper popper makeUnlimitedReader :: Connection -> IO BodyReader makeUnlimitedReader Connection {..} = do icomplete <- newIORef False return $ do bs <- connectionRead when (S.null bs) $ writeIORef icomplete True return bs makeLengthReader :: Int -> Connection -> IO BodyReader makeLengthReader count0 Connection {..} = do icount <- newIORef count0 return $ do count <- readIORef icount if count <= 0 then return empty else do bs <- connectionRead when (S.null bs) $ throwIO $ ResponseBodyTooShort (fromIntegral count0) (fromIntegral $ count0 - count) case compare count $ S.length bs of LT -> do let (x, y) = S.splitAt count bs connectionUnread y writeIORef icount (-1) return x EQ -> do writeIORef icount (-1) return bs GT -> do writeIORef icount (count - S.length bs) return bs makeChunkedReader :: Bool -- ^ raw -> Connection -> IO BodyReader makeChunkedReader raw conn@Connection {..} = do icount <- newIORef 0 return $ go icount where go icount = do count0 <- readIORef icount (rawCount, count) <- if count0 == 0 then readHeader else return (empty, count0) if count <= 0 then do writeIORef icount (-1) return $ if count /= (-1) && raw then rawCount else empty else do (bs, count') <- readChunk count writeIORef icount count' return $ appendHeader rawCount bs appendHeader | raw = S.append | otherwise = flip const readChunk 0 = return (empty, 0) readChunk remainder = do bs <- connectionRead when (S.null bs) $ throwIO InvalidChunkHeaders case compare remainder $ S.length bs of LT -> do let (x, y) = S.splitAt remainder bs assert (not $ S.null y) $ connectionUnread y requireNewline done x EQ -> do requireNewline done bs GT -> return (bs, remainder - S.length bs) where done x | raw = return (x `S.append` "\r\n", 0) | otherwise = return (x, 0) requireNewline = do bs <- connectionReadLine conn unless (S.null bs) $ throwIO InvalidChunkHeaders readHeader = do bs <- connectionReadLine conn case parseHex bs of Nothing -> throwIO InvalidChunkHeaders Just hex -> return (bs `S.append` "\r\n", hex) parseHex bs0 = case uncons bs0 of Just (w0, bs') | Just i0 <- toI w0 -> Just $ parseHex' i0 bs' _ -> Nothing parseHex' i bs = case uncons bs of Just (w, bs) | Just i' <- toI w -> parseHex' (i * 16 + i') bs _ -> i toI w | 48 <= w && w <= 57 = Just $ fromIntegral w - 48 | 65 <= w && w <= 70 = Just $ fromIntegral w - 55 | 97 <= w && w <= 102 = Just $ fromIntegral w - 87 | otherwise = Nothing http-client-0.4.26.2/Network/HTTP/Client/Connection.hs0000644000000000000000000001373012636306172020457 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} module Network.HTTP.Client.Connection ( connectionReadLine , connectionReadLineWith , connectionDropTillBlankLine , dummyConnection , openSocketConnection , openSocketConnectionSize , makeConnection ) where import Data.ByteString (ByteString, empty) import Data.IORef import Control.Monad import Control.Exception (throwIO) import Network.HTTP.Client.Types import Network.Socket (Socket, sClose, HostAddress) import qualified Network.Socket as NS import Network.Socket.ByteString (sendAll, recv) import qualified Control.Exception as E import qualified Data.ByteString as S import Data.Word (Word8) import Data.Function (fix) connectionReadLine :: Connection -> IO ByteString connectionReadLine conn = do bs <- connectionRead conn when (S.null bs) $ throwIO IncompleteHeaders connectionReadLineWith conn bs -- | Keep dropping input until a blank line is found. connectionDropTillBlankLine :: Connection -> IO () connectionDropTillBlankLine conn = fix $ \loop -> do bs <- connectionReadLine conn unless (S.null bs) loop connectionReadLineWith :: Connection -> ByteString -> IO ByteString connectionReadLineWith conn bs0 = go bs0 id 0 where go bs front total = case S.breakByte charLF bs of (_, "") -> do let total' = total + S.length bs when (total' > 4096) $ throwIO OverlongHeaders bs' <- connectionRead conn when (S.null bs') $ throwIO IncompleteHeaders go bs' (front . (bs:)) total' (x, S.drop 1 -> y) -> do unless (S.null y) $! connectionUnread conn y return $! killCR $! S.concat $! front [x] charLF, charCR :: Word8 charLF = 10 charCR = 13 killCR :: ByteString -> ByteString killCR bs | S.null bs = bs | S.last bs == charCR = S.init bs | otherwise = bs -- | For testing dummyConnection :: [ByteString] -- ^ input -> IO (Connection, IO [ByteString], IO [ByteString]) -- ^ conn, output, input dummyConnection input0 = do iinput <- newIORef input0 ioutput <- newIORef [] return (Connection { connectionRead = atomicModifyIORef iinput $ \input -> case input of [] -> ([], empty) x:xs -> (xs, x) , connectionUnread = \x -> atomicModifyIORef iinput $ \input -> (x:input, ()) , connectionWrite = \x -> atomicModifyIORef ioutput $ \output -> (output ++ [x], ()) , connectionClose = return () }, atomicModifyIORef ioutput $ \output -> ([], output), readIORef iinput) makeConnection :: IO ByteString -- ^ read -> (ByteString -> IO ()) -- ^ write -> IO () -- ^ close -> IO Connection makeConnection r w c = do istack <- newIORef [] -- it is necessary to make sure we never read from or write to -- already closed connection. closedVar <- newIORef False _ <- mkWeakIORef istack c return $! Connection { connectionRead = do closed <- readIORef closedVar when closed $ throwIO ConnectionClosed join $ atomicModifyIORef istack $ \stack -> case stack of x:xs -> (xs, return x) [] -> ([], r) , connectionUnread = \x -> do closed <- readIORef closedVar when closed $ throwIO ConnectionClosed atomicModifyIORef istack $ \stack -> (x:stack, ()) , connectionWrite = \x -> do closed <- readIORef closedVar when closed $ throwIO ConnectionClosed w x , connectionClose = do closed <- readIORef closedVar unless closed $ c writeIORef closedVar True } socketConnection :: Socket -> Int -> IO Connection socketConnection socket chunksize = makeConnection (recv socket chunksize) (sendAll socket) (sClose socket) openSocketConnection :: (Socket -> IO ()) -> Maybe HostAddress -> String -- ^ host -> Int -- ^ port -> IO Connection openSocketConnection f = openSocketConnectionSize f 8192 openSocketConnectionSize :: (Socket -> IO ()) -> Int -- ^ chunk size -> Maybe HostAddress -> String -- ^ host -> Int -- ^ port -> IO Connection openSocketConnectionSize tweakSocket chunksize hostAddress host port = do let hints = NS.defaultHints { NS.addrFlags = [NS.AI_ADDRCONFIG] , NS.addrSocketType = NS.Stream } addrs <- case hostAddress of Nothing -> NS.getAddrInfo (Just hints) (Just host) (Just $ show port) Just ha -> return [NS.AddrInfo { NS.addrFlags = [] , NS.addrFamily = NS.AF_INET , NS.addrSocketType = NS.Stream , NS.addrProtocol = 6 -- tcp , NS.addrAddress = NS.SockAddrInet (toEnum port) ha , NS.addrCanonName = Nothing }] firstSuccessful addrs $ \addr -> E.bracketOnError (NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) (NS.addrProtocol addr)) (NS.sClose) (\sock -> do NS.setSocketOption sock NS.NoDelay 1 NS.connect sock (NS.addrAddress addr) tweakSocket sock socketConnection sock chunksize) firstSuccessful :: [NS.AddrInfo] -> (NS.AddrInfo -> IO a) -> IO a firstSuccessful [] _ = error "getAddrInfo returned empty list" firstSuccessful (a:as) cb = cb a `E.catch` \(e :: E.IOException) -> case as of [] -> E.throwIO e _ -> firstSuccessful as cb http-client-0.4.26.2/Network/HTTP/Client/Cookies.hs0000644000000000000000000003313112636306172017751 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | This module implements the algorithms described in RFC 6265 for the Network.HTTP.Conduit library. module Network.HTTP.Client.Cookies ( updateCookieJar , receiveSetCookie , generateCookie , insertCheckedCookie , insertCookiesIntoRequest , computeCookieString , evictExpiredCookies , createCookieJar , destroyCookieJar , pathMatches , removeExistingCookieFromCookieJar , domainMatches , isIpAddress , defaultPath ) where import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as S8 import Data.Maybe import qualified Data.List as L import Data.Time.Clock import Data.Time.Calendar import Web.Cookie import qualified Data.CaseInsensitive as CI import Blaze.ByteString.Builder import qualified Network.PublicSuffixList.Lookup as PSL import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import qualified Network.HTTP.Client.Request as Req import qualified Network.HTTP.Client.Response as Res import Network.HTTP.Client.Types as Req slash :: Integral a => a slash = 47 -- '/' isIpAddress :: BS.ByteString -> Bool isIpAddress = go 4 where go 0 bs = BS.null bs go rest bs = case S8.readInt x of Just (i, x') | BS.null x' && i >= 0 && i < 256 -> go (rest - 1) y _ -> False where (x, y') = BS.breakByte 46 bs -- period y = BS.drop 1 y' -- | This corresponds to the subcomponent algorithm entitled \"Domain Matching\" detailed -- in section 5.1.3 domainMatches :: BS.ByteString -- ^ Domain to test -> BS.ByteString -- ^ Domain from a cookie -> Bool domainMatches string' domainString' | string == domainString = True | BS.length string < BS.length domainString + 1 = False | domainString `BS.isSuffixOf` string && BS.singleton (BS.last difference) == "." && not (isIpAddress string) = True | otherwise = False where difference = BS.take (BS.length string - BS.length domainString) string string = CI.foldCase string' domainString = CI.foldCase domainString' -- | This corresponds to the subcomponent algorithm entitled \"Paths\" detailed -- in section 5.1.4 defaultPath :: Req.Request -> BS.ByteString defaultPath req | BS.null uri_path = "/" | BS.singleton (BS.head uri_path) /= "/" = "/" | BS.count slash uri_path <= 1 = "/" | otherwise = BS.reverse $ BS.tail $ BS.dropWhile (/= slash) $ BS.reverse uri_path where uri_path = Req.path req -- | This corresponds to the subcomponent algorithm entitled \"Path-Match\" detailed -- in section 5.1.4 pathMatches :: BS.ByteString -> BS.ByteString -> Bool pathMatches requestPath cookiePath | cookiePath == path' = True | cookiePath `BS.isPrefixOf` path' && BS.singleton (BS.last cookiePath) == "/" = True | cookiePath `BS.isPrefixOf` path' && BS.singleton (BS.head remainder) == "/" = True | otherwise = False where remainder = BS.drop (BS.length cookiePath) requestPath path' = case S8.uncons requestPath of Just ('/', _) -> requestPath _ -> '/' `S8.cons` requestPath createCookieJar :: [Cookie] -> CookieJar createCookieJar = CJ destroyCookieJar :: CookieJar -> [Cookie] destroyCookieJar = expose insertIntoCookieJar :: Cookie -> CookieJar -> CookieJar insertIntoCookieJar cookie cookie_jar' = CJ $ cookie : cookie_jar where cookie_jar = expose cookie_jar' removeExistingCookieFromCookieJar :: Cookie -> CookieJar -> (Maybe Cookie, CookieJar) removeExistingCookieFromCookieJar cookie cookie_jar' = (mc, CJ lc) where (mc, lc) = removeExistingCookieFromCookieJarHelper cookie (expose cookie_jar') removeExistingCookieFromCookieJarHelper _ [] = (Nothing, []) removeExistingCookieFromCookieJarHelper c (c' : cs) | c == c' = (Just c', cs) | otherwise = (cookie', c' : cookie_jar'') where (cookie', cookie_jar'') = removeExistingCookieFromCookieJarHelper c cs -- | Are we configured to reject cookies for domains such as \"com\"? rejectPublicSuffixes :: Bool rejectPublicSuffixes = True isPublicSuffix :: BS.ByteString -> Bool isPublicSuffix = PSL.isSuffix . decodeUtf8With lenientDecode -- | This corresponds to the eviction algorithm described in Section 5.3 \"Storage Model\" evictExpiredCookies :: CookieJar -- ^ Input cookie jar -> UTCTime -- ^ Value that should be used as \"now\" -> CookieJar -- ^ Filtered cookie jar evictExpiredCookies cookie_jar' now = CJ $ filter (\ cookie -> cookie_expiry_time cookie >= now) $ expose cookie_jar' -- | This applies the 'computeCookieString' to a given Request insertCookiesIntoRequest :: Req.Request -- ^ The request to insert into -> CookieJar -- ^ Current cookie jar -> UTCTime -- ^ Value that should be used as \"now\" -> (Req.Request, CookieJar) -- ^ (Ouptut request, Updated cookie jar (last-access-time is updated)) insertCookiesIntoRequest request cookie_jar now | BS.null cookie_string = (request, cookie_jar') | otherwise = (request {Req.requestHeaders = cookie_header : purgedHeaders}, cookie_jar') where purgedHeaders = L.deleteBy (\ (a, _) (b, _) -> a == b) (CI.mk $ "Cookie", BS.empty) $ Req.requestHeaders request (cookie_string, cookie_jar') = computeCookieString request cookie_jar now True cookie_header = (CI.mk $ "Cookie", cookie_string) -- | This corresponds to the algorithm described in Section 5.4 \"The Cookie Header\" computeCookieString :: Req.Request -- ^ Input request -> CookieJar -- ^ Current cookie jar -> UTCTime -- ^ Value that should be used as \"now\" -> Bool -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that) -> (BS.ByteString, CookieJar) -- ^ (Contents of a \"Cookie\" header, Updated cookie jar (last-access-time is updated)) computeCookieString request cookie_jar now is_http_api = (output_line, cookie_jar') where matching_cookie cookie = condition1 && condition2 && condition3 && condition4 where condition1 | cookie_host_only cookie = CI.foldCase (Req.host request) == CI.foldCase (cookie_domain cookie) | otherwise = domainMatches (Req.host request) (cookie_domain cookie) condition2 = pathMatches (Req.path request) (cookie_path cookie) condition3 | not (cookie_secure_only cookie) = True | otherwise = Req.secure request condition4 | not (cookie_http_only cookie) = True | otherwise = is_http_api matching_cookies = filter matching_cookie $ expose cookie_jar output_cookies = map (\ c -> (cookie_name c, cookie_value c)) $ L.sort matching_cookies output_line = toByteString $ renderCookies $ output_cookies folding_function cookie_jar'' cookie = case removeExistingCookieFromCookieJar cookie cookie_jar'' of (Just c, cookie_jar''') -> insertIntoCookieJar (c {cookie_last_access_time = now}) cookie_jar''' (Nothing, cookie_jar''') -> cookie_jar''' cookie_jar' = foldl folding_function cookie_jar matching_cookies -- | This applies 'receiveSetCookie' to a given Response updateCookieJar :: Response a -- ^ Response received from server -> Request -- ^ Request which generated the response -> UTCTime -- ^ Value that should be used as \"now\" -> CookieJar -- ^ Current cookie jar -> (CookieJar, Response a) -- ^ (Updated cookie jar with cookies from the Response, The response stripped of any \"Set-Cookie\" header) updateCookieJar response request now cookie_jar = (cookie_jar', response { responseHeaders = other_headers }) where (set_cookie_headers, other_headers) = L.partition ((== (CI.mk $ "Set-Cookie")) . fst) $ responseHeaders response set_cookie_data = map snd set_cookie_headers set_cookies = map parseSetCookie set_cookie_data cookie_jar' = foldl (\ cj sc -> receiveSetCookie sc request now True cj) cookie_jar set_cookies -- | This corresponds to the algorithm described in Section 5.3 \"Storage Model\" -- This function consists of calling 'generateCookie' followed by 'insertCheckedCookie'. -- Use this function if you plan to do both in a row. -- 'generateCookie' and 'insertCheckedCookie' are only provided for more fine-grained control. receiveSetCookie :: SetCookie -- ^ The 'SetCookie' the cookie jar is receiving -> Req.Request -- ^ The request that originated the response that yielded the 'SetCookie' -> UTCTime -- ^ Value that should be used as \"now\" -> Bool -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that) -> CookieJar -- ^ Input cookie jar to modify -> CookieJar -- ^ Updated cookie jar receiveSetCookie set_cookie request now is_http_api cookie_jar = case (do cookie <- generateCookie set_cookie request now is_http_api return $ insertCheckedCookie cookie cookie_jar is_http_api) of Just cj -> cj Nothing -> cookie_jar -- | Insert a cookie created by generateCookie into the cookie jar (or not if it shouldn't be allowed in) insertCheckedCookie :: Cookie -- ^ The 'SetCookie' the cookie jar is receiving -> CookieJar -- ^ Input cookie jar to modify -> Bool -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that) -> CookieJar -- ^ Updated (or not) cookie jar insertCheckedCookie c cookie_jar is_http_api = case (do (cookie_jar', cookie') <- existanceTest c cookie_jar return $ insertIntoCookieJar cookie' cookie_jar') of Just cj -> cj Nothing -> cookie_jar where existanceTest cookie cookie_jar' = existanceTestHelper cookie $ removeExistingCookieFromCookieJar cookie cookie_jar' existanceTestHelper new_cookie (Just old_cookie, cookie_jar') | not is_http_api && cookie_http_only old_cookie = Nothing | otherwise = return (cookie_jar', new_cookie {cookie_creation_time = cookie_creation_time old_cookie}) existanceTestHelper new_cookie (Nothing, cookie_jar') = return (cookie_jar', new_cookie) -- | Turn a SetCookie into a Cookie, if it is valid generateCookie :: SetCookie -- ^ The 'SetCookie' we are encountering -> Req.Request -- ^ The request that originated the response that yielded the 'SetCookie' -> UTCTime -- ^ Value that should be used as \"now\" -> Bool -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that) -> Maybe Cookie -- ^ The optional output cookie generateCookie set_cookie request now is_http_api = do domain_sanitized <- sanitizeDomain $ step4 (setCookieDomain set_cookie) domain_intermediate <- step5 domain_sanitized (domain_final, host_only') <- step6 domain_intermediate http_only' <- step10 return $ Cookie { cookie_name = setCookieName set_cookie , cookie_value = setCookieValue set_cookie , cookie_expiry_time = getExpiryTime (setCookieExpires set_cookie) (setCookieMaxAge set_cookie) , cookie_domain = domain_final , cookie_path = getPath $ setCookiePath set_cookie , cookie_creation_time = now , cookie_last_access_time = now , cookie_persistent = getPersistent , cookie_host_only = host_only' , cookie_secure_only = setCookieSecure set_cookie , cookie_http_only = http_only' } where sanitizeDomain domain' | has_a_character && BS.singleton (BS.last domain') == "." = Nothing | has_a_character && BS.singleton (BS.head domain') == "." = Just $ BS.tail domain' | otherwise = Just $ domain' where has_a_character = not (BS.null domain') step4 (Just set_cookie_domain) = set_cookie_domain step4 Nothing = BS.empty step5 domain' | firstCondition && domain' == (Req.host request) = return BS.empty | firstCondition = Nothing | otherwise = return domain' where firstCondition = rejectPublicSuffixes && has_a_character && isPublicSuffix domain' has_a_character = not (BS.null domain') step6 domain' | firstCondition && not (domainMatches (Req.host request) domain') = Nothing | firstCondition = return (domain', False) | otherwise = return (Req.host request, True) where firstCondition = not $ BS.null domain' step10 | not is_http_api && setCookieHttpOnly set_cookie = Nothing | otherwise = return $ setCookieHttpOnly set_cookie getExpiryTime :: Maybe UTCTime -> Maybe DiffTime -> UTCTime getExpiryTime _ (Just t) = (fromRational $ toRational t) `addUTCTime` now getExpiryTime (Just t) Nothing = t getExpiryTime Nothing Nothing = UTCTime (365000 `addDays` utctDay now) (secondsToDiffTime 0) getPath (Just p) = p getPath Nothing = defaultPath request getPersistent = isJust (setCookieExpires set_cookie) || isJust (setCookieMaxAge set_cookie) http-client-0.4.26.2/Network/HTTP/Client/Core.hs0000644000000000000000000002236312636306172017252 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Client.Core ( withResponse , httpLbs , httpNoBody , httpRaw , responseOpen , responseClose , applyCheckStatus , httpRedirect ) where #if !MIN_VERSION_base(4,6,0) import Prelude hiding (catch) #endif import Network.HTTP.Types import Network.HTTP.Client.Manager import Network.HTTP.Client.Types import Network.HTTP.Client.Body import Network.HTTP.Client.Request import Network.HTTP.Client.Response import Network.HTTP.Client.Cookies import Data.Time import Control.Exception import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.Monoid import Control.Monad (void) -- | Perform a @Request@ using a connection acquired from the given @Manager@, -- and then provide the @Response@ to the given function. This function is -- fully exception safe, guaranteeing that the response will be closed when the -- inner function exits. It is defined as: -- -- > withResponse req man f = bracket (responseOpen req man) responseClose f -- -- It is recommended that you use this function in place of explicit calls to -- 'responseOpen' and 'responseClose'. -- -- You will need to use functions such as 'brRead' to consume the response -- body. -- -- Since 0.1.0 withResponse :: Request -> Manager -> (Response BodyReader -> IO a) -> IO a withResponse req man f = bracket (responseOpen req man) responseClose f -- | A convenience wrapper around 'withResponse' which reads in the entire -- response body and immediately closes the connection. Note that this function -- performs fully strict I\/O, and only uses a lazy ByteString in its response -- for memory efficiency. If you are anticipating a large response body, you -- are encouraged to use 'withResponse' and 'brRead' instead. -- -- Since 0.1.0 httpLbs :: Request -> Manager -> IO (Response L.ByteString) httpLbs req man = withResponse req man $ \res -> do bss <- brConsume $ responseBody res return res { responseBody = L.fromChunks bss } -- | A convenient wrapper around 'withResponse' which ignores the response -- body. This is useful, for example, when performing a HEAD request. -- -- Since 0.3.2 httpNoBody :: Request -> Manager -> IO (Response ()) httpNoBody req man = withResponse req man $ return . void -- | Get a 'Response' without any redirect following. httpRaw :: Request -> Manager -> IO (Response BodyReader) httpRaw req0 m = do req' <- mModifyRequest m $ mSetProxy m req0 (req, cookie_jar') <- case cookieJar req' of Just cj -> do now <- getCurrentTime return $ insertCookiesIntoRequest req' (evictExpiredCookies cj now) now Nothing -> return (req', mempty) (timeout', (connRelease, ci, isManaged)) <- getConnectionWrapper req (responseTimeout' req) (failedConnectionException req) (getConn req m) -- Originally, we would only test for exceptions when sending the request, -- not on calling @getResponse@. However, some servers seem to close -- connections after accepting the request headers, so we need to check for -- exceptions in both. ex <- try $ do cont <- requestBuilder (dropProxyAuthSecure req) ci getResponse connRelease timeout' req ci cont case (ex, isManaged) of -- Connection was reused, and might have been closed. Try again (Left e, Reused) | mRetryableException m e -> do connRelease DontReuse responseOpen req m -- Not reused, or a non-retry, so this is a real exception (Left e, _) -> throwIO e -- Everything went ok, so the connection is good. If any exceptions get -- thrown in the response body, just throw them as normal. (Right res, _) -> case cookieJar req' of Just _ -> do now' <- getCurrentTime let (cookie_jar, _) = updateCookieJar res req now' cookie_jar' return $ res {responseCookieJar = cookie_jar} Nothing -> return res where responseTimeout' req | rt == useDefaultTimeout = mResponseTimeout m | otherwise = rt where rt = responseTimeout req -- | The most low-level function for initiating an HTTP request. -- -- The first argument to this function gives a full specification -- on the request: the host to connect to, whether to use SSL, -- headers, etc. Please see 'Request' for full details. The -- second argument specifies which 'Manager' should be used. -- -- This function then returns a 'Response' with a -- 'BodyReader'. The 'Response' contains the status code -- and headers that were sent back to us, and the -- 'BodyReader' contains the body of the request. Note -- that this 'BodyReader' allows you to have fully -- interleaved IO actions during your HTTP download, making it -- possible to download very large responses in constant memory. -- -- An important note: the response body returned by this function represents a -- live HTTP connection. As such, if you do not use the response body, an open -- socket will be retained indefinitely. You must be certain to call -- 'responseClose' on this response to free up resources. -- -- This function automatically performs any necessary redirects, as specified -- by the 'redirectCount' setting. -- -- When implementing a (reverse) proxy using this function or relating -- functions, it's wise to remove Transfer-Encoding:, Content-Length:, -- Content-Encoding: and Accept-Encoding: from request and response -- headers to be relayed. -- -- Since 0.1.0 responseOpen :: Request -> Manager -> IO (Response BodyReader) responseOpen req0 manager = handle addTlsHostPort $ mWrapIOException manager $ do res <- if redirectCount req0 == 0 then httpRaw req0 manager else go (redirectCount req0) req0 maybe (return res) throwIO =<< applyCheckStatus req0 (checkStatus req0) res where addTlsHostPort (TlsException e) = throwIO $ TlsExceptionHostPort e (host req0) (port req0) addTlsHostPort e = throwIO e go count req' = httpRedirect count (\req -> do res <- httpRaw req manager let mreq = getRedirectedRequest req (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)) return (res, mreq)) req' -- | Apply 'Request'\'s 'checkStatus' and return resulting exception if any. applyCheckStatus :: Request -> (Status -> ResponseHeaders -> CookieJar -> Maybe SomeException) -> Response BodyReader -> IO (Maybe SomeException) applyCheckStatus req checkStatus' res = case checkStatus' (responseStatus res) (responseHeaders res) (responseCookieJar res) of Nothing -> return Nothing Just exc -> do exc' <- case fromException exc of Just (StatusCodeException s hdrs cookie_jar) -> do lbs <- brReadSome (responseBody res) 1024 return $ toException $ StatusCodeException s (hdrs ++ [ ("X-Response-Body-Start", toStrict' lbs) , ("X-Request-URL", S.concat [ method req , " " , S8.pack $ show $ getUri req ]) ]) cookie_jar _ -> return exc responseClose res return (Just exc') where #ifndef MIN_VERSION_bytestring #define MIN_VERSION_bytestring(x,y,z) 1 #endif #if MIN_VERSION_bytestring(0,10,0) toStrict' = L.toStrict #else toStrict' = S.concat . L.toChunks #endif -- | Redirect loop httpRedirect :: Int -- ^ 'redirectCount' -> (Request -> IO (Response BodyReader, Maybe Request)) -- ^ function which performs a request and returns a response, and possibly another request if there's a redirect. -> Request -> IO (Response BodyReader) httpRedirect count0 http' req0 = go count0 req0 [] where go count _ ress | count < 0 = throwIO $ TooManyRedirects ress go count req' ress = do (res, mreq) <- http' req' case mreq of Just req -> do -- Allow the original connection to return to the -- connection pool immediately by flushing the body. -- If the response body is too large, don't flush, but -- instead just close the connection. let maxFlush = 1024 lbs <- brReadSome (responseBody res) maxFlush -- The connection may already be closed, e.g. -- when using withResponseHistory. See -- https://github.com/snoyberg/http-client/issues/169 `catch` \(_ :: ConnectionClosed) -> return L.empty responseClose res -- And now perform the actual redirect go (count - 1) req (res { responseBody = lbs }:ress) Nothing -> return res -- | Close any open resources associated with the given @Response@. In general, -- this will either close an active @Connection@ or return it to the @Manager@ -- to be reused. -- -- Since 0.1.0 responseClose :: Response a -> IO () responseClose = runResponseClose . responseClose' http-client-0.4.26.2/Network/HTTP/Client/Headers.hs0000644000000000000000000000704512636306172017735 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Network.HTTP.Client.Headers ( parseStatusHeaders ) where import Control.Applicative ((<$>), (<*>)) import Control.Exception (throwIO) import Control.Monad import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.CaseInsensitive as CI import Network.HTTP.Client.Connection import Network.HTTP.Client.Types import Network.HTTP.Client.Util (timeout) import Network.HTTP.Types import Data.Word (Word8) charLF, charCR, charSpace, charColon, charPeriod :: Word8 charLF = 10 charCR = 13 charSpace = 32 charColon = 58 charPeriod = 46 parseStatusHeaders :: Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders parseStatusHeaders conn timeout' cont | Just k <- cont = getStatusExpectContinue k | otherwise = getStatus where withTimeout = case timeout' of Nothing -> id Just t -> timeout t >=> maybe (throwIO ResponseTimeout) return getStatus = withTimeout next where next = nextStatusHeaders >>= maybe next return getStatusExpectContinue sendBody = do status <- withTimeout nextStatusHeaders case status of Just s -> return s Nothing -> sendBody >> getStatus nextStatusHeaders = do (s, v) <- nextStatusLine if statusCode s == 100 then connectionDropTillBlankLine conn >> return Nothing else Just . StatusHeaders s v <$> parseHeaders 0 id nextStatusLine :: IO (Status, HttpVersion) nextStatusLine = do -- Ensure that there is some data coming in. If not, we want to signal -- this as a connection problem and not a protocol problem. bs <- connectionRead conn when (S.null bs) $ throwIO NoResponseDataReceived connectionReadLineWith conn bs >>= parseStatus 3 parseStatus :: Int -> S.ByteString -> IO (Status, HttpVersion) parseStatus i bs | S.null bs && i > 0 = connectionReadLine conn >>= parseStatus (i - 1) parseStatus _ bs = do let (ver, bs2) = S.breakByte charSpace bs (code, bs3) = S.breakByte charSpace $ S.dropWhile (== charSpace) bs2 msg = S.dropWhile (== charSpace) bs3 case (,) <$> parseVersion ver <*> readInt code of Just (ver', code') -> return (Status code' msg, ver') Nothing -> throwIO $ InvalidStatusLine bs stripPrefixBS x y | x `S.isPrefixOf` y = Just $ S.drop (S.length x) y | otherwise = Nothing parseVersion bs0 = do bs1 <- stripPrefixBS "HTTP/" bs0 let (num1, S.drop 1 -> num2) = S.breakByte charPeriod bs1 HttpVersion <$> readInt num1 <*> readInt num2 readInt bs = case S8.readInt bs of Just (i, "") -> Just i _ -> Nothing parseHeaders 100 _ = throwIO OverlongHeaders parseHeaders count front = do line <- connectionReadLine conn if S.null line then return $ front [] else do header <- parseHeader line parseHeaders (count + 1) $ front . (header:) parseHeader :: S.ByteString -> IO Header parseHeader bs = do let (key, bs2) = S.breakByte charColon bs when (S.null bs2) $ throwIO $ InvalidHeader bs return (CI.mk $! strip key, strip $! S.drop 1 bs2) strip = S.dropWhile (== charSpace) . fst . S.spanEnd (== charSpace) http-client-0.4.26.2/Network/HTTP/Client/Internal.hs0000644000000000000000000000266012636306172020134 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} -- | Note that this is essentially the \"kitchen sink\" export module, -- including many functions intended only to be used internally by this -- package. No API stability is guaranteed for this module. If you see -- functions here which you believe should be promoted to a stable API, please -- contact the author. module Network.HTTP.Client.Internal ( -- * Low-level response body handling module Network.HTTP.Client.Body -- * Raw connection handling , module Network.HTTP.Client.Connection -- * Cookies , module Network.HTTP.Client.Cookies -- * Performing requests , module Network.HTTP.Client.Core -- * Parse response headers , module Network.HTTP.Client.Headers -- * Request helper functions , module Network.HTTP.Client.Request -- * Low-level response body handling , module Network.HTTP.Client.Response -- * Manager , module Network.HTTP.Client.Manager -- * All types , module Network.HTTP.Client.Types -- * Various utilities , module Network.HTTP.Client.Util ) where import Network.HTTP.Client.Body import Network.HTTP.Client.Connection import Network.HTTP.Client.Cookies import Network.HTTP.Client.Core import Network.HTTP.Client.Headers import Network.HTTP.Client.Manager import Network.HTTP.Client.Request import Network.HTTP.Client.Response import Network.HTTP.Client.Types import Network.HTTP.Client.Util http-client-0.4.26.2/Network/HTTP/Client/Manager.hs0000644000000000000000000005313512636306172017735 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} module Network.HTTP.Client.Manager ( ManagerSettings (..) , newManager , closeManager , withManager , getConn , failedConnectionException , defaultManagerSettings , rawConnectionModifySocket , proxyFromRequest , noProxy , useProxy , proxyEnvironment , proxyEnvironmentNamed , defaultProxy , dropProxyAuthSecure ) where #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #if !MIN_VERSION_base(4,6,0) import Prelude hiding (catch) #endif import Control.Applicative ((<|>)) import Control.Arrow (first) import Data.Monoid (mappend) import System.IO (hClose, hFlush, IOMode(..)) import qualified Data.IORef as I import qualified Data.Map as Map import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import qualified Blaze.ByteString.Builder as Blaze import Data.Char (toLower) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Read (decimal) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad (unless, join, when, void, mplus) import Control.Exception (mask_, SomeException, bracket, catch, throwIO, fromException, mask, IOException, Exception (..), handle) import Control.Concurrent (forkIO, threadDelay) import Data.Time (UTCTime (..), Day (..), DiffTime, getCurrentTime, addUTCTime) import Control.DeepSeq (deepseq) import qualified Network.Socket as NS import Data.Maybe (mapMaybe) import System.IO (Handle) import System.Mem.Weak (Weak, deRefWeak) import Network.HTTP.Types (status200) import Network.HTTP.Client.Types import Network.HTTP.Client.Connection import Network.HTTP.Client.Headers (parseStatusHeaders) import Network.HTTP.Client.Request (username, password, applyBasicProxyAuth) import Control.Concurrent.MVar (MVar, takeMVar, tryPutMVar, newEmptyMVar) import System.Environment (getEnvironment) import qualified Network.URI as U import Control.Monad (guard) -- | A value for the @managerRawConnection@ setting, but also allows you to -- modify the underlying @Socket@ to set additional settings. For a motivating -- use case, see: . -- -- Since 0.3.8 rawConnectionModifySocket :: (NS.Socket -> IO ()) -> IO (Maybe NS.HostAddress -> String -> Int -> IO Connection) rawConnectionModifySocket = return . openSocketConnection -- | Same as @rawConnectionModifySocket@, but also takes in a chunk size. -- -- Since 0.4.5 rawConnectionModifySocketSize :: (NS.Socket -> IO ()) -> IO (Int -> Maybe NS.HostAddress -> String -> Int -> IO Connection) rawConnectionModifySocketSize = return . openSocketConnectionSize -- | Default value for @ManagerSettings@. -- -- Note that this value does /not/ have support for SSL/TLS. If you need to -- make any https connections, please use the http-client-tls package, which -- provides a @tlsManagerSettings@ value. -- -- Since 0.1.0 defaultManagerSettings :: ManagerSettings defaultManagerSettings = ManagerSettings { managerConnCount = 10 , managerRawConnection = return $ openSocketConnection (const $ return ()) , managerTlsConnection = return $ \_ _ _ -> throwIO TlsNotSupported , managerTlsProxyConnection = return $ \_ _ _ _ _ _ -> throwIO TlsNotSupported , managerResponseTimeout = Just 30000000 , managerRetryableException = \e -> case fromException e of Just (_ :: IOException) -> True _ -> case fromException e of -- Note: Some servers will timeout connections by accepting -- the incoming packets for the new request, but closing -- the connection as soon as we try to read. To make sure -- we open a new connection under these circumstances, we -- check for the NoResponseDataReceived exception. Just NoResponseDataReceived -> True Just IncompleteHeaders -> True _ -> False , managerWrapIOException = let wrapper se = case fromException se of Just e -> toException $ InternalIOException e Nothing -> se in handle $ throwIO . wrapper , managerIdleConnectionCount = 512 , managerModifyRequest = return , managerProxyInsecure = defaultProxy , managerProxySecure = defaultProxy } takeSocket :: Manager -> ConnKey -> IO (Maybe Connection) takeSocket man key = I.atomicModifyIORef (mConns man) go where go ManagerClosed = (ManagerClosed, Nothing) go mcOrig@(ManagerOpen idleCount m) = case Map.lookup key m of Nothing -> (mcOrig, Nothing) Just (One a _) -> let mc = ManagerOpen (idleCount - 1) (Map.delete key m) in mc `seq` (mc, Just a) Just (Cons a _ _ rest) -> let mc = ManagerOpen (idleCount - 1) (Map.insert key rest m) in mc `seq` (mc, Just a) putSocket :: Manager -> ConnKey -> Connection -> IO () putSocket man key ci = do now <- getCurrentTime join $ I.atomicModifyIORef (mConns man) (go now) void $ tryPutMVar (mConnsBaton man) () where go _ ManagerClosed = (ManagerClosed , connectionClose ci) go now mc@(ManagerOpen idleCount m) | idleCount >= mIdleConnectionCount man = (mc, connectionClose ci) | otherwise = case Map.lookup key m of Nothing -> let cnt' = idleCount + 1 m' = ManagerOpen cnt' (Map.insert key (One ci now) m) in m' `seq` (m', return ()) Just l -> let (l', mx) = addToList now (mMaxConns man) ci l cnt' = idleCount + maybe 0 (const 1) mx m' = ManagerOpen cnt' (Map.insert key l' m) in m' `seq` (m', maybe (return ()) connectionClose mx) -- | Add a new element to the list, up to the given maximum number. If we're -- already at the maximum, return the new value as leftover. addToList :: UTCTime -> Int -> a -> NonEmptyList a -> (NonEmptyList a, Maybe a) addToList _ i x l | i <= 1 = (l, Just x) addToList now _ x l@One{} = (Cons x 2 now l, Nothing) addToList now maxCount x l@(Cons _ currCount _ _) | maxCount > currCount = (Cons x (currCount + 1) now l, Nothing) | otherwise = (l, Just x) -- | Create a 'Manager'. The @Manager@ will be shut down automatically via -- garbage collection. -- -- Creating a new 'Manager' is a relatively expensive operation, you are -- advised to share a single 'Manager' between requests instead. -- -- The first argument to this function is often 'defaultManagerSettings', -- though add-on libraries may provide a recommended replacement. -- -- Since 0.1.0 newManager :: ManagerSettings -> IO Manager newManager ms = do NS.withSocketsDo $ return () rawConnection <- managerRawConnection ms tlsConnection <- managerTlsConnection ms tlsProxyConnection <- managerTlsProxyConnection ms mapRef <- I.newIORef $! ManagerOpen 0 Map.empty baton <- newEmptyMVar wmapRef <- I.mkWeakIORef mapRef $ closeManager' mapRef httpProxy <- runProxyOverride (managerProxyInsecure ms) False httpsProxy <- runProxyOverride (managerProxySecure ms) True _ <- forkIO $ reap baton wmapRef let manager = Manager { mConns = mapRef , mConnsBaton = baton , mMaxConns = managerConnCount ms , mResponseTimeout = managerResponseTimeout ms , mRawConnection = rawConnection , mTlsConnection = tlsConnection , mTlsProxyConnection = tlsProxyConnection , mRetryableException = managerRetryableException ms , mWrapIOException = managerWrapIOException ms , mIdleConnectionCount = managerIdleConnectionCount ms , mModifyRequest = managerModifyRequest ms , mSetProxy = \req -> if secure req then httpsProxy req else httpProxy req } return manager -- | Collect and destroy any stale connections. reap :: MVar () -> Weak (I.IORef ConnsMap) -> IO () reap baton wmapRef = mask_ loop where loop = do threadDelay (5 * 1000 * 1000) mmapRef <- deRefWeak wmapRef case mmapRef of Nothing -> return () -- manager is closed Just mapRef -> goMapRef mapRef goMapRef mapRef = do now <- getCurrentTime let isNotStale time = 30 `addUTCTime` time >= now (newMap, toDestroy) <- I.atomicModifyIORef mapRef $ \m -> let (newMap, toDestroy) = findStaleWrap isNotStale m in (newMap, (newMap, toDestroy)) mapM_ safeConnClose toDestroy case newMap of ManagerOpen _ m | not $ Map.null m -> return () _ -> takeMVar baton loop findStaleWrap _ ManagerClosed = (ManagerClosed, []) findStaleWrap isNotStale (ManagerOpen idleCount m) = let (x, y) = findStale isNotStale m in (ManagerOpen (idleCount - length y) x, y) findStale isNotStale = findStale' id id . Map.toList where findStale' destroy keep [] = (Map.fromList $ keep [], destroy []) findStale' destroy keep ((connkey, nelist):rest) = findStale' destroy' keep' rest where -- Note: By definition, the timestamps must be in descending order, -- so we don't need to traverse the whole list. (notStale, stale) = span (isNotStale . fst) $ neToList nelist destroy' = destroy . (map snd stale++) keep' = case neFromList notStale of Nothing -> keep Just x -> keep . ((connkey, x):) flushStaleCerts now = Map.fromList . mapMaybe flushStaleCerts' . Map.toList where flushStaleCerts' (host', inner) = case mapMaybe flushStaleCerts'' $ Map.toList inner of [] -> Nothing pairs -> let x = take 10 pairs in x `seqPairs` Just (host', Map.fromList x) flushStaleCerts'' (certs, expires) | expires > now = Just (certs, expires) | otherwise = Nothing seqPairs :: [(L.ByteString, UTCTime)] -> b -> b seqPairs [] b = b seqPairs (p:ps) b = p `seqPair` ps `seqPairs` b seqPair :: (L.ByteString, UTCTime) -> b -> b seqPair (lbs, utc) b = lbs `seqLBS` utc `seqUTC` b seqLBS :: L.ByteString -> b -> b seqLBS lbs b = L.length lbs `seq` b seqUTC :: UTCTime -> b -> b seqUTC (UTCTime day dt) b = day `seqDay` dt `seqDT` b seqDay :: Day -> b -> b seqDay (ModifiedJulianDay i) b = i `deepseq` b seqDT :: DiffTime -> b -> b seqDT = seq neToList :: NonEmptyList a -> [(UTCTime, a)] neToList (One a t) = [(t, a)] neToList (Cons a _ t nelist) = (t, a) : neToList nelist neFromList :: [(UTCTime, a)] -> Maybe (NonEmptyList a) neFromList [] = Nothing neFromList [(t, a)] = Just (One a t) neFromList xs = Just . snd . go $ xs where go [] = error "neFromList.go []" go [(t, a)] = (2, One a t) go ((t, a):rest) = let (i, rest') = go rest i' = i + 1 in i' `seq` (i', Cons a i t rest') -- | Close all connections in a 'Manager'. -- -- Note that this doesn't affect currently in-flight connections, -- meaning you can safely use it without hurting any queries you may -- have concurrently running. -- -- Since 0.1.0 closeManager :: Manager -> IO () closeManager _ = return () {-# DEPRECATED closeManager "Manager will be closed for you automatically when no longer in use" #-} closeManager' :: I.IORef ConnsMap -> IO () closeManager' connsRef = mask_ $ do !m <- I.atomicModifyIORef connsRef $ \x -> (ManagerClosed, x) case m of ManagerClosed -> return () ManagerOpen _ m -> mapM_ (nonEmptyMapM_ safeConnClose) $ Map.elems m -- | Create, use and close a 'Manager'. -- -- Since 0.2.1 withManager :: ManagerSettings -> (Manager -> IO a) -> IO a withManager settings f = newManager settings >>= f {-# DEPRECATED withManager "Use newManager instead" #-} safeConnClose :: Connection -> IO () safeConnClose ci = connectionClose ci `catch` \(_ :: IOException) -> return () nonEmptyMapM_ :: Monad m => (a -> m ()) -> NonEmptyList a -> m () nonEmptyMapM_ f (One x _) = f x nonEmptyMapM_ f (Cons x _ _ l) = f x >> nonEmptyMapM_ f l -- | This function needs to acquire a @ConnInfo@- either from the @Manager@ or -- via I\/O, and register it with the @ResourceT@ so it is guaranteed to be -- either released or returned to the manager. getManagedConn :: Manager -> ConnKey -> IO Connection -> IO (ConnRelease, Connection, ManagedConn) -- We want to avoid any holes caused by async exceptions, so let's mask. getManagedConn man key open = mask $ \restore -> do -- Try to take the socket out of the manager. mci <- takeSocket man key (ci, isManaged) <- case mci of -- There wasn't a matching connection in the manager, so create a -- new one. Nothing -> do ci <- restore open return (ci, Fresh) -- Return the existing one Just ci -> return (ci, Reused) -- When we release this connection, we can either reuse it (put it back in -- the manager) or not reuse it (close the socket). We set up a mutable -- reference to track what we want to do. By default, we say not to reuse -- it, that way if an exception is thrown, the connection won't be reused. toReuseRef <- I.newIORef DontReuse wasReleasedRef <- I.newIORef False -- When the connection is explicitly released, we update our toReuseRef to -- indicate what action should be taken, and then call release. let connRelease r = do I.writeIORef toReuseRef r releaseHelper releaseHelper = mask $ \restore -> do wasReleased <- I.atomicModifyIORef wasReleasedRef $ \x -> (True, x) unless wasReleased $ do toReuse <- I.readIORef toReuseRef restore $ case toReuse of Reuse -> putSocket man key ci DontReuse -> connectionClose ci return (connRelease, ci, isManaged) -- | Create an exception to be thrown if the connection for the given request -- fails. failedConnectionException :: Request -> HttpException failedConnectionException req = FailedConnectionException host' port' where (_, host', port') = getConnDest req getConnDest :: Request -> (Bool, String, Int) getConnDest req = case proxy req of Just p -> (True, S8.unpack (proxyHost p), proxyPort p) Nothing -> (False, S8.unpack $ host req, port req) -- | Drop the Proxy-Authorization header from the request if we're using a -- secure proxy. dropProxyAuthSecure :: Request -> Request dropProxyAuthSecure req | secure req && useProxy = req { requestHeaders = filter (\(k, _) -> k /= "Proxy-Authorization") (requestHeaders req) } | otherwise = req where (useProxy, _, _) = getConnDest req getConn :: Request -> Manager -> IO (ConnRelease, Connection, ManagedConn) getConn req m -- Stop Mac OS X from getting high: -- https://github.com/snoyberg/http-client/issues/40#issuecomment-39117909 | S8.null h = throwIO $ InvalidDestinationHost h | otherwise = getManagedConn m (ConnKey connKeyHost connport (host req) (port req) (secure req)) $ wrapConnectExc $ go connaddr connhost connport where h = host req (useProxy, connhost, connport) = getConnDest req (connaddr, connKeyHost) = case (hostAddress req, useProxy) of (Just ha, False) -> (Just ha, HostAddress ha) _ -> (Nothing, HostName $ T.pack connhost) wrapConnectExc = handle $ \e -> throwIO $ FailedConnectionException2 connhost connport (secure req) (toException (e :: IOException)) go = case (secure req, useProxy) of (False, _) -> mRawConnection m (True, False) -> mTlsConnection m (True, True) -> let ultHost = host req ultPort = port req proxyAuthorizationHeader = maybe "" (\h -> S8.concat ["Proxy-Authorization: ", h, "\r\n"]) . lookup "Proxy-Authorization" $ requestHeaders req connstr = S8.concat [ "CONNECT " , ultHost , ":" , S8.pack $ show ultPort , " HTTP/1.1\r\n" , proxyAuthorizationHeader , "\r\n" ] parse conn = do sh@(StatusHeaders status _ _) <- parseStatusHeaders conn Nothing Nothing unless (status == status200) $ throwIO $ ProxyConnectException ultHost ultPort $ Right $ StatusCodeException status [] (CJ []) in mTlsProxyConnection m connstr parse (S8.unpack ultHost) -- | Get the proxy settings from the @Request@ itself. -- -- Since 0.4.7 proxyFromRequest :: ProxyOverride proxyFromRequest = ProxyOverride $ const $ return id -- | Never connect using a proxy, regardless of the proxy value in the @Request@. -- -- Since 0.4.7 noProxy :: ProxyOverride noProxy = ProxyOverride $ const $ return $ \req -> req { proxy = Nothing } -- | Use the given proxy settings, regardless of the proxy value in the @Request@. -- -- Since 0.4.7 useProxy :: Proxy -> ProxyOverride useProxy p = ProxyOverride $ const $ return $ \req -> req { proxy = Just p } -- | Get the proxy settings from the default environment variable (@http_proxy@ -- for insecure, @https_proxy@ for secure). If no variable is set, then fall -- back to the given value. @Nothing@ is equivalent to 'noProxy', @Just@ is -- equivalent to 'useProxy'. -- -- Since 0.4.7 proxyEnvironment :: Maybe Proxy -- ^ fallback if no environment set -> ProxyOverride proxyEnvironment mp = ProxyOverride $ \secure -> envHelper (envName secure) $ maybe EHNoProxy EHUseProxy mp envName :: Bool -- ^ secure? -> Text envName False = "http_proxy" envName True = "https_proxy" -- | Same as 'proxyEnvironment', but instead of default environment variable -- names, allows you to set your own name. -- -- Since 0.4.7 proxyEnvironmentNamed :: Text -- ^ environment variable name -> Maybe Proxy -- ^ fallback if no environment set -> ProxyOverride proxyEnvironmentNamed name = ProxyOverride . const . envHelper name . maybe EHNoProxy EHUseProxy -- | The default proxy settings for a manager. In particular: if the @http_proxy@ (or @https_proxy@) environment variable is set, use it. Otherwise, use the values in the @Request@. -- -- Since 0.4.7 defaultProxy :: ProxyOverride defaultProxy = ProxyOverride $ \secure -> envHelper (envName secure) EHFromRequest data EnvHelper = EHFromRequest | EHNoProxy | EHUseProxy Proxy envHelper :: Text -> EnvHelper -> IO (Request -> Request) envHelper name eh = do env <- getEnvironment let lenv = Map.fromList $ map (first $ T.toLower . T.pack) env lookupEnvVar n = lookup (T.unpack n) env <|> Map.lookup n lenv noProxyDomains = domainSuffixes (lookupEnvVar "no_proxy") case lookupEnvVar name of Nothing -> return noEnvProxy Just "" -> return noEnvProxy Just str -> do let invalid = throwIO $ InvalidProxyEnvironmentVariable name (T.pack str) (p, muserpass) <- maybe invalid return $ do uri <- case U.parseURI str of Just u | U.uriScheme u == "http:" -> return u _ -> U.parseURI $ "http://" ++ str guard $ U.uriScheme uri == "http:" guard $ null (U.uriPath uri) || U.uriPath uri == "/" guard $ null $ U.uriQuery uri guard $ null $ U.uriFragment uri auth <- U.uriAuthority uri let muserpass = if null authInfo then Nothing else Just ( S8.pack $ username authInfo , S8.pack $ password authInfo ) authInfo = U.uriUserInfo auth port <- case U.uriPort auth of "" -> Just 80 ':':rest -> case decimal $ T.pack rest of Right (p, "") -> Just p _ -> Nothing _ -> Nothing Just $ (Proxy (S8.pack $ U.uriRegName auth) port, muserpass) return $ \req -> if host req `hasDomainSuffixIn` noProxyDomains then noEnvProxy req else maybe id (uncurry applyBasicProxyAuth) muserpass req { proxy = Just p } where noEnvProxy = case eh of EHFromRequest -> id EHNoProxy -> \req -> req { proxy = Nothing } EHUseProxy p -> \req -> req { proxy = Just p } prefixed s | S8.head s == '.' = s | otherwise = S8.cons '.' s domainSuffixes Nothing = [] domainSuffixes (Just "") = [] domainSuffixes (Just no_proxy) = [prefixed $ S8.dropWhile (== ' ') suffix | suffix <- S8.split ',' (S8.pack (map toLower no_proxy)), not (S8.null suffix)] hasDomainSuffixIn host = any (`S8.isSuffixOf` prefixed (S8.map toLower host)) http-client-0.4.26.2/Network/HTTP/Client/MultipartFormData.hs0000644000000000000000000002517312636306172021763 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} -- | This module handles building multipart/form-data. Example usage: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > import Network -- > import Network.HTTP.Client -- > import Network.HTTP.Client.MultipartFormData -- > -- > import Data.Text.Encoding as TE -- > -- > import Control.Monad -- > -- > main = withSocketsDo $ void $ withManager defaultManagerSettings $ \m -> do -- > req1 <- parseUrl "http://random-cat-photo.net/cat.jpg" -- > res <- httpLbs req1 m -- > req2 <- parseUrl "http://example.org/~friedrich/blog/addPost.hs" -- > flip httpLbs m =<< -- > (formDataBody [partBS "title" "Bleaurgh" -- > ,partBS "text" $ TE.encodeUtf8 "矢田矢田矢田矢田矢田" -- > ,partFileSource "file1" "/home/friedrich/Photos/MyLittlePony.jpg" -- > ,partFileRequestBody "file2" "cat.jpg" $ RequestBodyLBS $ responseBody res] -- > req2) module Network.HTTP.Client.MultipartFormData ( -- * Part type Part ,partName ,partFilename ,partContentType ,partHeaders ,partGetBody -- * Constructing parts ,partBS ,partLBS ,partFile ,partFileSource ,partFileSourceChunked ,partFileRequestBody ,partFileRequestBodyM -- * Headers ,addPartHeaders -- * Building form data ,formDataBody ,formDataBodyWithBoundary -- * Boundary ,webkitBoundary ,webkitBoundaryPure -- * Misc ,renderParts ,renderPart ) where import Network.HTTP.Client hiding (streamFile) import Network.Mime import Network.HTTP.Types (hContentType, methodPost, Header()) import Data.Monoid ((<>)) import Data.Foldable (foldMap) import Blaze.ByteString.Builder import Data.Text import qualified Data.Text.Encoding as TE import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import qualified Data.CaseInsensitive as CI import Control.Monad.Trans.State.Strict (state, runState) import Control.Monad.IO.Class import System.FilePath import System.Random import Data.Array.Base import System.IO import Data.Bits import Data.Word import Data.Monoid (Monoid(..)) import Control.Monad import Data.ByteString.Lazy.Internal (defaultChunkSize) -- | A single part of a multipart message. data Part = Part { partName :: Text -- ^ Name of the corresponding \ , partFilename :: Maybe String -- ^ A file name, if this is an attached file , partContentType :: Maybe MimeType -- ^ Content type , partHeaders :: [Header] -- ^ List of additional headers , partGetBody :: IO RequestBody -- ^ Action in m which returns the body -- of a message. } instance Show Part where showsPrec d (Part n f c h _) = showParen (d>=11) $ showString "Part " . showsPrec 11 n . showString " " . showsPrec 11 f . showString " " . showsPrec 11 c . showString " " . showsPrec 11 h . showString " " . showString "" -- | Make a 'Part' whose content is a strict 'BS.ByteString'. -- -- The 'Part' does not have a file name or content type associated -- with it. partBS :: Text -- ^ Name of the corresponding \. -> BS.ByteString -- ^ The body for this 'Part'. -> Part partBS n b = Part n mempty mempty mempty $ return $ RequestBodyBS b -- | Make a 'Part' whose content is a lazy 'BL.ByteString'. -- -- The 'Part' does not have a file name or content type associated -- with it. partLBS :: Text -- ^ Name of the corresponding \. -> BL.ByteString -- ^ The body for this 'Part'. -> Part partLBS n b = Part n mempty mempty mempty $ return $ RequestBodyLBS b -- | Make a 'Part' from a file. -- -- The entire file will reside in memory at once. If you want -- constant memory usage, use 'partFileSource'. -- -- The 'FilePath' supplied will be used as the file name of the -- 'Part'. If you do not want to reveal this name to the server, you -- must remove it prior to uploading. -- -- The 'Part' does not have a content type associated with it. partFile :: Text -- ^ Name of the corresponding \. -> FilePath -- ^ The name of the local file to upload. -> Part partFile n f = partFileRequestBodyM n f $ do liftM RequestBodyBS $ liftIO $ BS.readFile f -- | Stream a 'Part' from a file. -- -- The 'FilePath' supplied will be used as the file name of the -- 'Part'. If you do not want to reveal this name to the server, you -- must remove it prior to uploading. -- -- The 'Part' does not have a content type associated with it. partFileSource :: Text -- ^ Name of the corresponding \. -> FilePath -- ^ The name of the local file to upload. -> Part partFileSource n f = partFileRequestBodyM n f $ do size <- liftIO $ withBinaryFile f ReadMode hFileSize return $ RequestBodyStream (fromInteger size) $ streamFile f streamFile :: FilePath -> GivesPopper () streamFile fp np = withFile fp ReadMode $ np . go where go h = BS.hGetSome h defaultChunkSize -- | 'partFileSourceChunked' will read a file and send it in chunks. -- -- Note that not all servers support this. Only use 'partFileSourceChunked' -- if you know the server you're sending to supports chunked request bodies. -- -- The 'FilePath' supplied will be used as the file name of the -- 'Part'. If you do not want to reveal this name to the server, you -- must remove it prior to uploading. -- -- The 'Part' does not have a content type associated with it. partFileSourceChunked :: Text -> FilePath -> Part partFileSourceChunked n f = partFileRequestBody n f $ do RequestBodyStreamChunked $ streamFile f -- | Construct a 'Part' from form name, filepath and a 'RequestBody' -- -- > partFileRequestBody "who_calls" "caller.json" $ RequestBodyBS "{\"caller\":\"Jason J Jason\"}" -- -- > -- empty upload form -- > partFileRequestBody "file" mempty mempty -- -- The 'Part' does not have a content type associated with it. partFileRequestBody :: Text -- ^ Name of the corresponding \. -> FilePath -- ^ File name to supply to the server. -> RequestBody -- ^ Data to upload. -> Part partFileRequestBody n f rqb = partFileRequestBodyM n f $ return rqb -- | Construct a 'Part' from action returning the 'RequestBody' -- -- > partFileRequestBodyM "cat_photo" "haskell-the-cat.jpg" $ do -- > size <- fromInteger <$> withBinaryFile "haskell-the-cat.jpg" ReadMode hFileSize -- > return $ RequestBodySource size $ CB.sourceFile "haskell-the-cat.jpg" $= CL.map fromByteString -- -- The 'Part' does not have a content type associated with it. partFileRequestBodyM :: Text -- ^ Name of the corresponding \. -> FilePath -- ^ File name to supply to the server. -> IO RequestBody -- ^ Action that will supply data to upload. -> Part partFileRequestBodyM n f rqb = Part n (Just f) (Just $ defaultMimeLookup $ pack f) mempty rqb {-# INLINE cp #-} cp :: BS.ByteString -> RequestBody cp bs = RequestBodyBuilder (fromIntegral $ BS.length bs) $ copyByteString bs -- | Add a list of additional headers to this 'Part'. addPartHeaders :: Part -> [Header] -> Part addPartHeaders p hs = p { partHeaders = partHeaders p <> hs } renderPart :: BS.ByteString -- ^ Boundary between parts. -> Part -> IO RequestBody renderPart boundary (Part name mfilename mcontenttype hdrs get) = liftM render get where render renderBody = cp "--" <> cp boundary <> cp "\r\n" <> cp "Content-Disposition: form-data; name=\"" <> RequestBodyBS (TE.encodeUtf8 name) <> (case mfilename of Just f -> cp "\"; filename=\"" <> RequestBodyBS (TE.encodeUtf8 $ pack $ takeFileName f) _ -> mempty) <> cp "\"" <> (case mcontenttype of Just ct -> cp "\r\n" <> cp "Content-Type: " <> cp ct _ -> mempty) <> foldMap (\(k, v) -> cp "\r\n" <> cp (CI.original k) <> cp ": " <> cp v) hdrs <> cp "\r\n\r\n" <> renderBody <> cp "\r\n" -- | Combine the 'Part's to form multipart/form-data body renderParts :: BS.ByteString -- ^ Boundary between parts. -> [Part] -> IO RequestBody renderParts boundary parts = (fin . mconcat) `liftM` mapM (renderPart boundary) parts where fin = (<> cp "--" <> cp boundary <> cp "--\r\n") -- | Generate a boundary simillar to those generated by WebKit-based browsers. webkitBoundary :: IO BS.ByteString webkitBoundary = getStdRandom webkitBoundaryPure webkitBoundaryPure :: RandomGen g => g -> (BS.ByteString, g) webkitBoundaryPure g = (`runState` g) $ do fmap (BS.append prefix . BS.pack . Prelude.concat) $ replicateM 4 $ do randomness <- state $ random return [unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 24 .&. 0x3F ,unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 16 .&. 0x3F ,unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 8 .&. 0x3F ,unsafeAt alphaNumericEncodingMap $ randomness .&. 0x3F] where prefix = "----WebKitFormBoundary" alphaNumericEncodingMap :: UArray Int Word8 alphaNumericEncodingMap = listArray (0, 63) [0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x41, 0x42] -- | Add form data to the 'Request'. -- -- This sets a new 'requestBody', adds a content-type request header and changes the method to POST. formDataBody :: MonadIO m => [Part] -> Request -> m Request formDataBody a b = liftIO $ do boundary <- webkitBoundary formDataBodyWithBoundary boundary a b -- | Add form data with supplied boundary formDataBodyWithBoundary :: BS.ByteString -> [Part] -> Request -> IO Request formDataBodyWithBoundary boundary parts req = do body <- renderParts boundary parts return $ req { method = methodPost , requestHeaders = (hContentType, "multipart/form-data; boundary=" <> boundary) : Prelude.filter (\(x, _) -> x /= hContentType) (requestHeaders req) , requestBody = body } http-client-0.4.26.2/Network/HTTP/Client/Request.hs0000644000000000000000000004275412636306172020020 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Network.HTTP.Client.Request ( parseUrl , setUriRelative , getUri , setUri , browserDecompress , alwaysDecompress , addProxy , applyBasicAuth , applyBasicProxyAuth , urlEncodedBody , needsGunzip , requestBuilder , useDefaultTimeout , setQueryString , streamFile , observedStreamFile , username , password ) where import Data.Int (Int64) import Data.Maybe (fromMaybe, isJust) import Data.Monoid (mempty, mappend) import Data.String (IsString(..)) import Data.Char (toLower) import Control.Applicative ((<$>)) import Control.Monad (when, unless) import Numeric (showHex) import Data.Default.Class (Default (def)) import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString, toByteStringIO, flush) import Blaze.ByteString.Builder.Char8 (fromChar, fromShow) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Internal (defaultChunkSize) import qualified Network.HTTP.Types as W import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, isAllowedInURI, isReserved) import Control.Monad.IO.Class (liftIO) import Control.Exception (Exception, toException, throw, throwIO, IOException) import qualified Control.Exception as E import qualified Data.CaseInsensitive as CI import qualified Data.ByteString.Base64 as B64 import Network.HTTP.Client.Types import Network.HTTP.Client.Util import Network.HTTP.Client.Connection import Network.HTTP.Client.Util (readDec, (<>)) import Data.Time.Clock import Control.Monad.Catch (MonadThrow, throwM) import Data.IORef import System.IO (withBinaryFile, hTell, hFileSize, Handle, IOMode (ReadMode)) -- | Convert a URL into a 'Request'. -- -- This defaults some of the values in 'Request', such as setting 'method' to -- GET and 'requestHeaders' to @[]@. -- -- Since this function uses 'MonadThrow', the return monad can be anything that is -- an instance of 'MonadThrow', such as 'IO' or 'Maybe'. -- -- Since 0.1.0 parseUrl :: MonadThrow m => String -> m Request parseUrl s = case parseURI (encode s) of Just uri -> setUri def uri Nothing -> throwM $ InvalidUrlException s "Invalid URL" where encode = escapeURIString isAllowedInURI -- | Add a 'URI' to the request. If it is absolute (includes a host name), add -- it as per 'setUri'; if it is relative, merge it with the existing request. setUriRelative :: MonadThrow m => Request -> URI -> m Request setUriRelative req uri = #ifndef MIN_VERSION_network #define MIN_VERSION_network(x,y,z) 1 #endif #if MIN_VERSION_network(2,4,0) setUri req $ uri `relativeTo` getUri req #else case uri `relativeTo` getUri req of Just uri' -> setUri req uri' Nothing -> throwM $ InvalidUrlException (show uri) "Invalid URL" #endif -- | Extract a 'URI' from the request. -- -- Since 0.1.0 getUri :: Request -> URI getUri req = URI { uriScheme = if secure req then "https:" else "http:" , uriAuthority = Just URIAuth { uriUserInfo = "" , uriRegName = S8.unpack $ host req , uriPort = ':' : show (port req) } , uriPath = S8.unpack $ path req , uriQuery = case S8.uncons $ queryString req of Just (c, _) | c /= '?' -> '?' : (S8.unpack $ queryString req) _ -> S8.unpack $ queryString req , uriFragment = "" } applyAnyUriBasedAuth :: URI -> Request -> Request applyAnyUriBasedAuth uri req = if hasAuth then applyBasicAuth (S8.pack theuser) (S8.pack thepass) req else req where hasAuth = (notEmpty theuser) && (notEmpty thepass) notEmpty = not . null theuser = username authInfo thepass = password authInfo authInfo = maybe "" uriUserInfo $ uriAuthority uri username :: String -> String username = encode . takeWhile (/=':') . authPrefix password :: String -> String password = encode . takeWhile (/='@') . drop 1 . dropWhile (/=':') encode :: String -> String encode = escapeURIString (not . isReserved) authPrefix :: String -> String authPrefix u = if '@' `elem` u then takeWhile (/= '@') u else "" -- | Validate a 'URI', then add it to the request. setUri :: MonadThrow m => Request -> URI -> m Request setUri req uri = do sec <- parseScheme uri auth <- maybe (failUri "URL must be absolute") return $ uriAuthority uri port' <- parsePort sec auth return $ applyAnyUriBasedAuth uri req { host = S8.pack $ uriRegName auth , port = port' , secure = sec , path = S8.pack $ if null $ uriPath uri then "/" else uriPath uri , queryString = S8.pack $ uriQuery uri } where failUri :: MonadThrow m => String -> m a failUri = throwM . InvalidUrlException (show uri) parseScheme URI{uriScheme = scheme} = case map toLower scheme of "http:" -> return False "https:" -> return True _ -> failUri "Invalid scheme" parsePort sec URIAuth{uriPort = portStr} = case portStr of -- If the user specifies a port, then use it ':':rest -> maybe (failUri "Invalid port") return (readDec rest) -- Otherwise, use the default port _ -> case sec of False {- HTTP -} -> return 80 True {- HTTPS -} -> return 443 instance Show Request where show x = unlines [ "Request {" , " host = " ++ show (host x) , " port = " ++ show (port x) , " secure = " ++ show (secure x) , " requestHeaders = " ++ show (requestHeaders x) , " path = " ++ show (path x) , " queryString = " ++ show (queryString x) --, " requestBody = " ++ show (requestBody x) , " method = " ++ show (method x) , " proxy = " ++ show (proxy x) , " rawBody = " ++ show (rawBody x) , " redirectCount = " ++ show (redirectCount x) , " responseTimeout = " ++ show (responseTimeout x) , " requestVersion = " ++ show (requestVersion x) , "}" ] -- | Magic value to be placed in a 'Request' to indicate that we should use the -- timeout value in the @Manager@. -- -- Since 1.9.3 useDefaultTimeout :: Maybe Int useDefaultTimeout = Just (-3425) instance Default Request where def = Request { host = "localhost" , port = 80 , secure = False , requestHeaders = [] , path = "/" , queryString = S8.empty , requestBody = RequestBodyLBS L.empty , method = "GET" , proxy = Nothing , hostAddress = Nothing , rawBody = False , decompress = browserDecompress , redirectCount = 10 , checkStatus = \s@(W.Status sci _) hs cookie_jar -> if 200 <= sci && sci < 300 then Nothing else Just $ toException $ StatusCodeException s hs cookie_jar , responseTimeout = useDefaultTimeout , getConnectionWrapper = \mtimeout exc f -> case mtimeout of Nothing -> fmap ((,) Nothing) f Just timeout' -> do before <- getCurrentTime mres <- timeout timeout' f case mres of Nothing -> throwIO exc Just res -> do now <- getCurrentTime let timeSpentMicro = diffUTCTime now before * 1000000 remainingTime = round $ fromIntegral timeout' - timeSpentMicro if remainingTime <= 0 then throwIO exc else return (Just remainingTime, res) , cookieJar = Just def , requestVersion = W.http11 , onRequestBodyException = \se -> case E.fromException se of Just (_ :: IOException) -> return () Nothing -> throwIO se } instance IsString Request where fromString s = case parseUrl s of Left e -> throw e Right r -> r -- | Always decompress a compressed stream. alwaysDecompress :: S.ByteString -> Bool alwaysDecompress = const True -- | Decompress a compressed stream unless the content-type is 'application/x-tar'. browserDecompress :: S.ByteString -> Bool browserDecompress = (/= "application/x-tar") -- | Add a Basic Auth header (with the specified user name and password) to the -- given Request. Ignore error handling: -- -- > applyBasicAuth "user" "pass" $ fromJust $ parseUrl url -- -- Since 0.1.0 applyBasicAuth :: S.ByteString -> S.ByteString -> Request -> Request applyBasicAuth user passwd req = req { requestHeaders = authHeader : requestHeaders req } where authHeader = (CI.mk "Authorization", basic) basic = S8.append "Basic " (B64.encode $ S8.concat [ user, ":", passwd ]) -- | Add a proxy to the Request so that the Request when executed will use -- the provided proxy. -- -- Since 0.1.0 addProxy :: S.ByteString -> Int -> Request -> Request addProxy hst prt req = req { proxy = Just $ Proxy hst prt } -- | Add a Proxy-Authorization header (with the specified username and -- password) to the given 'Request'. Ignore error handling: -- -- > applyBasicProxyAuth "user" "pass" <$> parseUrl "http://example.org" -- -- Since 0.3.4 applyBasicProxyAuth :: S.ByteString -> S.ByteString -> Request -> Request applyBasicProxyAuth user passwd req = req { requestHeaders = authHeader : requestHeaders req } where authHeader = (CI.mk "Proxy-Authorization", basic) basic = S8.append "Basic " (B64.encode $ S8.concat [ user , ":", passwd ]) -- | Add url-encoded parameters to the 'Request'. -- -- This sets a new 'requestBody', adds a content-type request header and -- changes the 'method' to POST. -- -- Since 0.1.0 urlEncodedBody :: [(S.ByteString, S.ByteString)] -> Request -> Request urlEncodedBody headers req = req { requestBody = RequestBodyLBS body , method = "POST" , requestHeaders = (ct, "application/x-www-form-urlencoded") : filter (\(x, _) -> x /= ct) (requestHeaders req) } where ct = "Content-Type" body = L.fromChunks . return $ W.renderSimpleQuery False headers needsGunzip :: Request -> [W.Header] -- ^ response headers -> Bool needsGunzip req hs' = not (rawBody req) && ("content-encoding", "gzip") `elem` hs' && decompress req (fromMaybe "" $ lookup "content-type" hs') requestBuilder :: Request -> Connection -> IO (Maybe (IO ())) requestBuilder req Connection {..} | expectContinue = flushHeaders >> return (Just (checkBadSend sendLater)) | otherwise = sendNow >> return Nothing where expectContinue = Just "100-continue" == lookup "Expect" (requestHeaders req) checkBadSend f = f `E.catch` onRequestBodyException req writeBuilder = toByteStringIO connectionWrite writeHeadersWith = writeBuilder . (builder `mappend`) flushHeaders = writeHeadersWith flush (contentLength, sendNow, sendLater) = case requestBody req of RequestBodyLBS lbs -> let body = fromLazyByteString lbs now = checkBadSend $ writeHeadersWith body later = writeBuilder body in (Just (L.length lbs), now, later) RequestBodyBS bs -> let body = fromByteString bs now = checkBadSend $ writeHeadersWith body later = writeBuilder body in (Just (fromIntegral $ S.length bs), now, later) RequestBodyBuilder len body -> let now = checkBadSend $ writeHeadersWith body later = writeBuilder body in (Just len, now, later) -- See https://github.com/snoyberg/http-client/issues/74 for usage -- of flush here. RequestBodyStream len stream -> let body = writeStream False stream -- Don't check for a bad send on the headers themselves. -- Ideally, we'd do the same thing for the other request body -- types, but it would also introduce a performance hit since -- we couldn't merge request headers and bodies together. now = flushHeaders >> checkBadSend body in (Just len, now, body) RequestBodyStreamChunked stream -> let body = writeStream True stream now = flushHeaders >> checkBadSend body in (Nothing, now, body) writeStream isChunked withStream = withStream loop where loop stream = do bs <- stream if S.null bs then when isChunked $ connectionWrite "0\r\n\r\n" else do connectionWrite $ if isChunked then S.concat [ S8.pack $ showHex (S.length bs) "\r\n" , bs , "\r\n" ] else bs loop stream hh | port req == 80 && not (secure req) = host req | port req == 443 && secure req = host req | otherwise = host req <> S8.pack (':' : show (port req)) requestProtocol | secure req = fromByteString "https://" | otherwise = fromByteString "http://" requestHostname | isJust (proxy req) && not (secure req) = requestProtocol <> fromByteString hh | otherwise = mempty contentLengthHeader (Just contentLength') = if method req `elem` ["GET", "HEAD"] && contentLength' == 0 then id else (:) ("Content-Length", S8.pack $ show contentLength') contentLengthHeader Nothing = (:) ("Transfer-Encoding", "chunked") acceptEncodingHeader = case lookup "Accept-Encoding" $ requestHeaders req of Nothing -> (("Accept-Encoding", "gzip"):) Just "" -> filter (\(k, _) -> k /= "Accept-Encoding") Just _ -> id hostHeader x = case lookup "Host" x of Nothing -> ("Host", hh) : x Just{} -> x headerPairs :: W.RequestHeaders headerPairs = hostHeader $ acceptEncodingHeader $ contentLengthHeader contentLength $ requestHeaders req builder :: Builder builder = fromByteString (method req) <> fromByteString " " <> requestHostname <> (case S8.uncons $ path req of Just ('/', _) -> fromByteString $ path req _ -> fromChar '/' <> fromByteString (path req)) <> (case S8.uncons $ queryString req of Nothing -> mempty Just ('?', _) -> fromByteString $ queryString req _ -> fromChar '?' <> fromByteString (queryString req)) <> (case requestVersion req of W.HttpVersion 1 1 -> fromByteString " HTTP/1.1\r\n" W.HttpVersion 1 0 -> fromByteString " HTTP/1.0\r\n" version -> fromChar ' ' <> fromShow version <> fromByteString "\r\n") <> foldr (\a b -> headerPairToBuilder a <> b) (fromByteString "\r\n") headerPairs headerPairToBuilder (k, v) = fromByteString (CI.original k) <> fromByteString ": " <> fromByteString v <> fromByteString "\r\n" -- | Set the query string to the given key/value pairs. -- -- Since 0.3.6 setQueryString :: [(S.ByteString, Maybe S.ByteString)] -> Request -> Request setQueryString qs req = req { queryString = W.renderQuery True qs } -- | Send a file as the request body. -- -- It is expected that the file size does not change between calling -- `streamFile` and making any requests using this request body. -- -- Since 0.4.9 streamFile :: FilePath -> IO RequestBody streamFile = observedStreamFile (\_ -> return ()) -- | Send a file as the request body, while observing streaming progress via -- a `PopObserver`. Observations are made between reading and sending a chunk. -- -- It is expected that the file size does not change between calling -- `observedStreamFile` and making any requests using this request body. -- -- Since 0.4.9 observedStreamFile :: (StreamFileStatus -> IO ()) -> FilePath -> IO RequestBody observedStreamFile obs path = do size <- fromIntegral <$> withBinaryFile path ReadMode hFileSize let filePopper :: Handle -> Popper filePopper h = do bs <- S.hGetSome h defaultChunkSize currentPosition <- fromIntegral <$> hTell h obs $ StreamFileStatus { fileSize = size , readSoFar = currentPosition , thisChunkSize = S.length bs } return bs givesFilePopper :: GivesPopper () givesFilePopper k = withBinaryFile path ReadMode $ \h -> do k (filePopper h) return $ RequestBodyStream size givesFilePopper http-client-0.4.26.2/Network/HTTP/Client/Response.hs0000644000000000000000000001161212636306172020153 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Network.HTTP.Client.Response ( getRedirectedRequest , getResponse , lbsResponse ) where import Control.Monad ((>=>), when) import Control.Exception (throwIO) import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.Default.Class (def) import Data.Maybe (isJust) import qualified Network.HTTP.Types as W import Network.URI (parseURIReference, escapeURIString, isAllowedInURI) import Network.HTTP.Client.Types import Network.HTTP.Client.Request import Network.HTTP.Client.Util import Network.HTTP.Client.Body import Network.HTTP.Client.Headers -- | If a request is a redirection (status code 3xx) this function will create -- a new request from the old request, the server headers returned with the -- redirection, and the redirection code itself. This function returns 'Nothing' -- if the code is not a 3xx, there is no 'location' header included, or if the -- redirected response couldn't be parsed with 'parseUrl'. -- -- If a user of this library wants to know the url chain that results from a -- specific request, that user has to re-implement the redirect-following logic -- themselves. An example of that might look like this: -- -- > myHttp req man = do -- > (res, redirectRequests) <- (`runStateT` []) $ -- > 'httpRedirect' -- > 9000 -- > (\req' -> do -- > res <- http req'{redirectCount=0} man -- > modify (\rqs -> req' : rqs) -- > return (res, getRedirectedRequest req' (responseHeaders res) (responseCookieJar res) (W.statusCode (responseStatus res)) -- > ) -- > 'lift' -- > req -- > applyCheckStatus (checkStatus req) res -- > return redirectRequests getRedirectedRequest :: Request -> W.ResponseHeaders -> CookieJar -> Int -> Maybe Request getRedirectedRequest req hs cookie_jar code | 300 <= code && code < 400 = do l' <- lookup "location" hs let l = escapeURIString isAllowedInURI (S8.unpack l') req' <- setUriRelative req =<< parseURIReference l return $ if code == 302 || code == 303 -- According to the spec, this should *only* be for status code -- 303. However, almost all clients mistakenly implement it for -- 302 as well. So we have to be wrong like everyone else... then req' { method = "GET" , requestBody = RequestBodyBS "" , cookieJar = cookie_jar' , requestHeaders = filter ((/= W.hContentType) . fst) $ requestHeaders req' } else req' {cookieJar = cookie_jar'} | otherwise = Nothing where cookie_jar' = fmap (const cookie_jar) $ cookieJar req -- | Convert a 'Response' that has a 'Source' body to one with a lazy -- 'L.ByteString' body. lbsResponse :: Response BodyReader -> IO (Response L.ByteString) lbsResponse res = do bss <- brConsume $ responseBody res return res { responseBody = L.fromChunks bss } getResponse :: ConnRelease -> Maybe Int -> Request -> Connection -> Maybe (IO ()) -- ^ Action to run in case of a '100 Continue'. -> IO (Response BodyReader) getResponse connRelease timeout' req@(Request {..}) conn cont = do StatusHeaders s version hs <- parseStatusHeaders conn timeout' cont let mcl = lookup "content-length" hs >>= readDec . S8.unpack isChunked = ("transfer-encoding", "chunked") `elem` hs -- should we put this connection back into the connection manager? toPut = Just "close" /= lookup "connection" hs && version > W.HttpVersion 1 0 cleanup bodyConsumed = connRelease $ if toPut && bodyConsumed then Reuse else DontReuse body <- -- RFC 2616 section 4.4_1 defines responses that must not include a body if hasNoBody method (W.statusCode s) || (mcl == Just 0 && not isChunked) then do cleanup True return brEmpty else do body1 <- if isChunked then makeChunkedReader rawBody conn else case mcl of Just len -> makeLengthReader len conn Nothing -> makeUnlimitedReader conn body2 <- if needsGunzip req hs then makeGzipReader body1 else return body1 return $ brAddCleanup (cleanup True) body2 return Response { responseStatus = s , responseVersion = version , responseHeaders = hs , responseBody = body , responseCookieJar = def , responseClose' = ResponseClose (cleanup False) } http-client-0.4.26.2/Network/HTTP/Client/Types.hs0000644000000000000000000005660212636306172017471 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE RankNTypes #-} module Network.HTTP.Client.Types ( BodyReader , Connection (..) , StatusHeaders (..) , ConnectionClosed (..) , HttpException (..) , Cookie (..) , CookieJar (..) , Proxy (..) , RequestBody (..) , Popper , NeedsPopper , GivesPopper , Request (..) , ConnReuse (..) , ConnRelease , ManagedConn (..) , Response (..) , ResponseClose (..) , Manager (..) , HasHttpManager (..) , ConnsMap (..) , ManagerSettings (..) , NonEmptyList (..) , ConnHost (..) , ConnKey (..) , ProxyOverride (..) , StreamFileStatus (..) ) where import qualified Data.Typeable as T (Typeable) import Network.HTTP.Types import Control.Exception (Exception, IOException, SomeException) import Data.Word (Word64) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Blaze.ByteString.Builder (Builder, fromLazyByteString, fromByteString, toLazyByteString) import Data.Int (Int64) import Data.Default.Class import Data.Foldable (Foldable) import Data.Monoid import Data.String (IsString, fromString) import Data.Time (UTCTime) import Data.Traversable (Traversable) import qualified Data.List as DL import Network.Socket (HostAddress) import Data.IORef import qualified Network.Socket as NS import qualified Data.IORef as I import qualified Data.Map as Map import Data.Text (Text) import Data.Streaming.Zlib (ZlibException) import Control.Concurrent.MVar (MVar) import Data.CaseInsensitive as CI -- | An @IO@ action that represents an incoming response body coming from the -- server. Data provided by this action has already been gunzipped and -- de-chunked, and respects any content-length headers present. -- -- The action gets a single chunk of data from the response body, or an empty -- bytestring if no more data is available. -- -- Since 0.4.0 type BodyReader = IO S.ByteString data Connection = Connection { connectionRead :: IO S.ByteString -- ^ If no more data, return empty. , connectionUnread :: S.ByteString -> IO () -- ^ Return data to be read next time. , connectionWrite :: S.ByteString -> IO () -- ^ Send data to server , connectionClose :: IO () -- ^ Close connection. Any successive operation on the connection -- (exept closing) should fail with `ConnectionClosed` exception. -- It is allowed to close connection multiple times. } deriving T.Typeable data StatusHeaders = StatusHeaders Status HttpVersion RequestHeaders deriving (Show, Eq, Ord, T.Typeable) data ConnectionClosed = ConnectionClosed deriving (Eq, Show, T.Typeable) instance Exception ConnectionClosed data HttpException = StatusCodeException Status ResponseHeaders CookieJar | InvalidUrlException String String | TooManyRedirects [Response L.ByteString] -- ^ List of encountered responses containing redirects in reverse chronological order; including last redirect, which triggered the exception and was not followed. | UnparseableRedirect (Response L.ByteString) -- ^ Response containing unparseable redirect. | TooManyRetries | HttpParserException String | HandshakeFailed | OverlongHeaders | ResponseTimeout | FailedConnectionException String Int -- ^ host/port -- -- Note that in old versions of http-client and -- http-conduit, this exception would indicate a failed -- attempt to create a connection. However, since (at least) -- http-client 0.4, it indicates a timeout occurred while -- trying to establish the connection. For more information -- on this, see: -- -- | FailedConnectionException2 String Int Bool SomeException -- ^ host\/port\/secure | ExpectedBlankAfter100Continue | InvalidStatusLine S.ByteString | InvalidHeader S.ByteString | InternalIOException IOException | ProxyConnectException S.ByteString Int (Either S.ByteString HttpException) -- ^ host/port | NoResponseDataReceived | TlsException SomeException | TlsNotSupported | ResponseBodyTooShort Word64 Word64 -- ^ Expected size/actual size. -- -- Since 1.9.4 | InvalidChunkHeaders -- ^ -- -- Since 1.9.4 | IncompleteHeaders | InvalidDestinationHost S.ByteString | HttpZlibException ZlibException -- ^ -- -- Since 0.3 | InvalidProxyEnvironmentVariable Text Text -- ^ Environment name and value -- -- Since 0.4.7 | ResponseLengthAndChunkingBothUsed -- ^ Detect a case where both the @content-length@ header -- and @transfer-encoding: chunked@ are used. Since 0.4.8. -- -- Since 0.4.11 this exception isn't thrown anymore. | TlsExceptionHostPort SomeException S.ByteString Int -- ^ TLS exception, together with the host and port -- -- @since 0.4.24 deriving (Show, T.Typeable) instance Exception HttpException -- This corresponds to the description of a cookie detailed in Section 5.3 \"Storage Model\" data Cookie = Cookie { cookie_name :: S.ByteString , cookie_value :: S.ByteString , cookie_expiry_time :: UTCTime , cookie_domain :: S.ByteString , cookie_path :: S.ByteString , cookie_creation_time :: UTCTime , cookie_last_access_time :: UTCTime , cookie_persistent :: Bool , cookie_host_only :: Bool , cookie_secure_only :: Bool , cookie_http_only :: Bool } deriving (Read, Show, T.Typeable) newtype CookieJar = CJ { expose :: [Cookie] } deriving (Read, Show, T.Typeable) -- This corresponds to step 11 of the algorithm described in Section 5.3 \"Storage Model\" instance Eq Cookie where (==) a b = name_matches && domain_matches && path_matches where name_matches = cookie_name a == cookie_name b domain_matches = CI.foldCase (cookie_domain a) == CI.foldCase (cookie_domain b) path_matches = cookie_path a == cookie_path b instance Ord Cookie where compare c1 c2 | S.length (cookie_path c1) > S.length (cookie_path c2) = LT | S.length (cookie_path c1) < S.length (cookie_path c2) = GT | cookie_creation_time c1 > cookie_creation_time c2 = GT | otherwise = LT instance Default CookieJar where def = CJ [] instance Eq CookieJar where (==) cj1 cj2 = (DL.sort $ expose cj1) == (DL.sort $ expose cj2) -- | Since 1.9 instance Monoid CookieJar where mempty = def (CJ a) `mappend` (CJ b) = CJ (DL.nub $ DL.sortBy compare' $ a `mappend` b) where compare' c1 c2 = -- inverse so that recent cookies are kept by nub over older if cookie_creation_time c1 > cookie_creation_time c2 then LT else GT -- | Define a HTTP proxy, consisting of a hostname and port number. data Proxy = Proxy { proxyHost :: S.ByteString -- ^ The host name of the HTTP proxy. , proxyPort :: Int -- ^ The port number of the HTTP proxy. } deriving (Show, Read, Eq, Ord, T.Typeable) -- | When using one of the 'RequestBodyStream' \/ 'RequestBodyStreamChunked' -- constructors, you must ensure that the 'GivesPopper' can be called multiple -- times. Usually this is not a problem. -- -- The 'RequestBodyStreamChunked' will send a chunked request body. Note that -- not all servers support this. Only use 'RequestBodyStreamChunked' if you -- know the server you're sending to supports chunked request bodies. -- -- Since 0.1.0 data RequestBody = RequestBodyLBS L.ByteString | RequestBodyBS S.ByteString | RequestBodyBuilder Int64 Builder | RequestBodyStream Int64 (GivesPopper ()) | RequestBodyStreamChunked (GivesPopper ()) deriving T.Typeable -- | -- -- Since 0.4.12 instance IsString RequestBody where fromString str = RequestBodyBS (fromString str) instance Monoid RequestBody where mempty = RequestBodyBS S.empty mappend x0 y0 = case (simplify x0, simplify y0) of (Left (i, x), Left (j, y)) -> RequestBodyBuilder (i + j) (x `mappend` y) (Left x, Right y) -> combine (builderToStream x) y (Right x, Left y) -> combine x (builderToStream y) (Right x, Right y) -> combine x y where combine (Just i, x) (Just j, y) = RequestBodyStream (i + j) (combine' x y) combine (_, x) (_, y) = RequestBodyStreamChunked (combine' x y) combine' :: GivesPopper () -> GivesPopper () -> GivesPopper () combine' x y f = x $ \x' -> y $ \y' -> combine'' x' y' f combine'' :: Popper -> Popper -> NeedsPopper () -> IO () combine'' x y f = do istate <- newIORef $ Left (x, y) f $ go istate go istate = do state <- readIORef istate case state of Left (x, y) -> do bs <- x if S.null bs then do writeIORef istate $ Right y y else return bs Right y -> y simplify :: RequestBody -> Either (Int64, Builder) (Maybe Int64, GivesPopper ()) simplify (RequestBodyLBS lbs) = Left (L.length lbs, fromLazyByteString lbs) simplify (RequestBodyBS bs) = Left (fromIntegral $ S.length bs, fromByteString bs) simplify (RequestBodyBuilder len b) = Left (len, b) simplify (RequestBodyStream i gp) = Right (Just i, gp) simplify (RequestBodyStreamChunked gp) = Right (Nothing, gp) builderToStream :: (Int64, Builder) -> (Maybe Int64, GivesPopper ()) builderToStream (len, builder) = (Just len, gp) where gp np = do ibss <- newIORef $ L.toChunks $ toLazyByteString builder np $ do bss <- readIORef ibss case bss of [] -> return S.empty bs:bss' -> do writeIORef ibss bss' return bs -- | A function which generates successive chunks of a request body, provider a -- single empty bytestring when no more data is available. -- -- Since 0.1.0 type Popper = IO S.ByteString -- | A function which must be provided with a 'Popper'. -- -- Since 0.1.0 type NeedsPopper a = Popper -> IO a -- | A function which will provide a 'Popper' to a 'NeedsPopper'. This -- seemingly convoluted structure allows for creation of request bodies which -- allocate scarce resources in an exception safe manner. -- -- Since 0.1.0 type GivesPopper a = NeedsPopper a -> IO a -- | All information on how to connect to a host and what should be sent in the -- HTTP request. -- -- If you simply wish to download from a URL, see 'parseUrl'. -- -- The constructor for this data type is not exposed. Instead, you should use -- either the 'def' method to retrieve a default instance, or 'parseUrl' to -- construct from a URL, and then use the records below to make modifications. -- This approach allows http-client to add configuration options without -- breaking backwards compatibility. -- -- For example, to construct a POST request, you could do something like: -- -- > initReq <- parseUrl "http://www.example.com/path" -- > let req = initReq -- > { method = "POST" -- > } -- -- For more information, please see -- . -- -- Since 0.1.0 data Request = Request { method :: Method -- ^ HTTP request method, eg GET, POST. -- -- Since 0.1.0 , secure :: Bool -- ^ Whether to use HTTPS (ie, SSL). -- -- Since 0.1.0 , host :: S.ByteString -- ^ Requested host name, used for both the IP address to connect to and -- the @host@ request header. -- -- Since 0.1.0 , port :: Int -- ^ The port to connect to. Also used for generating the @host@ request header. -- -- Since 0.1.0 , path :: S.ByteString -- ^ Everything from the host to the query string. -- -- Since 0.1.0 , queryString :: S.ByteString -- ^ Query string appended to the path. -- -- Since 0.1.0 , requestHeaders :: RequestHeaders -- ^ Custom HTTP request headers -- -- The Content-Length and Transfer-Encoding headers are set automatically -- by this module, and shall not be added to @requestHeaders@. -- -- If not provided by the user, @Host@ will automatically be set based on -- the @host@ and @port@ fields. -- -- Moreover, the Accept-Encoding header is set implicitly to gzip for -- convenience by default. This behaviour can be overridden if needed, by -- setting the header explicitly to a different value. In order to omit the -- Accept-Header altogether, set it to the empty string \"\". If you need an -- empty Accept-Header (i.e. requesting the identity encoding), set it to a -- non-empty white-space string, e.g. \" \". See RFC 2616 section 14.3 for -- details about the semantics of the Accept-Header field. If you request a -- content-encoding not supported by this module, you will have to decode -- it yourself (see also the 'decompress' field). -- -- Note: Multiple header fields with the same field-name will result in -- multiple header fields being sent and therefore it\'s the responsibility -- of the client code to ensure that the rules from RFC 2616 section 4.2 -- are honoured. -- -- Since 0.1.0 , requestBody :: RequestBody -- ^ Request body to be sent to the server. -- -- Since 0.1.0 , proxy :: Maybe Proxy -- ^ Optional HTTP proxy. -- -- Since 0.1.0 , hostAddress :: Maybe HostAddress -- ^ Optional resolved host address. May not be used by all backends. -- -- Since 0.1.0 , rawBody :: Bool -- ^ If @True@, a chunked and\/or gzipped body will not be -- decoded. Use with caution. -- -- Since 0.1.0 , decompress :: S.ByteString -> Bool -- ^ Predicate to specify whether gzipped data should be -- decompressed on the fly (see 'alwaysDecompress' and -- 'browserDecompress'). Argument is the mime type. -- Default: browserDecompress. -- -- Since 0.1.0 , redirectCount :: Int -- ^ How many redirects to follow when getting a resource. 0 means follow -- no redirects. Default value: 10. -- -- Since 0.1.0 , checkStatus :: Status -> ResponseHeaders -> CookieJar -> Maybe SomeException -- ^ Check the status code. Note that this will run after all redirects are -- performed. Default: return a @StatusCodeException@ on non-2XX responses. -- -- Since 0.1.0 , responseTimeout :: Maybe Int -- ^ Number of microseconds to wait for a response. If -- @Nothing@, will wait indefinitely. Default: use -- 'managerResponseTimeout' (which by default is 30 seconds). -- -- Since 0.1.0 , getConnectionWrapper :: Maybe Int -> HttpException -> IO (ConnRelease, Connection, ManagedConn) -> IO (Maybe Int, (ConnRelease, Connection, ManagedConn)) -- ^ Wraps the calls for getting new connections. This can be useful for -- instituting some kind of timeouts. The first argument is the value of -- @responseTimeout@. Second argument is the exception to be thrown on -- failure. -- -- Default: If @responseTimeout@ is @Nothing@, does nothing. Otherwise, -- institutes timeout, and returns remaining time for @responseTimeout@. -- -- Since 0.1.0 , cookieJar :: Maybe CookieJar -- ^ A user-defined cookie jar. -- If 'Nothing', no cookie handling will take place, \"Cookie\" headers -- in 'requestHeaders' will be sent raw, and 'responseCookieJar' will be -- empty. -- -- Since 0.1.0 , requestVersion :: HttpVersion -- ^ HTTP version to send to server. -- -- Default: HTTP 1.1 -- -- Since 0.4.3 , onRequestBodyException :: SomeException -> IO () -- ^ How to deal with exceptions thrown while sending the request. -- -- Default: ignore @IOException@s, rethrow all other exceptions. -- -- Since: 0.4.6 } deriving T.Typeable data ConnReuse = Reuse | DontReuse deriving T.Typeable type ConnRelease = ConnReuse -> IO () data ManagedConn = Fresh | Reused -- | A simple representation of the HTTP response. -- -- Since 0.1.0 data Response body = Response { responseStatus :: Status -- ^ Status code of the response. -- -- Since 0.1.0 , responseVersion :: HttpVersion -- ^ HTTP version used by the server. -- -- Since 0.1.0 , responseHeaders :: ResponseHeaders -- ^ Response headers sent by the server. -- -- Since 0.1.0 , responseBody :: body -- ^ Response body sent by the server. -- -- Since 0.1.0 , responseCookieJar :: CookieJar -- ^ Cookies set on the client after interacting with the server. If -- cookies have been disabled by setting 'cookieJar' to @Nothing@, then -- this will always be empty. -- -- Since 0.1.0 , responseClose' :: ResponseClose -- ^ Releases any resource held by this response. If the response body -- has not been fully read yet, doing so after this call will likely -- be impossible. -- -- Since 0.1.0 } deriving (Show, Eq, T.Typeable, Functor, Foldable, Traversable) newtype ResponseClose = ResponseClose { runResponseClose :: IO () } deriving T.Typeable instance Show ResponseClose where show _ = "ResponseClose" instance Eq ResponseClose where _ == _ = True -- | Settings for a @Manager@. Please use the 'defaultManagerSettings' function and then modify -- individual settings. For more information, see . -- -- Since 0.1.0 data ManagerSettings = ManagerSettings { managerConnCount :: Int -- ^ Number of connections to a single host to keep alive. Default: 10. -- -- Since 0.1.0 , managerRawConnection :: IO (Maybe NS.HostAddress -> String -> Int -> IO Connection) -- ^ Create an insecure connection. -- -- Since 0.1.0 -- FIXME in the future, combine managerTlsConnection and managerTlsProxyConnection , managerTlsConnection :: IO (Maybe NS.HostAddress -> String -> Int -> IO Connection) -- ^ Create a TLS connection. Default behavior: throw an exception that TLS is not supported. -- -- Since 0.1.0 , managerTlsProxyConnection :: IO (S.ByteString -> (Connection -> IO ()) -> String -> Maybe NS.HostAddress -> String -> Int -> IO Connection) -- ^ Create a TLS proxy connection. Default behavior: throw an exception that TLS is not supported. -- -- Since 0.2.2 , managerResponseTimeout :: Maybe Int -- ^ Default timeout (in microseconds) to be applied to requests which do -- not provide a timeout value. -- -- Default is 30 seconds -- -- Since 0.1.0 , managerRetryableException :: SomeException -> Bool -- ^ Exceptions for which we should retry our request if we were reusing an -- already open connection. In the case of IOExceptions, for example, we -- assume that the connection was closed on the server and therefore open a -- new one. -- -- Since 0.1.0 , managerWrapIOException :: forall a. IO a -> IO a -- ^ Action wrapped around all attempted @Request@s, usually used to wrap -- up exceptions in library-specific types. -- -- Default: wrap all @IOException@s in the @InternalIOException@ constructor. -- -- Since 0.1.0 , managerIdleConnectionCount :: Int -- ^ Total number of idle connection to keep open at a given time. -- -- This limit helps deal with the case where you are making a large number -- of connections to different hosts. Without this limit, you could run out -- of file descriptors. -- -- Default: 512 -- -- Since 0.3.7 , managerModifyRequest :: Request -> IO Request -- ^ Perform the given modification to a @Request@ before performing it. -- -- Default: no modification -- -- Since 0.4.4 , managerProxyInsecure :: ProxyOverride -- ^ How HTTP proxy server settings should be discovered. -- -- Default: respect the @proxy@ value on the @Request@ itself. -- -- Since 0.4.7 , managerProxySecure :: ProxyOverride -- ^ How HTTPS proxy server settings should be discovered. -- -- Default: respect the @proxy@ value on the @Request@ itself. -- -- Since 0.4.7 } deriving T.Typeable -- | How the HTTP proxy server settings should be discovered. -- -- Since 0.4.7 newtype ProxyOverride = ProxyOverride { runProxyOverride :: Bool -> IO (Request -> Request) } deriving T.Typeable -- | Keeps track of open connections for keep-alive. -- -- If possible, you should share a single 'Manager' between multiple threads and requests. -- -- Since 0.1.0 data Manager = Manager { mConns :: I.IORef ConnsMap -- ^ @Nothing@ indicates that the manager is closed. , mConnsBaton :: MVar () -- ^ Used to indicate to the reaper thread that it has some work to do. -- This must be filled every time a connection is returned to the manager. -- While redundant with the @IORef@ above, this allows us to have the -- reaper thread fully blocked instead of running every 5 seconds when -- there are no connections to manage. , mMaxConns :: Int -- ^ This is a per-@ConnKey@ value. , mResponseTimeout :: Maybe Int -- ^ Copied from 'managerResponseTimeout' , mRawConnection :: Maybe NS.HostAddress -> String -> Int -> IO Connection , mTlsConnection :: Maybe NS.HostAddress -> String -> Int -> IO Connection , mTlsProxyConnection :: S.ByteString -> (Connection -> IO ()) -> String -> Maybe NS.HostAddress -> String -> Int -> IO Connection , mRetryableException :: SomeException -> Bool , mWrapIOException :: forall a. IO a -> IO a , mIdleConnectionCount :: Int , mModifyRequest :: Request -> IO Request , mSetProxy :: Request -> Request -- ^ See 'managerProxy' } deriving T.Typeable class HasHttpManager a where getHttpManager :: a -> Manager instance HasHttpManager Manager where getHttpManager = id data ConnsMap = ManagerClosed | ManagerOpen {-# UNPACK #-} !Int !(Map.Map ConnKey (NonEmptyList Connection)) data NonEmptyList a = One a UTCTime | Cons a Int UTCTime (NonEmptyList a) deriving T.Typeable -- | Hostname or resolved host address. data ConnHost = HostName Text | HostAddress NS.HostAddress deriving (Eq, Show, Ord, T.Typeable) -- | @ConnKey@ consists of a hostname, a port and a @Bool@ -- specifying whether to use SSL. data ConnKey = ConnKey ConnHost Int S.ByteString Int Bool deriving (Eq, Show, Ord, T.Typeable) -- | Status of streaming a request body from a file. -- -- Since 0.4.9 data StreamFileStatus = StreamFileStatus { fileSize :: Int64 , readSoFar :: Int64 , thisChunkSize :: Int } deriving (Eq, Show, Ord, T.Typeable) http-client-0.4.26.2/Network/HTTP/Client/Util.hs0000644000000000000000000001364612636306172017303 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Network.HTTP.Client.Util ( hGetSome , (<>) , readDec , hasNoBody , fromStrict , timeout ) where import Data.Monoid (Monoid, mappend) import qualified Data.ByteString.Char8 as S8 #ifndef MIN_VERSION_bytestring #define MIN_VERSION_bytestring(x,y,z) 1 #endif #if MIN_VERSION_bytestring(0,10,0) import Data.ByteString.Lazy (fromStrict) #else import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S #endif import qualified Data.Text as T import qualified Data.Text.Read import System.Timeout (timeout) import System.IO.Unsafe (unsafePerformIO) import Control.Exception (mask_, Exception, throwTo, try, finally, SomeException, assert) import Control.Monad (join, when, void) import Control.Concurrent (myThreadId, threadDelay, forkIO) import Data.IORef import Data.Function (fix) import Data.Typeable (Typeable) #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #if MIN_VERSION_base(4,3,0) import Data.ByteString (hGetSome) #else import GHC.IO.Handle.Types import System.IO (hWaitForInput, hIsEOF) import System.IO.Error (mkIOError, illegalOperationErrorType) -- | Like 'hGet', except that a shorter 'ByteString' may be returned -- if there are not enough bytes immediately available to satisfy the -- whole request. 'hGetSome' only blocks if there is no data -- available, and EOF has not yet been reached. hGetSome :: Handle -> Int -> IO S.ByteString hGetSome hh i | i > 0 = let loop = do s <- S.hGetNonBlocking hh i if not (S.null s) then return s else do eof <- hIsEOF hh if eof then return s else hWaitForInput hh (-1) >> loop -- for this to work correctly, the -- Handle should be in binary mode -- (see GHC ticket #3808) in loop | i == 0 = return S.empty | otherwise = illegalBufferSize hh "hGetSome" i illegalBufferSize :: Handle -> String -> Int -> IO a illegalBufferSize handle fn sz = ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing) --TODO: System.IO uses InvalidArgument here, but it's not exported :-( where msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz [] #endif infixr 5 <> (<>) :: Monoid m => m -> m -> m (<>) = mappend readDec :: Integral i => String -> Maybe i readDec s = case Data.Text.Read.decimal $ T.pack s of Right (i, t) | T.null t -> Just i _ -> Nothing hasNoBody :: S8.ByteString -- ^ request method -> Int -- ^ status code -> Bool hasNoBody "HEAD" _ = True hasNoBody _ 204 = True hasNoBody _ 304 = True hasNoBody _ i = 100 <= i && i < 200 #if !MIN_VERSION_bytestring(0,10,0) {-# INLINE fromStrict #-} fromStrict :: S.ByteString -> L.ByteString fromStrict x = L.fromChunks [x] #endif -- Disabling the custom timeout code for now. See: https://github.com/snoyberg/http-client/issues/116 {- data TimeoutHandler = TimeoutHandler {-# UNPACK #-} !TimeSpec (IO ()) newtype TimeoutManager = TimeoutManager (IORef ([TimeoutHandler], Bool)) newTimeoutManager :: IO TimeoutManager newTimeoutManager = fmap TimeoutManager $ newIORef ([], False) timeoutManager :: TimeoutManager timeoutManager = unsafePerformIO newTimeoutManager {-# NOINLINE timeoutManager #-} spawnWorker :: TimeoutManager -> IO () spawnWorker (TimeoutManager ref) = void $ forkIO $ fix $ \loop -> do threadDelay 500000 join $ atomicModifyIORef ref $ \(hs, isCleaning) -> assert (not isCleaning) $ if null hs then (([], False), return ()) else (([], True), ) $ do now <- getTime Monotonic front <- go now id hs atomicModifyIORef ref $ \(hs', isCleaning') -> assert isCleaning' $ ((front hs', False), ()) loop where go now = go' where go' front [] = return front go' front (h@(TimeoutHandler time action):hs) | time < now = do _ :: Either SomeException () <- try action go' front hs | otherwise = go' (front . (h:)) hs addHandler :: TimeoutManager -> TimeoutHandler -> IO () addHandler man@(TimeoutManager ref) h = mask_ $ join $ atomicModifyIORef ref $ \(hs, isCleaning) -> let hs' = h : hs action | isCleaning || not (null hs) = return () | otherwise = spawnWorker man in ((hs', isCleaning), action) -- | Has same semantics as @System.Timeout.timeout@, but implemented in such a -- way to avoid high-concurrency contention issues. See: -- -- https://github.com/snoyberg/http-client/issues/98 timeout :: Int -> IO a -> IO (Maybe a) timeout delayU inner = do TimeSpec nowS nowN <- getTime Monotonic let (delayS, delayU') = delayU `quotRem` 1000000 delayN = delayU' * 1000 stopN' = nowN + delayN stopS' = nowS + delayS (stopN, stopS) | stopN' > 1000000000 = (stopN' - 1000000000, stopS' + 1) | otherwise = (stopN', stopS') toStop = TimeSpec stopS stopN toThrow <- newIORef True tid <- myThreadId let handler = TimeoutHandler toStop $ do toThrow' <- readIORef toThrow when toThrow' $ throwTo tid TimeoutTriggered eres <- try $ do addHandler timeoutManager handler inner `finally` writeIORef toThrow False return $ case eres of Left TimeoutTriggered -> Nothing Right x -> Just x data TimeoutTriggered = TimeoutTriggered deriving (Show, Typeable) instance Exception TimeoutTriggered -} http-client-0.4.26.2/publicsuffixlist/0000755000000000000000000000000012636306172015771 5ustar0000000000000000http-client-0.4.26.2/publicsuffixlist/Network/0000755000000000000000000000000012636306172017422 5ustar0000000000000000http-client-0.4.26.2/publicsuffixlist/Network/PublicSuffixList/0000755000000000000000000000000012636306172022661 5ustar0000000000000000http-client-0.4.26.2/publicsuffixlist/Network/PublicSuffixList/DataStructure.hs0000644000000000000000000031615012636306172026015 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -- DO NOT MODIFY! This file has been automatically generated from the Create.hs script at 2015-04-29 04:59:31.367899 UTC module Network.PublicSuffixList.DataStructure (dataStructure) where import Data.ByteString.Char8 () import Network.PublicSuffixList.Types #if !defined(RUNTIMELIST) import qualified Data.ByteString as BS import Network.PublicSuffixList.Serialize #else import qualified Network.PublicSuffixList.Create as PSLC import qualified Data.Conduit as C import Data.Conduit.Binary (sourceFile) import System.IO.Unsafe (unsafePerformIO) #endif -- We could just put the raw data structure here, but if we do that, there will be lots of -- static string literals, which makes GHC really slow when compiling. Instead, we can manually -- serialize the datastructure ourself, so there's only one string literal. {-| The opaque data structure that 'isSuffix' can query. This data structure was generated at 2015-04-29 04:59:31.367899 UTC -} dataStructure :: DataStructure #if defined(RUNTIMELIST) {-# NOINLINE dataStructure #-} dataStructure = unsafePerformIO $ C.runResourceT $ sourceFile RUNTIMELIST C.$$ PSLC.sink #else dataStructure = getDataStructure serializedDataStructure serializedDataStructure :: BS.ByteString serializedDataStructure = "aaa\NUL\NULabb\NUL\NULabbott\NUL\NULabogado\NUL\NULac\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULacademy\NUL\NULaccenture\NUL\NULaccountant\NUL\NULaccountants\NUL\NULaco\NUL\NULactive\NUL\NULactor\NUL\NULad\NULnom\NUL\NUL\NULads\NUL\NULadult\NUL\NULae\NULac\NUL\NULblogspot\NUL\NULco\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NUL\NULaeg\NUL\NULaero\NULaccident-investigation\NUL\NULaccident-prevention\NUL\NULaerobatic\NUL\NULaeroclub\NUL\NULaerodrome\NUL\NULagents\NUL\NULair-surveillance\NUL\NULair-traffic-control\NUL\NULaircraft\NUL\NULairline\NUL\NULairport\NUL\NULairtraffic\NUL\NULambulance\NUL\NULamusement\NUL\NULassociation\NUL\NULauthor\NUL\NULballooning\NUL\NULbroker\NUL\NULcaa\NUL\NULcargo\NUL\NULcatering\NUL\NULcertification\NUL\NULchampionship\NUL\NULcharter\NUL\NULcivilaviation\NUL\NULclub\NUL\NULconference\NUL\NULconsultant\NUL\NULconsulting\NUL\NULcontrol\NUL\NULcouncil\NUL\NULcrew\NUL\NULdesign\NUL\NULdgca\NUL\NULeducator\NUL\NULemergency\NUL\NULengine\NUL\NULengineer\NUL\NULentertainment\NUL\NULequipment\NUL\NULexchange\NUL\NULexpress\NUL\NULfederation\NUL\NULflight\NUL\NULfreight\NUL\NULfuel\NUL\NULgliding\NUL\NULgovernment\NUL\NULgroundhandling\NUL\NULgroup\NUL\NULhanggliding\NUL\NULhomebuilt\NUL\NULinsurance\NUL\NULjournal\NUL\NULjournalist\NUL\NULleasing\NUL\NULlogistics\NUL\NULmagazine\NUL\NULmaintenance\NUL\NULmarketplace\NUL\NULmedia\NUL\NULmicrolight\NUL\NULmodelling\NUL\NULnavigation\NUL\NULparachuting\NUL\NULparagliding\NUL\NULpassenger-association\NUL\NULpilot\NUL\NULpress\NUL\NULproduction\NUL\NULrecreation\NUL\NULrepbody\NUL\NULres\NUL\NULresearch\NUL\NULrotorcraft\NUL\NULsafety\NUL\NULscientist\NUL\NULservices\NUL\NULshow\NUL\NULskydiving\NUL\NULsoftware\NUL\NULstudent\NUL\NULtaxi\NUL\NULtrader\NUL\NULtrading\NUL\NULtrainer\NUL\NULunion\NUL\NULworkinggroup\NUL\NULworks\NUL\NUL\NULaf\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULafl\NUL\NULafrica\NUL\NULafricamagic\NUL\NULag\NULco\NUL\NULcom\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NUL\NULagency\NUL\NULai\NULcom\NUL\NULnet\NUL\NULoff\NUL\NULorg\NUL\NUL\NULaig\NUL\NULairforce\NUL\NULairtel\NUL\NULal\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULalibaba\NUL\NULalipay\NUL\NULallfinanz\NUL\NULalsace\NUL\NULam\NUL\NULamsterdam\NUL\NULan\NULcom\NUL\NULedu\NUL\NULnet\NUL\NULorg\NUL\NUL\NULanalytics\NUL\NULandroid\NUL\NULanquan\NUL\NULao\NULco\NUL\NULed\NUL\NULgv\NUL\NULit\NUL\NULog\NUL\NULpb\NUL\NUL\NULapartments\NUL\NULaq\NUL\NULaquarelle\NUL\NULar\NULcom\NULblogspot\NUL\NUL\NULedu\NUL\NULgob\NUL\NULgov\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULtur\NUL\NUL\NULaramco\NUL\NULarchi\NUL\NULarmy\NUL\NULarpa\NULe164\NUL\NULin-addr\NUL\NULip6\NUL\NULiris\NUL\NULuri\NUL\NULurn\NUL\NUL\NULarte\NUL\NULas\NULgov\NUL\NUL\NULasia\NUL\NULassociates\NUL\NULat\NULac\NUL\NULbiz\NUL\NULco\NULblogspot\NUL\NUL\NULgv\NUL\NULinfo\NUL\NULor\NUL\NULpriv\NUL\NUL\NULattorney\NUL\NULau\NULact\NUL\NULasn\NUL\NULcom\NULblogspot\NUL\NUL\NULconf\NUL\NULedu\NULact\NUL\NULnsw\NUL\NULnt\NUL\NULqld\NUL\NULsa\NUL\NULtas\NUL\NULvic\NUL\NULwa\NUL\NUL\NULgov\NULqld\NUL\NULsa\NUL\NULtas\NUL\NULvic\NUL\NULwa\NUL\NUL\NULid\NUL\NULinfo\NUL\NULnet\NUL\NULnsw\NUL\NULnt\NUL\NULorg\NUL\NULoz\NUL\NULqld\NUL\NULsa\NUL\NULtas\NUL\NULvic\NUL\NULwa\NUL\NUL\NULauction\NUL\NULaudio\NUL\NULauthor\NUL\NULauto\NUL\NULautos\NUL\NULavianca\NUL\NULaw\NULcom\NUL\NUL\NULax\NUL\NULaxa\NUL\NULaz\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpp\NUL\NULpro\NUL\NUL\NULazure\NUL\NULba\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULrs\NUL\NULunbi\NUL\NULunsa\NUL\NUL\NULbaidu\NUL\NULband\NUL\NULbank\NUL\NULbar\NUL\NULbarcelona\NUL\NULbarclaycard\NUL\NULbarclays\NUL\NULbargains\NUL\NULbauhaus\NUL\NULbayern\NUL\NULbb\NULbiz\NUL\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULnet\NUL\NULorg\NUL\NULstore\NUL\NULtv\NUL\NUL\NULbbc\NUL\NULbbva\NUL\NULbcg\NUL\NULbcn\NUL\NULbd\NUL*\NUL\NUL\NULbe\NULac\NUL\NULblogspot\NUL\NUL\NULbeer\NUL\NULbentley\NUL\NULberlin\NUL\NULbest\NUL\NULbf\NULgov\NUL\NUL\NULbg\NUL0\NUL\NUL1\NUL\NUL2\NUL\NUL3\NUL\NUL4\NUL\NUL5\NUL\NUL6\NUL\NUL7\NUL\NUL8\NUL\NUL9\NUL\NULa\NUL\NULb\NUL\NULc\NUL\NULd\NUL\NULe\NUL\NULf\NUL\NULg\NUL\NULh\NUL\NULi\NUL\NULj\NUL\NULk\NUL\NULl\NUL\NULm\NUL\NULn\NUL\NULo\NUL\NULp\NUL\NULq\NUL\NULr\NUL\NULs\NUL\NULt\NUL\NULu\NUL\NULv\NUL\NULw\NUL\NULx\NUL\NULy\NUL\NULz\NUL\NUL\NULbh\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULbharti\NUL\NULbi\NULco\NUL\NULcom\NUL\NULedu\NUL\NULor\NUL\NULorg\NUL\NUL\NULbible\NUL\NULbid\NUL\NULbike\NUL\NULbing\NUL\NULbingo\NUL\NULbio\NUL\NULbiz\NULdyndns\NUL\NULfor-better\NUL\NULfor-more\NUL\NULfor-some\NUL\NULfor-the\NUL\NULselfip\NUL\NULwebhop\NUL\NUL\NULbj\NULasso\NUL\NULbarreau\NUL\NULblogspot\NUL\NULgouv\NUL\NUL\NULblack\NUL\NULblackfriday\NUL\NULbloomberg\NUL\NULblue\NUL\NULbm\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULbms\NUL\NULbmw\NUL\NULbn\NUL*\NUL\NUL\NULbnl\NUL\NULbnpparibas\NUL\NULbo\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULgov\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULtv\NUL\NUL\NULboats\NUL\NULbom\NUL\NULbond\NUL\NULboo\NUL\NULboots\NUL\NULbot\NUL\NULboutique\NUL\NULbr\NULadm\NUL\NULadv\NUL\NULagr\NUL\NULam\NUL\NULarq\NUL\NULart\NUL\NULato\NUL\NULb\NUL\NULbio\NUL\NULblog\NUL\NULbmd\NUL\NULcim\NUL\NULcng\NUL\NULcnt\NUL\NULcom\NULblogspot\NUL\NUL\NULcoop\NUL\NULecn\NUL\NULeco\NUL\NULedu\NUL\NULemp\NUL\NULeng\NUL\NULesp\NUL\NULetc\NUL\NULeti\NUL\NULfar\NUL\NULflog\NUL\NULfm\NUL\NULfnd\NUL\NULfot\NUL\NULfst\NUL\NULg12\NUL\NULggf\NUL\NULgov\NUL\NULimb\NUL\NULind\NUL\NULinf\NUL\NULjor\NUL\NULjus\NUL\NULleg\NUL\NULlel\NUL\NULmat\NUL\NULmed\NUL\NULmil\NUL\NULmp\NUL\NULmus\NUL\NULnet\NUL\NULnom\NUL*\NUL\NUL\NULnot\NUL\NULntr\NUL\NULodo\NUL\NULorg\NUL\NULppg\NUL\NULpro\NUL\NULpsc\NUL\NULpsi\NUL\NULqsl\NUL\NULradio\NUL\NULrec\NUL\NULslg\NUL\NULsrv\NUL\NULtaxi\NUL\NULteo\NUL\NULtmp\NUL\NULtrd\NUL\NULtur\NUL\NULtv\NUL\NULvet\NUL\NULvlog\NUL\NULwiki\NUL\NULzlg\NUL\NUL\NULbradesco\NUL\NULbridgestone\NUL\NULbroadway\NUL\NULbroker\NUL\NULbrother\NUL\NULbrussels\NUL\NULbs\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULbt\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULbudapest\NUL\NULbuild\NUL\NULbuilders\NUL\NULbusiness\NUL\NULbuy\NUL\NULbuzz\NUL\NULbv\NUL\NULbw\NULco\NUL\NULorg\NUL\NUL\NULby\NULcom\NUL\NULgov\NUL\NULmil\NUL\NULof\NUL\NUL\NULbz\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULza\NUL\NUL\NULbzh\NUL\NULca\NULab\NUL\NULbc\NUL\NULblogspot\NUL\NULco\NUL\NULgc\NUL\NULmb\NUL\NULnb\NUL\NULnf\NUL\NULnl\NUL\NULns\NUL\NULnt\NUL\NULnu\NUL\NULon\NUL\NULpe\NUL\NULqc\NUL\NULsk\NUL\NULyk\NUL\NUL\NULcab\NUL\NULcafe\NUL\NULcal\NUL\NULcall\NUL\NULcamera\NUL\NULcamp\NUL\NULcancerresearch\NUL\NULcanon\NUL\NULcapetown\NUL\NULcapital\NUL\NULcar\NUL\NULcaravan\NUL\NULcards\NUL\NULcare\NUL\NULcareer\NUL\NULcareers\NUL\NULcars\NUL\NULcartier\NUL\NULcasa\NUL\NULcash\NUL\NULcasino\NUL\NULcat\NUL\NULcatering\NUL\NULcba\NUL\NULcbn\NUL\NULcc\NULftpaccess\NUL\NULgame-server\NUL\NULmyphotos\NUL\NULscrapping\NUL\NUL\NULcd\NULgov\NUL\NUL\NULcenter\NUL\NULceo\NUL\NULcern\NUL\NULcf\NULblogspot\NUL\NUL\NULcfa\NUL\NULcfd\NUL\NULcg\NUL\NULch\NULblogspot\NUL\NUL\NULchannel\NUL\NULchat\NUL\NULcheap\NUL\NULchloe\NUL\NULchristmas\NUL\NULchrome\NUL\NULchurch\NUL\NULci\NULac\NUL\NULasso\NUL\NULco\NUL\NULcom\NUL\NULed\NUL\NULedu\NUL\NULgo\NUL\NULgouv\NUL\NULint\NUL\NULmd\NUL\NULnet\NUL\NULor\NUL\NULorg\NUL\NULpresse\NUL\NULxn--aroport-bya\NUL\NUL\NULcipriani\NUL\NULcircle\NUL\NULcisco\NUL\NULcitic\NUL\NULcity\NUL\NULcityeats\NUL\NULck\NUL*\NUL\NUL\NULcl\NULco\NUL\NULgob\NUL\NULgov\NUL\NULmil\NUL\NUL\NULclaims\NUL\NULcleaning\NUL\NULclick\NUL\NULclinic\NUL\NULclothing\NUL\NULclub\NUL\NULcm\NULco\NUL\NULcom\NUL\NULgov\NUL\NULnet\NUL\NUL\NULcn\NULac\NUL\NULah\NUL\NULamazonaws\NULcompute\NUL\NUL\NULbj\NUL\NULcom\NUL\NULcq\NUL\NULedu\NUL\NULfj\NUL\NULgd\NUL\NULgov\NUL\NULgs\NUL\NULgx\NUL\NULgz\NUL\NULha\NUL\NULhb\NUL\NULhe\NUL\NULhi\NUL\NULhk\NUL\NULhl\NUL\NULhn\NUL\NULjl\NUL\NULjs\NUL\NULjx\NUL\NULln\NUL\NULmil\NUL\NULmo\NUL\NULnet\NUL\NULnm\NUL\NULnx\NUL\NULorg\NUL\NULqh\NUL\NULsc\NUL\NULsd\NUL\NULsh\NUL\NULsn\NUL\NULsx\NUL\NULtj\NUL\NULtw\NUL\NULxj\NUL\NULxn--55qx5d\NUL\NULxn--io0a7i\NUL\NULxn--od0alg\NUL\NULxz\NUL\NULyn\NUL\NULzj\NUL\NUL\NULco\NULarts\NUL\NULcom\NUL\NULedu\NUL\NULfirm\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NULrec\NUL\NULweb\NUL\NUL\NULcoach\NUL\NULcodes\NUL\NULcoffee\NUL\NULcollege\NUL\NULcologne\NUL\NULcom\NUL1kapp\NUL\NULafrica\NUL\NULamazonaws\NULcompute\NULeu-central-1\NUL\NULeu-west-1\NUL\NULsa-east-1\NUL\NULus-gov-west-1\NUL\NULus-west-1\NUL\NULus-west-2\NUL\NUL\NULcompute-1\NULz-1\NUL\NULz-2\NUL\NUL\NULelb\NUL\NULs3\NUL\NULs3-ap-northeast-1\NUL\NULs3-ap-southeast-1\NUL\NULs3-ap-southeast-2\NUL\NULs3-eu-west-1\NUL\NULs3-fips-us-gov-west-1\NUL\NULs3-sa-east-1\NUL\NULs3-us-gov-west-1\NUL\NULs3-us-west-1\NUL\NULs3-us-west-2\NUL\NULs3-website-ap-northeast-1\NUL\NULs3-website-ap-southeast-1\NUL\NULs3-website-ap-southeast-2\NUL\NULs3-website-eu-west-1\NUL\NULs3-website-sa-east-1\NUL\NULs3-website-us-east-1\NUL\NULs3-website-us-gov-west-1\NUL\NULs3-website-us-west-1\NUL\NULs3-website-us-west-2\NUL\NULus-east-1\NUL\NUL\NULappspot\NUL\NULar\NUL\NULbetainabox\NUL\NULblogdns\NUL\NULblogspot\NUL\NULbr\NUL\NULcechire\NUL\NULcloudcontrolapp\NUL\NULcloudcontrolled\NUL\NULcn\NUL\NULco\NUL\NULcodespot\NUL\NULde\NUL\NULdnsalias\NUL\NULdnsdojo\NUL\NULdoesntexist\NUL\NULdontexist\NUL\NULdoomdns\NUL\NULdreamhosters\NUL\NULdyn-o-saur\NUL\NULdynalias\NUL\NULdyndns-at-home\NUL\NULdyndns-at-work\NUL\NULdyndns-blog\NUL\NULdyndns-free\NUL\NULdyndns-home\NUL\NULdyndns-ip\NUL\NULdyndns-mail\NUL\NULdyndns-office\NUL\NULdyndns-pics\NUL\NULdyndns-remote\NUL\NULdyndns-server\NUL\NULdyndns-web\NUL\NULdyndns-wiki\NUL\NULdyndns-work\NUL\NULelasticbeanstalk\NUL\NULest-a-la-maison\NUL\NULest-a-la-masion\NUL\NULest-le-patron\NUL\NULest-mon-blogueur\NUL\NULeu\NUL\NULfirebaseapp\NUL\NULflynnhub\NUL\NULfrom-ak\NUL\NULfrom-al\NUL\NULfrom-ar\NUL\NULfrom-ca\NUL\NULfrom-ct\NUL\NULfrom-dc\NUL\NULfrom-de\NUL\NULfrom-fl\NUL\NULfrom-ga\NUL\NULfrom-hi\NUL\NULfrom-ia\NUL\NULfrom-id\NUL\NULfrom-il\NUL\NULfrom-in\NUL\NULfrom-ks\NUL\NULfrom-ky\NUL\NULfrom-ma\NUL\NULfrom-md\NUL\NULfrom-mi\NUL\NULfrom-mn\NUL\NULfrom-mo\NUL\NULfrom-ms\NUL\NULfrom-mt\NUL\NULfrom-nc\NUL\NULfrom-nd\NUL\NULfrom-ne\NUL\NULfrom-nh\NUL\NULfrom-nj\NUL\NULfrom-nm\NUL\NULfrom-nv\NUL\NULfrom-oh\NUL\NULfrom-ok\NUL\NULfrom-or\NUL\NULfrom-pa\NUL\NULfrom-pr\NUL\NULfrom-ri\NUL\NULfrom-sc\NUL\NULfrom-sd\NUL\NULfrom-tn\NUL\NULfrom-tx\NUL\NULfrom-ut\NUL\NULfrom-va\NUL\NULfrom-vt\NUL\NULfrom-wa\NUL\NULfrom-wi\NUL\NULfrom-wv\NUL\NULfrom-wy\NUL\NULgb\NUL\NULgetmyip\NUL\NULgithubusercontent\NUL\NULgoogleapis\NUL\NULgooglecode\NUL\NULgotdns\NUL\NULgr\NUL\NULherokuapp\NUL\NULherokussl\NUL\NULhk\NUL\NULhobby-site\NUL\NULhomelinux\NUL\NULhomeunix\NUL\NULhu\NUL\NULiamallama\NUL\NULis-a-anarchist\NUL\NULis-a-blogger\NUL\NULis-a-bookkeeper\NUL\NULis-a-bulls-fan\NUL\NULis-a-caterer\NUL\NULis-a-chef\NUL\NULis-a-conservative\NUL\NULis-a-cpa\NUL\NULis-a-cubicle-slave\NUL\NULis-a-democrat\NUL\NULis-a-designer\NUL\NULis-a-doctor\NUL\NULis-a-financialadvisor\NUL\NULis-a-geek\NUL\NULis-a-green\NUL\NULis-a-guru\NUL\NULis-a-hard-worker\NUL\NULis-a-hunter\NUL\NULis-a-landscaper\NUL\NULis-a-lawyer\NUL\NULis-a-liberal\NUL\NULis-a-libertarian\NUL\NULis-a-llama\NUL\NULis-a-musician\NUL\NULis-a-nascarfan\NUL\NULis-a-nurse\NUL\NULis-a-painter\NUL\NULis-a-personaltrainer\NUL\NULis-a-photographer\NUL\NULis-a-player\NUL\NULis-a-republican\NUL\NULis-a-rockstar\NUL\NULis-a-socialist\NUL\NULis-a-student\NUL\NULis-a-teacher\NUL\NULis-a-techie\NUL\NULis-a-therapist\NUL\NULis-an-accountant\NUL\NULis-an-actor\NUL\NULis-an-actress\NUL\NULis-an-anarchist\NUL\NULis-an-artist\NUL\NULis-an-engineer\NUL\NULis-an-entertainer\NUL\NULis-certified\NUL\NULis-gone\NUL\NULis-into-anime\NUL\NULis-into-cars\NUL\NULis-into-cartoons\NUL\NULis-into-games\NUL\NULis-leet\NUL\NULis-not-certified\NUL\NULis-slick\NUL\NULis-uberleet\NUL\NULis-with-theband\NUL\NULisa-geek\NUL\NULisa-hockeynut\NUL\NULissmarterthanyou\NUL\NULjpn\NUL\NULkr\NUL\NULlikes-pie\NUL\NULlikescandy\NUL\NULmex\NUL\NULneat-url\NUL\NULnfshost\NUL\NULno\NUL\NULoperaunite\NUL\NULoutsystemscloud\NUL\NULpagespeedmobilizer\NUL\NULqc\NUL\NULrhcloud\NUL\NULro\NUL\NULru\NUL\NULsa\NUL\NULsaves-the-whales\NUL\NULse\NUL\NULselfip\NUL\NULsells-for-less\NUL\NULsells-for-u\NUL\NULservebbs\NUL\NULsimple-url\NUL\NULsinaapp\NUL\NULspace-to-rent\NUL\NULteaches-yoga\NUL\NULuk\NUL\NULus\NUL\NULuy\NUL\NULvipsinaapp\NUL\NULwithgoogle\NUL\NULwritesthisblog\NUL\NULyolasite\NUL\NULza\NUL\NUL\NULcommbank\NUL\NULcommunity\NUL\NULcompany\NUL\NULcomputer\NUL\NULcomsec\NUL\NULcondos\NUL\NULconstruction\NUL\NULconsulting\NUL\NULcontact\NUL\NULcontractors\NUL\NULcooking\NUL\NULcool\NUL\NULcoop\NUL\NULcorsica\NUL\NULcountry\NUL\NULcoupon\NUL\NULcoupons\NUL\NULcourses\NUL\NULcr\NULac\NUL\NULco\NUL\NULed\NUL\NULfi\NUL\NULgo\NUL\NULor\NUL\NULsa\NUL\NUL\NULcredit\NUL\NULcreditcard\NUL\NULcreditunion\NUL\NULcricket\NUL\NULcrown\NUL\NULcrs\NUL\NULcruises\NUL\NULcsc\NUL\NULcu\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinf\NUL\NULnet\NUL\NULorg\NUL\NUL\NULcuisinella\NUL\NULcv\NULblogspot\NUL\NUL\NULcw\NULcom\NUL\NULedu\NUL\NULnet\NUL\NULorg\NUL\NUL\NULcx\NULath\NUL\NULgov\NUL\NUL\NULcy\NUL*\NUL\NUL\NULcymru\NUL\NULcyou\NUL\NULcz\NULblogspot\NUL\NUL\NULdabur\NUL\NULdad\NUL\NULdance\NUL\NULdate\NUL\NULdating\NUL\NULdatsun\NUL\NULday\NUL\NULdclk\NUL\NULde\NULblogspot\NUL\NULcom\NUL\NULfuettertdasnetz\NUL\NUListeingeek\NUL\NUListmein\NUL\NULlebtimnetz\NUL\NULleitungsen\NUL\NULtraeumtgerade\NUL\NUL\NULdealer\NUL\NULdeals\NUL\NULdegree\NUL\NULdelivery\NUL\NULdell\NUL\NULdelta\NUL\NULdemocrat\NUL\NULdental\NUL\NULdentist\NUL\NULdesi\NUL\NULdesign\NUL\NULdev\NUL\NULdiamonds\NUL\NULdiet\NUL\NULdigital\NUL\NULdirect\NUL\NULdirectory\NUL\NULdiscount\NUL\NULdj\NUL\NULdk\NULblogspot\NUL\NUL\NULdm\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULdnp\NUL\NULdo\NULart\NUL\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULsld\NUL\NULweb\NUL\NUL\NULdocs\NUL\NULdog\NUL\NULdoha\NUL\NULdomains\NUL\NULdoosan\NUL\NULdownload\NUL\NULdrive\NUL\NULdstv\NUL\NULdubai\NUL\NULdurban\NUL\NULdvag\NUL\NULdz\NULart\NUL\NULasso\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULpol\NUL\NUL\NULearth\NUL\NULeat\NUL\NULec\NULcom\NUL\NULedu\NUL\NULfin\NUL\NULgob\NUL\NULgov\NUL\NULinfo\NUL\NULk12\NUL\NULmed\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NUL\NULedeka\NUL\NULedu\NUL\NULeducation\NUL\NULee\NULaip\NUL\NULcom\NUL\NULedu\NUL\NULfie\NUL\NULgov\NUL\NULlib\NUL\NULmed\NUL\NULorg\NUL\NULpri\NUL\NULriik\NUL\NUL\NULeg\NULcom\NUL\NULedu\NUL\NULeun\NUL\NULgov\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULsci\NUL\NUL\NULemail\NUL\NULemerck\NUL\NULenergy\NUL\NULengineer\NUL\NULengineering\NUL\NULenterprises\NUL\NULepson\NUL\NULequipment\NUL\NULer\NUL*\NUL\NUL\NULerni\NUL\NULes\NULcom\NULblogspot\NUL\NUL\NULedu\NUL\NULgob\NUL\NULnom\NUL\NULorg\NUL\NUL\NULesq\NUL\NULestate\NUL\NULet\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULname\NUL\NULorg\NUL\NUL\NULeu\NUL\NULeurovision\NUL\NULeus\NUL\NULevents\NUL\NULeverbank\NUL\NULexchange\NUL\NULexpert\NUL\NULexposed\NUL\NULexpress\NUL\NULfage\NUL\NULfail\NUL\NULfairwinds\NUL\NULfaith\NUL\NULfamily\NUL\NULfan\NUL\NULfans\NUL\NULfarm\NUL\NULfashion\NUL\NULfast\NUL\NULfeedback\NUL\NULferrero\NUL\NULfi\NULaland\NUL\NULblogspot\NUL\NULiki\NUL\NUL\NULfilm\NUL\NULfinal\NUL\NULfinance\NUL\NULfinancial\NUL\NULfirestone\NUL\NULfirmdale\NUL\NULfish\NUL\NULfishing\NUL\NULfit\NUL\NULfitness\NUL\NULfj\NUL*\NUL\NUL\NULfk\NUL*\NUL\NUL\NULflickr\NUL\NULflights\NUL\NULflorist\NUL\NULflowers\NUL\NULflsmidth\NUL\NULfly\NUL\NULfm\NUL\NULfo\NUL\NULfoo\NUL\NULfootball\NUL\NULford\NUL\NULforex\NUL\NULforsale\NUL\NULforum\NUL\NULfoundation\NUL\NULfr\NULaeroport\NUL\NULassedic\NUL\NULasso\NUL\NULavocat\NUL\NULavoues\NUL\NULblogspot\NUL\NULcci\NUL\NULchambagri\NUL\NULchirurgiens-dentistes\NUL\NULcom\NUL\NULexperts-comptables\NUL\NULgeometre-expert\NUL\NULgouv\NUL\NULgreta\NUL\NULhuissier-justice\NUL\NULmedecin\NUL\NULnom\NUL\NULnotaires\NUL\NULpharmacien\NUL\NULport\NUL\NULprd\NUL\NULpresse\NUL\NULtm\NUL\NULveterinaire\NUL\NUL\NULfrl\NUL\NULfrogans\NUL\NULfrontier\NUL\NULfund\NUL\NULfurniture\NUL\NULfutbol\NUL\NULfyi\NUL\NULga\NUL\NULgal\NUL\NULgallery\NUL\NULgallup\NUL\NULgarden\NUL\NULgb\NUL\NULgbiz\NUL\NULgd\NUL\NULgdn\NUL\NULge\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULpvt\NUL\NUL\NULgea\NUL\NULgent\NUL\NULgenting\NUL\NULgf\NUL\NULgg\NULco\NUL\NULnet\NUL\NULorg\NUL\NUL\NULggee\NUL\NULgh\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULorg\NUL\NUL\NULgi\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULltd\NUL\NULmod\NUL\NULorg\NUL\NUL\NULgift\NUL\NULgifts\NUL\NULgives\NUL\NULgiving\NUL\NULgl\NUL\NULglass\NUL\NULgle\NUL\NULglobal\NUL\NULglobo\NUL\NULgm\NUL\NULgmail\NUL\NULgmo\NUL\NULgmx\NUL\NULgn\NULac\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULgold\NUL\NULgoldpoint\NUL\NULgolf\NUL\NULgoo\NUL\NULgoog\NUL\NULgoogle\NUL\NULgop\NUL\NULgot\NUL\NULgotv\NUL\NULgov\NUL\NULgp\NULasso\NUL\NULcom\NUL\NULedu\NUL\NULmobi\NUL\NULnet\NUL\NULorg\NUL\NUL\NULgq\NUL\NULgr\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULgraphics\NUL\NULgratis\NUL\NULgreen\NUL\NULgripe\NUL\NULgroup\NUL\NULgs\NUL\NULgt\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULind\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULgu\NUL*\NUL\NUL\NULgucci\NUL\NULguge\NUL\NULguide\NUL\NULguitars\NUL\NULguru\NUL\NULgw\NUL\NULgy\NULco\NUL\NULcom\NUL\NULnet\NUL\NUL\NULhamburg\NUL\NULhangout\NUL\NULhaus\NUL\NULhdfcbank\NUL\NULhealth\NUL\NULhealthcare\NUL\NULhelp\NUL\NULhelsinki\NUL\NULhere\NUL\NULhermes\NUL\NULhiphop\NUL\NULhitachi\NUL\NULhiv\NUL\NULhk\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULidv\NUL\NULinc\NUL\NULltd\NUL\NULnet\NUL\NULorg\NUL\NULxn--55qx5d\NUL\NULxn--ciqpn\NUL\NULxn--gmq050i\NUL\NULxn--gmqw5a\NUL\NULxn--io0a7i\NUL\NULxn--lcvr32d\NUL\NULxn--mk0axi\NUL\NULxn--mxtq1m\NUL\NULxn--od0alg\NUL\NULxn--od0aq3b\NUL\NULxn--tn0ag\NUL\NULxn--uc0atv\NUL\NULxn--uc0ay4a\NUL\NULxn--wcvs22d\NUL\NULxn--zf0avx\NUL\NUL\NULhm\NUL\NULhn\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULhockey\NUL\NULholdings\NUL\NULholiday\NUL\NULhomedepot\NUL\NULhomes\NUL\NULhonda\NUL\NULhorse\NUL\NULhost\NUL\NULhosting\NUL\NULhoteles\NUL\NULhotmail\NUL\NULhouse\NUL\NULhow\NUL\NULhr\NULcom\NUL\NULfrom\NUL\NULiz\NUL\NULname\NUL\NUL\NULhsbc\NUL\NULht\NULadult\NUL\NULart\NUL\NULasso\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULfirm\NUL\NULgouv\NUL\NULinfo\NUL\NULmed\NUL\NULnet\NUL\NULorg\NUL\NULperso\NUL\NULpol\NUL\NULpro\NUL\NULrel\NUL\NULshop\NUL\NUL\NULhtc\NUL\NULhu\NUL2000\NUL\NULagrar\NUL\NULblogspot\NUL\NULbolt\NUL\NULcasino\NUL\NULcity\NUL\NULco\NUL\NULerotica\NUL\NULerotika\NUL\NULfilm\NUL\NULforum\NUL\NULgames\NUL\NULhotel\NUL\NULinfo\NUL\NULingatlan\NUL\NULjogasz\NUL\NULkonyvelo\NUL\NULlakas\NUL\NULmedia\NUL\NULnews\NUL\NULorg\NUL\NULpriv\NUL\NULreklam\NUL\NULsex\NUL\NULshop\NUL\NULsport\NUL\NULsuli\NUL\NULszex\NUL\NULtm\NUL\NULtozsde\NUL\NULutazas\NUL\NULvideo\NUL\NUL\NULibm\NUL\NULicbc\NUL\NULice\NUL\NULicu\NUL\NULid\NULac\NUL\NULbiz\NUL\NULco\NUL\NULdesa\NUL\NULgo\NUL\NULmil\NUL\NULmy\NUL\NULnet\NUL\NULor\NUL\NULsch\NUL\NULweb\NUL\NUL\NULie\NULblogspot\NUL\NULgov\NUL\NUL\NULifm\NUL\NULiinet\NUL\NULil\NUL*\NUL\NULco\NULblogspot\NUL\NUL\NUL\NULim\NULac\NUL\NULco\NULltd\NUL\NULplc\NUL\NUL\NULcom\NUL\NULnet\NUL\NULorg\NUL\NULtt\NUL\NULtv\NUL\NUL\NULimmo\NUL\NULimmobilien\NUL\NULin\NULac\NUL\NULblogspot\NUL\NULco\NUL\NULedu\NUL\NULfirm\NUL\NULgen\NUL\NULgov\NUL\NULind\NUL\NULmil\NUL\NULnet\NUL\NULnic\NUL\NULorg\NUL\NULres\NUL\NUL\NULindustries\NUL\NULinfiniti\NUL\NULinfo\NULbarrel-of-knowledge\NUL\NULbarrell-of-knowledge\NUL\NULdyndns\NUL\NULfor-our\NUL\NULgroks-the\NUL\NULgroks-this\NUL\NULhere-for-more\NUL\NULknowsitall\NUL\NULselfip\NUL\NULwebhop\NUL\NUL\NULing\NUL\NULink\NUL\NULinstitute\NUL\NULinsurance\NUL\NULinsure\NUL\NULint\NULeu\NUL\NUL\NULinternational\NUL\NULinvestments\NUL\NULio\NULcom\NUL\NULgithub\NUL\NULnid\NUL\NUL\NULipiranga\NUL\NULiq\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULir\NULac\NUL\NULco\NUL\NULgov\NUL\NULid\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NULxn--mgba3a4f16a\NUL\NULxn--mgba3a4fra\NUL\NUL\NULirish\NUL\NULis\NULcom\NUL\NULcupcake\NUL\NULedu\NUL\NULgov\NUL\NULint\NUL\NULnet\NUL\NULorg\NUL\NUL\NULiselect\NUL\NUList\NUL\NUListanbul\NUL\NULit\NULabr\NUL\NULabruzzo\NUL\NULag\NUL\NULagrigento\NUL\NULal\NUL\NULalessandria\NUL\NULalto-adige\NUL\NULaltoadige\NUL\NULan\NUL\NULancona\NUL\NULandria-barletta-trani\NUL\NULandria-trani-barletta\NUL\NULandriabarlettatrani\NUL\NULandriatranibarletta\NUL\NULao\NUL\NULaosta\NUL\NULaosta-valley\NUL\NULaostavalley\NUL\NULaoste\NUL\NULap\NUL\NULaq\NUL\NULaquila\NUL\NULar\NUL\NULarezzo\NUL\NULascoli-piceno\NUL\NULascolipiceno\NUL\NULasti\NUL\NULat\NUL\NULav\NUL\NULavellino\NUL\NULba\NUL\NULbalsan\NUL\NULbari\NUL\NULbarletta-trani-andria\NUL\NULbarlettatraniandria\NUL\NULbas\NUL\NULbasilicata\NUL\NULbelluno\NUL\NULbenevento\NUL\NULbergamo\NUL\NULbg\NUL\NULbi\NUL\NULbiella\NUL\NULbl\NUL\NULblogspot\NUL\NULbn\NUL\NULbo\NUL\NULbologna\NUL\NULbolzano\NUL\NULbozen\NUL\NULbr\NUL\NULbrescia\NUL\NULbrindisi\NUL\NULbs\NUL\NULbt\NUL\NULbz\NUL\NULca\NUL\NULcagliari\NUL\NULcal\NUL\NULcalabria\NUL\NULcaltanissetta\NUL\NULcam\NUL\NULcampania\NUL\NULcampidano-medio\NUL\NULcampidanomedio\NUL\NULcampobasso\NUL\NULcarbonia-iglesias\NUL\NULcarboniaiglesias\NUL\NULcarrara-massa\NUL\NULcarraramassa\NUL\NULcaserta\NUL\NULcatania\NUL\NULcatanzaro\NUL\NULcb\NUL\NULce\NUL\NULcesena-forli\NUL\NULcesenaforli\NUL\NULch\NUL\NULchieti\NUL\NULci\NUL\NULcl\NUL\NULcn\NUL\NULco\NUL\NULcomo\NUL\NULcosenza\NUL\NULcr\NUL\NULcremona\NUL\NULcrotone\NUL\NULcs\NUL\NULct\NUL\NULcuneo\NUL\NULcz\NUL\NULdell-ogliastra\NUL\NULdellogliastra\NUL\NULedu\NUL\NULemilia-romagna\NUL\NULemiliaromagna\NUL\NULemr\NUL\NULen\NUL\NULenna\NUL\NULfc\NUL\NULfe\NUL\NULfermo\NUL\NULferrara\NUL\NULfg\NUL\NULfi\NUL\NULfirenze\NUL\NULflorence\NUL\NULfm\NUL\NULfoggia\NUL\NULforli-cesena\NUL\NULforlicesena\NUL\NULfr\NUL\NULfriuli-v-giulia\NUL\NULfriuli-ve-giulia\NUL\NULfriuli-vegiulia\NUL\NULfriuli-venezia-giulia\NUL\NULfriuli-veneziagiulia\NUL\NULfriuli-vgiulia\NUL\NULfriuliv-giulia\NUL\NULfriulive-giulia\NUL\NULfriulivegiulia\NUL\NULfriulivenezia-giulia\NUL\NULfriuliveneziagiulia\NUL\NULfriulivgiulia\NUL\NULfrosinone\NUL\NULfvg\NUL\NULge\NUL\NULgenoa\NUL\NULgenova\NUL\NULgo\NUL\NULgorizia\NUL\NULgov\NUL\NULgr\NUL\NULgrosseto\NUL\NULiglesias-carbonia\NUL\NULiglesiascarbonia\NUL\NULim\NUL\NULimperia\NUL\NULis\NUL\NULisernia\NUL\NULkr\NUL\NULla-spezia\NUL\NULlaquila\NUL\NULlaspezia\NUL\NULlatina\NUL\NULlaz\NUL\NULlazio\NUL\NULlc\NUL\NULle\NUL\NULlecce\NUL\NULlecco\NUL\NULli\NUL\NULlig\NUL\NULliguria\NUL\NULlivorno\NUL\NULlo\NUL\NULlodi\NUL\NULlom\NUL\NULlombardia\NUL\NULlombardy\NUL\NULlt\NUL\NULlu\NUL\NULlucania\NUL\NULlucca\NUL\NULmacerata\NUL\NULmantova\NUL\NULmar\NUL\NULmarche\NUL\NULmassa-carrara\NUL\NULmassacarrara\NUL\NULmatera\NUL\NULmb\NUL\NULmc\NUL\NULme\NUL\NULmedio-campidano\NUL\NULmediocampidano\NUL\NULmessina\NUL\NULmi\NUL\NULmilan\NUL\NULmilano\NUL\NULmn\NUL\NULmo\NUL\NULmodena\NUL\NULmol\NUL\NULmolise\NUL\NULmonza\NUL\NULmonza-brianza\NUL\NULmonza-e-della-brianza\NUL\NULmonzabrianza\NUL\NULmonzaebrianza\NUL\NULmonzaedellabrianza\NUL\NULms\NUL\NULmt\NUL\NULna\NUL\NULnaples\NUL\NULnapoli\NUL\NULno\NUL\NULnovara\NUL\NULnu\NUL\NULnuoro\NUL\NULog\NUL\NULogliastra\NUL\NULolbia-tempio\NUL\NULolbiatempio\NUL\NULor\NUL\NULoristano\NUL\NULot\NUL\NULpa\NUL\NULpadova\NUL\NULpadua\NUL\NULpalermo\NUL\NULparma\NUL\NULpavia\NUL\NULpc\NUL\NULpd\NUL\NULpe\NUL\NULperugia\NUL\NULpesaro-urbino\NUL\NULpesarourbino\NUL\NULpescara\NUL\NULpg\NUL\NULpi\NUL\NULpiacenza\NUL\NULpiedmont\NUL\NULpiemonte\NUL\NULpisa\NUL\NULpistoia\NUL\NULpmn\NUL\NULpn\NUL\NULpo\NUL\NULpordenone\NUL\NULpotenza\NUL\NULpr\NUL\NULprato\NUL\NULpt\NUL\NULpu\NUL\NULpug\NUL\NULpuglia\NUL\NULpv\NUL\NULpz\NUL\NULra\NUL\NULragusa\NUL\NULravenna\NUL\NULrc\NUL\NULre\NUL\NULreggio-calabria\NUL\NULreggio-emilia\NUL\NULreggiocalabria\NUL\NULreggioemilia\NUL\NULrg\NUL\NULri\NUL\NULrieti\NUL\NULrimini\NUL\NULrm\NUL\NULrn\NUL\NULro\NUL\NULroma\NUL\NULrome\NUL\NULrovigo\NUL\NULsa\NUL\NULsalerno\NUL\NULsar\NUL\NULsardegna\NUL\NULsardinia\NUL\NULsassari\NUL\NULsavona\NUL\NULsi\NUL\NULsic\NUL\NULsicilia\NUL\NULsicily\NUL\NULsiena\NUL\NULsiracusa\NUL\NULso\NUL\NULsondrio\NUL\NULsp\NUL\NULsr\NUL\NULss\NUL\NULsuedtirol\NUL\NULsv\NUL\NULta\NUL\NULtaa\NUL\NULtaranto\NUL\NULte\NUL\NULtempio-olbia\NUL\NULtempioolbia\NUL\NULteramo\NUL\NULterni\NUL\NULtn\NUL\NULto\NUL\NULtorino\NUL\NULtos\NUL\NULtoscana\NUL\NULtp\NUL\NULtr\NUL\NULtrani-andria-barletta\NUL\NULtrani-barletta-andria\NUL\NULtraniandriabarletta\NUL\NULtranibarlettaandria\NUL\NULtrapani\NUL\NULtrentino\NUL\NULtrentino-a-adige\NUL\NULtrentino-aadige\NUL\NULtrentino-alto-adige\NUL\NULtrentino-altoadige\NUL\NULtrentino-s-tirol\NUL\NULtrentino-stirol\NUL\NULtrentino-sud-tirol\NUL\NULtrentino-sudtirol\NUL\NULtrentino-sued-tirol\NUL\NULtrentino-suedtirol\NUL\NULtrentinoa-adige\NUL\NULtrentinoaadige\NUL\NULtrentinoalto-adige\NUL\NULtrentinoaltoadige\NUL\NULtrentinos-tirol\NUL\NULtrentinostirol\NUL\NULtrentinosud-tirol\NUL\NULtrentinosudtirol\NUL\NULtrentinosued-tirol\NUL\NULtrentinosuedtirol\NUL\NULtrento\NUL\NULtreviso\NUL\NULtrieste\NUL\NULts\NUL\NULturin\NUL\NULtuscany\NUL\NULtv\NUL\NULud\NUL\NULudine\NUL\NULumb\NUL\NULumbria\NUL\NULurbino-pesaro\NUL\NULurbinopesaro\NUL\NULva\NUL\NULval-d-aosta\NUL\NULval-daosta\NUL\NULvald-aosta\NUL\NULvaldaosta\NUL\NULvalle-aosta\NUL\NULvalle-d-aosta\NUL\NULvalle-daosta\NUL\NULvalleaosta\NUL\NULvalled-aosta\NUL\NULvalledaosta\NUL\NULvallee-aoste\NUL\NULvalleeaoste\NUL\NULvao\NUL\NULvarese\NUL\NULvb\NUL\NULvc\NUL\NULvda\NUL\NULve\NUL\NULven\NUL\NULveneto\NUL\NULvenezia\NUL\NULvenice\NUL\NULverbania\NUL\NULvercelli\NUL\NULverona\NUL\NULvi\NUL\NULvibo-valentia\NUL\NULvibovalentia\NUL\NULvicenza\NUL\NULviterbo\NUL\NULvr\NUL\NULvs\NUL\NULvt\NUL\NULvv\NUL\NUL\NULitau\NUL\NULiwc\NUL\NULjaguar\NUL\NULjava\NUL\NULjcb\NUL\NULje\NULco\NUL\NULnet\NUL\NULorg\NUL\NUL\NULjetzt\NUL\NULjewelry\NUL\NULjio\NUL\NULjlc\NUL\NULjll\NUL\NULjm\NUL*\NUL\NUL\NULjmp\NUL\NULjo\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NUL\NULjobs\NUL\NULjoburg\NUL\NULjot\NUL\NULjoy\NUL\NULjp\NULac\NUL\NULad\NUL\NULaichi\NULaisai\NUL\NULama\NUL\NULanjo\NUL\NULasuke\NUL\NULchiryu\NUL\NULchita\NUL\NULfuso\NUL\NULgamagori\NUL\NULhanda\NUL\NULhazu\NUL\NULhekinan\NUL\NULhigashiura\NUL\NULichinomiya\NUL\NULinazawa\NUL\NULinuyama\NUL\NULisshiki\NUL\NULiwakura\NUL\NULkanie\NUL\NULkariya\NUL\NULkasugai\NUL\NULkira\NUL\NULkiyosu\NUL\NULkomaki\NUL\NULkonan\NUL\NULkota\NUL\NULmihama\NUL\NULmiyoshi\NUL\NULnishio\NUL\NULnisshin\NUL\NULobu\NUL\NULoguchi\NUL\NULoharu\NUL\NULokazaki\NUL\NULowariasahi\NUL\NULseto\NUL\NULshikatsu\NUL\NULshinshiro\NUL\NULshitara\NUL\NULtahara\NUL\NULtakahama\NUL\NULtobishima\NUL\NULtoei\NUL\NULtogo\NUL\NULtokai\NUL\NULtokoname\NUL\NULtoyoake\NUL\NULtoyohashi\NUL\NULtoyokawa\NUL\NULtoyone\NUL\NULtoyota\NUL\NULtsushima\NUL\NULyatomi\NUL\NUL\NULakita\NULakita\NUL\NULdaisen\NUL\NULfujisato\NUL\NULgojome\NUL\NULhachirogata\NUL\NULhappou\NUL\NULhigashinaruse\NUL\NULhonjo\NUL\NULhonjyo\NUL\NULikawa\NUL\NULkamikoani\NUL\NULkamioka\NUL\NULkatagami\NUL\NULkazuno\NUL\NULkitaakita\NUL\NULkosaka\NUL\NULkyowa\NUL\NULmisato\NUL\NULmitane\NUL\NULmoriyoshi\NUL\NULnikaho\NUL\NULnoshiro\NUL\NULodate\NUL\NULoga\NUL\NULogata\NUL\NULsemboku\NUL\NULyokote\NUL\NULyurihonjo\NUL\NUL\NULaomori\NULaomori\NUL\NULgonohe\NUL\NULhachinohe\NUL\NULhashikami\NUL\NULhiranai\NUL\NULhirosaki\NUL\NULitayanagi\NUL\NULkuroishi\NUL\NULmisawa\NUL\NULmutsu\NUL\NULnakadomari\NUL\NULnoheji\NUL\NULoirase\NUL\NULowani\NUL\NULrokunohe\NUL\NULsannohe\NUL\NULshichinohe\NUL\NULshingo\NUL\NULtakko\NUL\NULtowada\NUL\NULtsugaru\NUL\NULtsuruta\NUL\NUL\NULblogspot\NUL\NULchiba\NULabiko\NUL\NULasahi\NUL\NULchonan\NUL\NULchosei\NUL\NULchoshi\NUL\NULchuo\NUL\NULfunabashi\NUL\NULfuttsu\NUL\NULhanamigawa\NUL\NULichihara\NUL\NULichikawa\NUL\NULichinomiya\NUL\NULinzai\NUL\NULisumi\NUL\NULkamagaya\NUL\NULkamogawa\NUL\NULkashiwa\NUL\NULkatori\NUL\NULkatsuura\NUL\NULkimitsu\NUL\NULkisarazu\NUL\NULkozaki\NUL\NULkujukuri\NUL\NULkyonan\NUL\NULmatsudo\NUL\NULmidori\NUL\NULmihama\NUL\NULminamiboso\NUL\NULmobara\NUL\NULmutsuzawa\NUL\NULnagara\NUL\NULnagareyama\NUL\NULnarashino\NUL\NULnarita\NUL\NULnoda\NUL\NULoamishirasato\NUL\NULomigawa\NUL\NULonjuku\NUL\NULotaki\NUL\NULsakae\NUL\NULsakura\NUL\NULshimofusa\NUL\NULshirako\NUL\NULshiroi\NUL\NULshisui\NUL\NULsodegaura\NUL\NULsosa\NUL\NULtako\NUL\NULtateyama\NUL\NULtogane\NUL\NULtohnosho\NUL\NULtomisato\NUL\NULurayasu\NUL\NULyachimata\NUL\NULyachiyo\NUL\NULyokaichiba\NUL\NULyokoshibahikari\NUL\NULyotsukaido\NUL\NUL\NULco\NUL\NULed\NUL\NULehime\NULainan\NUL\NULhonai\NUL\NULikata\NUL\NULimabari\NUL\NULiyo\NUL\NULkamijima\NUL\NULkihoku\NUL\NULkumakogen\NUL\NULmasaki\NUL\NULmatsuno\NUL\NULmatsuyama\NUL\NULnamikata\NUL\NULniihama\NUL\NULozu\NUL\NULsaijo\NUL\NULseiyo\NUL\NULshikokuchuo\NUL\NULtobe\NUL\NULtoon\NUL\NULuchiko\NUL\NULuwajima\NUL\NULyawatahama\NUL\NUL\NULfukui\NULechizen\NUL\NULeiheiji\NUL\NULfukui\NUL\NULikeda\NUL\NULkatsuyama\NUL\NULmihama\NUL\NULminamiechizen\NUL\NULobama\NUL\NULohi\NUL\NULono\NUL\NULsabae\NUL\NULsakai\NUL\NULtakahama\NUL\NULtsuruga\NUL\NULwakasa\NUL\NUL\NULfukuoka\NULashiya\NUL\NULbuzen\NUL\NULchikugo\NUL\NULchikuho\NUL\NULchikujo\NUL\NULchikushino\NUL\NULchikuzen\NUL\NULchuo\NUL\NULdazaifu\NUL\NULfukuchi\NUL\NULhakata\NUL\NULhigashi\NUL\NULhirokawa\NUL\NULhisayama\NUL\NULiizuka\NUL\NULinatsuki\NUL\NULkaho\NUL\NULkasuga\NUL\NULkasuya\NUL\NULkawara\NUL\NULkeisen\NUL\NULkoga\NUL\NULkurate\NUL\NULkurogi\NUL\NULkurume\NUL\NULminami\NUL\NULmiyako\NUL\NULmiyama\NUL\NULmiyawaka\NUL\NULmizumaki\NUL\NULmunakata\NUL\NULnakagawa\NUL\NULnakama\NUL\NULnishi\NUL\NULnogata\NUL\NULogori\NUL\NULokagaki\NUL\NULokawa\NUL\NULoki\NUL\NULomuta\NUL\NULonga\NUL\NULonojo\NUL\NULoto\NUL\NULsaigawa\NUL\NULsasaguri\NUL\NULshingu\NUL\NULshinyoshitomi\NUL\NULshonai\NUL\NULsoeda\NUL\NULsue\NUL\NULtachiarai\NUL\NULtagawa\NUL\NULtakata\NUL\NULtoho\NUL\NULtoyotsu\NUL\NULtsuiki\NUL\NULukiha\NUL\NULumi\NUL\NULusui\NUL\NULyamada\NUL\NULyame\NUL\NULyanagawa\NUL\NULyukuhashi\NUL\NUL\NULfukushima\NULaizubange\NUL\NULaizumisato\NUL\NULaizuwakamatsu\NUL\NULasakawa\NUL\NULbandai\NUL\NULdate\NUL\NULfukushima\NUL\NULfurudono\NUL\NULfutaba\NUL\NULhanawa\NUL\NULhigashi\NUL\NULhirata\NUL\NULhirono\NUL\NULiitate\NUL\NULinawashiro\NUL\NULishikawa\NUL\NULiwaki\NUL\NULizumizaki\NUL\NULkagamiishi\NUL\NULkaneyama\NUL\NULkawamata\NUL\NULkitakata\NUL\NULkitashiobara\NUL\NULkoori\NUL\NULkoriyama\NUL\NULkunimi\NUL\NULmiharu\NUL\NULmishima\NUL\NULnamie\NUL\NULnango\NUL\NULnishiaizu\NUL\NULnishigo\NUL\NULokuma\NUL\NULomotego\NUL\NULono\NUL\NULotama\NUL\NULsamegawa\NUL\NULshimogo\NUL\NULshirakawa\NUL\NULshowa\NUL\NULsoma\NUL\NULsukagawa\NUL\NULtaishin\NUL\NULtamakawa\NUL\NULtanagura\NUL\NULtenei\NUL\NULyabuki\NUL\NULyamato\NUL\NULyamatsuri\NUL\NULyanaizu\NUL\NULyugawa\NUL\NUL\NULgifu\NULanpachi\NUL\NULena\NUL\NULgifu\NUL\NULginan\NUL\NULgodo\NUL\NULgujo\NUL\NULhashima\NUL\NULhichiso\NUL\NULhida\NUL\NULhigashishirakawa\NUL\NULibigawa\NUL\NULikeda\NUL\NULkakamigahara\NUL\NULkani\NUL\NULkasahara\NUL\NULkasamatsu\NUL\NULkawaue\NUL\NULkitagata\NUL\NULmino\NUL\NULminokamo\NUL\NULmitake\NUL\NULmizunami\NUL\NULmotosu\NUL\NULnakatsugawa\NUL\NULogaki\NUL\NULsakahogi\NUL\NULseki\NUL\NULsekigahara\NUL\NULshirakawa\NUL\NULtajimi\NUL\NULtakayama\NUL\NULtarui\NUL\NULtoki\NUL\NULtomika\NUL\NULwanouchi\NUL\NULyamagata\NUL\NULyaotsu\NUL\NULyoro\NUL\NUL\NULgo\NUL\NULgr\NUL\NULgunma\NULannaka\NUL\NULchiyoda\NUL\NULfujioka\NUL\NULhigashiagatsuma\NUL\NULisesaki\NUL\NULitakura\NUL\NULkanna\NUL\NULkanra\NUL\NULkatashina\NUL\NULkawaba\NUL\NULkiryu\NUL\NULkusatsu\NUL\NULmaebashi\NUL\NULmeiwa\NUL\NULmidori\NUL\NULminakami\NUL\NULnaganohara\NUL\NULnakanojo\NUL\NULnanmoku\NUL\NULnumata\NUL\NULoizumi\NUL\NULora\NUL\NULota\NUL\NULshibukawa\NUL\NULshimonita\NUL\NULshinto\NUL\NULshowa\NUL\NULtakasaki\NUL\NULtakayama\NUL\NULtamamura\NUL\NULtatebayashi\NUL\NULtomioka\NUL\NULtsukiyono\NUL\NULtsumagoi\NUL\NULueno\NUL\NULyoshioka\NUL\NUL\NULhiroshima\NULasaminami\NUL\NULdaiwa\NUL\NULetajima\NUL\NULfuchu\NUL\NULfukuyama\NUL\NULhatsukaichi\NUL\NULhigashihiroshima\NUL\NULhongo\NUL\NULjinsekikogen\NUL\NULkaita\NUL\NULkui\NUL\NULkumano\NUL\NULkure\NUL\NULmihara\NUL\NULmiyoshi\NUL\NULnaka\NUL\NULonomichi\NUL\NULosakikamijima\NUL\NULotake\NUL\NULsaka\NUL\NULsera\NUL\NULseranishi\NUL\NULshinichi\NUL\NULshobara\NUL\NULtakehara\NUL\NUL\NULhokkaido\NULabashiri\NUL\NULabira\NUL\NULaibetsu\NUL\NULakabira\NUL\NULakkeshi\NUL\NULasahikawa\NUL\NULashibetsu\NUL\NULashoro\NUL\NULassabu\NUL\NULatsuma\NUL\NULbibai\NUL\NULbiei\NUL\NULbifuka\NUL\NULbihoro\NUL\NULbiratori\NUL\NULchippubetsu\NUL\NULchitose\NUL\NULdate\NUL\NULebetsu\NUL\NULembetsu\NUL\NULeniwa\NUL\NULerimo\NUL\NULesan\NUL\NULesashi\NUL\NULfukagawa\NUL\NULfukushima\NUL\NULfurano\NUL\NULfurubira\NUL\NULhaboro\NUL\NULhakodate\NUL\NULhamatonbetsu\NUL\NULhidaka\NUL\NULhigashikagura\NUL\NULhigashikawa\NUL\NULhiroo\NUL\NULhokuryu\NUL\NULhokuto\NUL\NULhonbetsu\NUL\NULhorokanai\NUL\NULhoronobe\NUL\NULikeda\NUL\NULimakane\NUL\NULishikari\NUL\NULiwamizawa\NUL\NULiwanai\NUL\NULkamifurano\NUL\NULkamikawa\NUL\NULkamishihoro\NUL\NULkamisunagawa\NUL\NULkamoenai\NUL\NULkayabe\NUL\NULkembuchi\NUL\NULkikonai\NUL\NULkimobetsu\NUL\NULkitahiroshima\NUL\NULkitami\NUL\NULkiyosato\NUL\NULkoshimizu\NUL\NULkunneppu\NUL\NULkuriyama\NUL\NULkuromatsunai\NUL\NULkushiro\NUL\NULkutchan\NUL\NULkyowa\NUL\NULmashike\NUL\NULmatsumae\NUL\NULmikasa\NUL\NULminamifurano\NUL\NULmombetsu\NUL\NULmoseushi\NUL\NULmukawa\NUL\NULmuroran\NUL\NULnaie\NUL\NULnakagawa\NUL\NULnakasatsunai\NUL\NULnakatombetsu\NUL\NULnanae\NUL\NULnanporo\NUL\NULnayoro\NUL\NULnemuro\NUL\NULniikappu\NUL\NULniki\NUL\NULnishiokoppe\NUL\NULnoboribetsu\NUL\NULnumata\NUL\NULobihiro\NUL\NULobira\NUL\NULoketo\NUL\NULokoppe\NUL\NULotaru\NUL\NULotobe\NUL\NULotofuke\NUL\NULotoineppu\NUL\NULoumu\NUL\NULozora\NUL\NULpippu\NUL\NULrankoshi\NUL\NULrebun\NUL\NULrikubetsu\NUL\NULrishiri\NUL\NULrishirifuji\NUL\NULsaroma\NUL\NULsarufutsu\NUL\NULshakotan\NUL\NULshari\NUL\NULshibecha\NUL\NULshibetsu\NUL\NULshikabe\NUL\NULshikaoi\NUL\NULshimamaki\NUL\NULshimizu\NUL\NULshimokawa\NUL\NULshinshinotsu\NUL\NULshintoku\NUL\NULshiranuka\NUL\NULshiraoi\NUL\NULshiriuchi\NUL\NULsobetsu\NUL\NULsunagawa\NUL\NULtaiki\NUL\NULtakasu\NUL\NULtakikawa\NUL\NULtakinoue\NUL\NULteshikaga\NUL\NULtobetsu\NUL\NULtohma\NUL\NULtomakomai\NUL\NULtomari\NUL\NULtoya\NUL\NULtoyako\NUL\NULtoyotomi\NUL\NULtoyoura\NUL\NULtsubetsu\NUL\NULtsukigata\NUL\NULurakawa\NUL\NULurausu\NUL\NULuryu\NUL\NULutashinai\NUL\NULwakkanai\NUL\NULwassamu\NUL\NULyakumo\NUL\NULyoichi\NUL\NUL\NULhyogo\NULaioi\NUL\NULakashi\NUL\NULako\NUL\NULamagasaki\NUL\NULaogaki\NUL\NULasago\NUL\NULashiya\NUL\NULawaji\NUL\NULfukusaki\NUL\NULgoshiki\NUL\NULharima\NUL\NULhimeji\NUL\NULichikawa\NUL\NULinagawa\NUL\NULitami\NUL\NULkakogawa\NUL\NULkamigori\NUL\NULkamikawa\NUL\NULkasai\NUL\NULkasuga\NUL\NULkawanishi\NUL\NULmiki\NUL\NULminamiawaji\NUL\NULnishinomiya\NUL\NULnishiwaki\NUL\NULono\NUL\NULsanda\NUL\NULsannan\NUL\NULsasayama\NUL\NULsayo\NUL\NULshingu\NUL\NULshinonsen\NUL\NULshiso\NUL\NULsumoto\NUL\NULtaishi\NUL\NULtaka\NUL\NULtakarazuka\NUL\NULtakasago\NUL\NULtakino\NUL\NULtamba\NUL\NULtatsuno\NUL\NULtoyooka\NUL\NULyabu\NUL\NULyashiro\NUL\NULyoka\NUL\NULyokawa\NUL\NUL\NULibaraki\NULami\NUL\NULasahi\NUL\NULbando\NUL\NULchikusei\NUL\NULdaigo\NUL\NULfujishiro\NUL\NULhitachi\NUL\NULhitachinaka\NUL\NULhitachiomiya\NUL\NULhitachiota\NUL\NULibaraki\NUL\NULina\NUL\NULinashiki\NUL\NULitako\NUL\NULiwama\NUL\NULjoso\NUL\NULkamisu\NUL\NULkasama\NUL\NULkashima\NUL\NULkasumigaura\NUL\NULkoga\NUL\NULmiho\NUL\NULmito\NUL\NULmoriya\NUL\NULnaka\NUL\NULnamegata\NUL\NULoarai\NUL\NULogawa\NUL\NULomitama\NUL\NULryugasaki\NUL\NULsakai\NUL\NULsakuragawa\NUL\NULshimodate\NUL\NULshimotsuma\NUL\NULshirosato\NUL\NULsowa\NUL\NULsuifu\NUL\NULtakahagi\NUL\NULtamatsukuri\NUL\NULtokai\NUL\NULtomobe\NUL\NULtone\NUL\NULtoride\NUL\NULtsuchiura\NUL\NULtsukuba\NUL\NULuchihara\NUL\NULushiku\NUL\NULyachiyo\NUL\NULyamagata\NUL\NULyawara\NUL\NULyuki\NUL\NUL\NULishikawa\NULanamizu\NUL\NULhakui\NUL\NULhakusan\NUL\NULkaga\NUL\NULkahoku\NUL\NULkanazawa\NUL\NULkawakita\NUL\NULkomatsu\NUL\NULnakanoto\NUL\NULnanao\NUL\NULnomi\NUL\NULnonoichi\NUL\NULnoto\NUL\NULshika\NUL\NULsuzu\NUL\NULtsubata\NUL\NULtsurugi\NUL\NULuchinada\NUL\NULwajima\NUL\NUL\NULiwate\NULfudai\NUL\NULfujisawa\NUL\NULhanamaki\NUL\NULhiraizumi\NUL\NULhirono\NUL\NULichinohe\NUL\NULichinoseki\NUL\NULiwaizumi\NUL\NULiwate\NUL\NULjoboji\NUL\NULkamaishi\NUL\NULkanegasaki\NUL\NULkarumai\NUL\NULkawai\NUL\NULkitakami\NUL\NULkuji\NUL\NULkunohe\NUL\NULkuzumaki\NUL\NULmiyako\NUL\NULmizusawa\NUL\NULmorioka\NUL\NULninohe\NUL\NULnoda\NUL\NULofunato\NUL\NULoshu\NUL\NULotsuchi\NUL\NULrikuzentakata\NUL\NULshiwa\NUL\NULshizukuishi\NUL\NULsumita\NUL\NULtanohata\NUL\NULtono\NUL\NULyahaba\NUL\NULyamada\NUL\NUL\NULkagawa\NULayagawa\NUL\NULhigashikagawa\NUL\NULkanonji\NUL\NULkotohira\NUL\NULmanno\NUL\NULmarugame\NUL\NULmitoyo\NUL\NULnaoshima\NUL\NULsanuki\NUL\NULtadotsu\NUL\NULtakamatsu\NUL\NULtonosho\NUL\NULuchinomi\NUL\NULutazu\NUL\NULzentsuji\NUL\NUL\NULkagoshima\NULakune\NUL\NULamami\NUL\NULhioki\NUL\NULisa\NUL\NULisen\NUL\NULizumi\NUL\NULkagoshima\NUL\NULkanoya\NUL\NULkawanabe\NUL\NULkinko\NUL\NULkouyama\NUL\NULmakurazaki\NUL\NULmatsumoto\NUL\NULminamitane\NUL\NULnakatane\NUL\NULnishinoomote\NUL\NULsatsumasendai\NUL\NULsoo\NUL\NULtarumizu\NUL\NULyusui\NUL\NUL\NULkanagawa\NULaikawa\NUL\NULatsugi\NUL\NULayase\NUL\NULchigasaki\NUL\NULebina\NUL\NULfujisawa\NUL\NULhadano\NUL\NULhakone\NUL\NULhiratsuka\NUL\NULisehara\NUL\NULkaisei\NUL\NULkamakura\NUL\NULkiyokawa\NUL\NULmatsuda\NUL\NULminamiashigara\NUL\NULmiura\NUL\NULnakai\NUL\NULninomiya\NUL\NULodawara\NUL\NULoi\NUL\NULoiso\NUL\NULsagamihara\NUL\NULsamukawa\NUL\NULtsukui\NUL\NULyamakita\NUL\NULyamato\NUL\NULyokosuka\NUL\NULyugawara\NUL\NULzama\NUL\NULzushi\NUL\NUL\NULkawasaki\NUL*\NUL\NUL\NULkitakyushu\NUL*\NUL\NUL\NULkobe\NUL*\NUL\NUL\NULkochi\NULaki\NUL\NULgeisei\NUL\NULhidaka\NUL\NULhigashitsuno\NUL\NULino\NUL\NULkagami\NUL\NULkami\NUL\NULkitagawa\NUL\NULkochi\NUL\NULmihara\NUL\NULmotoyama\NUL\NULmuroto\NUL\NULnahari\NUL\NULnakamura\NUL\NULnankoku\NUL\NULnishitosa\NUL\NULniyodogawa\NUL\NULochi\NUL\NULokawa\NUL\NULotoyo\NUL\NULotsuki\NUL\NULsakawa\NUL\NULsukumo\NUL\NULsusaki\NUL\NULtosa\NUL\NULtosashimizu\NUL\NULtoyo\NUL\NULtsuno\NUL\NULumaji\NUL\NULyasuda\NUL\NULyusuhara\NUL\NUL\NULkumamoto\NULamakusa\NUL\NULarao\NUL\NULaso\NUL\NULchoyo\NUL\NULgyokuto\NUL\NULhitoyoshi\NUL\NULkamiamakusa\NUL\NULkashima\NUL\NULkikuchi\NUL\NULkosa\NUL\NULkumamoto\NUL\NULmashiki\NUL\NULmifune\NUL\NULminamata\NUL\NULminamioguni\NUL\NULnagasu\NUL\NULnishihara\NUL\NULoguni\NUL\NULozu\NUL\NULsumoto\NUL\NULtakamori\NUL\NULuki\NUL\NULuto\NUL\NULyamaga\NUL\NULyamato\NUL\NULyatsushiro\NUL\NUL\NULkyoto\NULayabe\NUL\NULfukuchiyama\NUL\NULhigashiyama\NUL\NULide\NUL\NULine\NUL\NULjoyo\NUL\NULkameoka\NUL\NULkamo\NUL\NULkita\NUL\NULkizu\NUL\NULkumiyama\NUL\NULkyotamba\NUL\NULkyotanabe\NUL\NULkyotango\NUL\NULmaizuru\NUL\NULminami\NUL\NULminamiyamashiro\NUL\NULmiyazu\NUL\NULmuko\NUL\NULnagaokakyo\NUL\NULnakagyo\NUL\NULnantan\NUL\NULoyamazaki\NUL\NULsakyo\NUL\NULseika\NUL\NULtanabe\NUL\NULuji\NUL\NULujitawara\NUL\NULwazuka\NUL\NULyamashina\NUL\NULyawata\NUL\NUL\NULlg\NUL\NULmie\NULasahi\NUL\NULinabe\NUL\NULise\NUL\NULkameyama\NUL\NULkawagoe\NUL\NULkiho\NUL\NULkisosaki\NUL\NULkiwa\NUL\NULkomono\NUL\NULkumano\NUL\NULkuwana\NUL\NULmatsusaka\NUL\NULmeiwa\NUL\NULmihama\NUL\NULminamiise\NUL\NULmisugi\NUL\NULmiyama\NUL\NULnabari\NUL\NULshima\NUL\NULsuzuka\NUL\NULtado\NUL\NULtaiki\NUL\NULtaki\NUL\NULtamaki\NUL\NULtoba\NUL\NULtsu\NUL\NULudono\NUL\NULureshino\NUL\NULwatarai\NUL\NULyokkaichi\NUL\NUL\NULmiyagi\NULfurukawa\NUL\NULhigashimatsushima\NUL\NULishinomaki\NUL\NULiwanuma\NUL\NULkakuda\NUL\NULkami\NUL\NULkawasaki\NUL\NULkesennuma\NUL\NULmarumori\NUL\NULmatsushima\NUL\NULminamisanriku\NUL\NULmisato\NUL\NULmurata\NUL\NULnatori\NUL\NULogawara\NUL\NULohira\NUL\NULonagawa\NUL\NULosaki\NUL\NULrifu\NUL\NULsemine\NUL\NULshibata\NUL\NULshichikashuku\NUL\NULshikama\NUL\NULshiogama\NUL\NULshiroishi\NUL\NULtagajo\NUL\NULtaiwa\NUL\NULtome\NUL\NULtomiya\NUL\NULwakuya\NUL\NULwatari\NUL\NULyamamoto\NUL\NULzao\NUL\NUL\NULmiyazaki\NULaya\NUL\NULebino\NUL\NULgokase\NUL\NULhyuga\NUL\NULkadogawa\NUL\NULkawaminami\NUL\NULkijo\NUL\NULkitagawa\NUL\NULkitakata\NUL\NULkitaura\NUL\NULkobayashi\NUL\NULkunitomi\NUL\NULkushima\NUL\NULmimata\NUL\NULmiyakonojo\NUL\NULmiyazaki\NUL\NULmorotsuka\NUL\NULnichinan\NUL\NULnishimera\NUL\NULnobeoka\NUL\NULsaito\NUL\NULshiiba\NUL\NULshintomi\NUL\NULtakaharu\NUL\NULtakanabe\NUL\NULtakazaki\NUL\NULtsuno\NUL\NUL\NULnagano\NULachi\NUL\NULagematsu\NUL\NULanan\NUL\NULaoki\NUL\NULasahi\NUL\NULazumino\NUL\NULchikuhoku\NUL\NULchikuma\NUL\NULchino\NUL\NULfujimi\NUL\NULhakuba\NUL\NULhara\NUL\NULhiraya\NUL\NULiida\NUL\NULiijima\NUL\NULiiyama\NUL\NULiizuna\NUL\NULikeda\NUL\NULikusaka\NUL\NULina\NUL\NULkaruizawa\NUL\NULkawakami\NUL\NULkiso\NUL\NULkisofukushima\NUL\NULkitaaiki\NUL\NULkomagane\NUL\NULkomoro\NUL\NULmatsukawa\NUL\NULmatsumoto\NUL\NULmiasa\NUL\NULminamiaiki\NUL\NULminamimaki\NUL\NULminamiminowa\NUL\NULminowa\NUL\NULmiyada\NUL\NULmiyota\NUL\NULmochizuki\NUL\NULnagano\NUL\NULnagawa\NUL\NULnagiso\NUL\NULnakagawa\NUL\NULnakano\NUL\NULnozawaonsen\NUL\NULobuse\NUL\NULogawa\NUL\NULokaya\NUL\NULomachi\NUL\NULomi\NUL\NULookuwa\NUL\NULooshika\NUL\NULotaki\NUL\NULotari\NUL\NULsakae\NUL\NULsakaki\NUL\NULsaku\NUL\NULsakuho\NUL\NULshimosuwa\NUL\NULshinanomachi\NUL\NULshiojiri\NUL\NULsuwa\NUL\NULsuzaka\NUL\NULtakagi\NUL\NULtakamori\NUL\NULtakayama\NUL\NULtateshina\NUL\NULtatsuno\NUL\NULtogakushi\NUL\NULtogura\NUL\NULtomi\NUL\NULueda\NUL\NULwada\NUL\NULyamagata\NUL\NULyamanouchi\NUL\NULyasaka\NUL\NULyasuoka\NUL\NUL\NULnagasaki\NULchijiwa\NUL\NULfutsu\NUL\NULgoto\NUL\NULhasami\NUL\NULhirado\NUL\NULiki\NUL\NULisahaya\NUL\NULkawatana\NUL\NULkuchinotsu\NUL\NULmatsuura\NUL\NULnagasaki\NUL\NULobama\NUL\NULomura\NUL\NULoseto\NUL\NULsaikai\NUL\NULsasebo\NUL\NULseihi\NUL\NULshimabara\NUL\NULshinkamigoto\NUL\NULtogitsu\NUL\NULtsushima\NUL\NULunzen\NUL\NUL\NULnagoya\NUL*\NUL\NUL\NULnara\NULando\NUL\NULgose\NUL\NULheguri\NUL\NULhigashiyoshino\NUL\NULikaruga\NUL\NULikoma\NUL\NULkamikitayama\NUL\NULkanmaki\NUL\NULkashiba\NUL\NULkashihara\NUL\NULkatsuragi\NUL\NULkawai\NUL\NULkawakami\NUL\NULkawanishi\NUL\NULkoryo\NUL\NULkurotaki\NUL\NULmitsue\NUL\NULmiyake\NUL\NULnara\NUL\NULnosegawa\NUL\NULoji\NUL\NULouda\NUL\NULoyodo\NUL\NULsakurai\NUL\NULsango\NUL\NULshimoichi\NUL\NULshimokitayama\NUL\NULshinjo\NUL\NULsoni\NUL\NULtakatori\NUL\NULtawaramoto\NUL\NULtenkawa\NUL\NULtenri\NUL\NULuda\NUL\NULyamatokoriyama\NUL\NULyamatotakada\NUL\NULyamazoe\NUL\NULyoshino\NUL\NUL\NULne\NUL\NULniigata\NULaga\NUL\NULagano\NUL\NULgosen\NUL\NULitoigawa\NUL\NULizumozaki\NUL\NULjoetsu\NUL\NULkamo\NUL\NULkariwa\NUL\NULkashiwazaki\NUL\NULminamiuonuma\NUL\NULmitsuke\NUL\NULmuika\NUL\NULmurakami\NUL\NULmyoko\NUL\NULnagaoka\NUL\NULniigata\NUL\NULojiya\NUL\NULomi\NUL\NULsado\NUL\NULsanjo\NUL\NULseiro\NUL\NULseirou\NUL\NULsekikawa\NUL\NULshibata\NUL\NULtagami\NUL\NULtainai\NUL\NULtochio\NUL\NULtokamachi\NUL\NULtsubame\NUL\NULtsunan\NUL\NULuonuma\NUL\NULyahiko\NUL\NULyoita\NUL\NULyuzawa\NUL\NUL\NULoita\NULbeppu\NUL\NULbungoono\NUL\NULbungotakada\NUL\NULhasama\NUL\NULhiji\NUL\NULhimeshima\NUL\NULhita\NUL\NULkamitsue\NUL\NULkokonoe\NUL\NULkuju\NUL\NULkunisaki\NUL\NULkusu\NUL\NULoita\NUL\NULsaiki\NUL\NULtaketa\NUL\NULtsukumi\NUL\NULusa\NUL\NULusuki\NUL\NULyufu\NUL\NUL\NULokayama\NULakaiwa\NUL\NULasakuchi\NUL\NULbizen\NUL\NULhayashima\NUL\NULibara\NUL\NULkagamino\NUL\NULkasaoka\NUL\NULkibichuo\NUL\NULkumenan\NUL\NULkurashiki\NUL\NULmaniwa\NUL\NULmisaki\NUL\NULnagi\NUL\NULniimi\NUL\NULnishiawakura\NUL\NULokayama\NUL\NULsatosho\NUL\NULsetouchi\NUL\NULshinjo\NUL\NULshoo\NUL\NULsoja\NUL\NULtakahashi\NUL\NULtamano\NUL\NULtsuyama\NUL\NULwake\NUL\NULyakage\NUL\NUL\NULokinawa\NULaguni\NUL\NULginowan\NUL\NULginoza\NUL\NULgushikami\NUL\NULhaebaru\NUL\NULhigashi\NUL\NULhirara\NUL\NULiheya\NUL\NULishigaki\NUL\NULishikawa\NUL\NULitoman\NUL\NULizena\NUL\NULkadena\NUL\NULkin\NUL\NULkitadaito\NUL\NULkitanakagusuku\NUL\NULkumejima\NUL\NULkunigami\NUL\NULminamidaito\NUL\NULmotobu\NUL\NULnago\NUL\NULnaha\NUL\NULnakagusuku\NUL\NULnakijin\NUL\NULnanjo\NUL\NULnishihara\NUL\NULogimi\NUL\NULokinawa\NUL\NULonna\NUL\NULshimoji\NUL\NULtaketomi\NUL\NULtarama\NUL\NULtokashiki\NUL\NULtomigusuku\NUL\NULtonaki\NUL\NULurasoe\NUL\NULuruma\NUL\NULyaese\NUL\NULyomitan\NUL\NULyonabaru\NUL\NULyonaguni\NUL\NULzamami\NUL\NUL\NULor\NUL\NULosaka\NULabeno\NUL\NULchihayaakasaka\NUL\NULchuo\NUL\NULdaito\NUL\NULfujiidera\NUL\NULhabikino\NUL\NULhannan\NUL\NULhigashiosaka\NUL\NULhigashisumiyoshi\NUL\NULhigashiyodogawa\NUL\NULhirakata\NUL\NULibaraki\NUL\NULikeda\NUL\NULizumi\NUL\NULizumiotsu\NUL\NULizumisano\NUL\NULkadoma\NUL\NULkaizuka\NUL\NULkanan\NUL\NULkashiwara\NUL\NULkatano\NUL\NULkawachinagano\NUL\NULkishiwada\NUL\NULkita\NUL\NULkumatori\NUL\NULmatsubara\NUL\NULminato\NUL\NULminoh\NUL\NULmisaki\NUL\NULmoriguchi\NUL\NULneyagawa\NUL\NULnishi\NUL\NULnose\NUL\NULosakasayama\NUL\NULsakai\NUL\NULsayama\NUL\NULsennan\NUL\NULsettsu\NUL\NULshijonawate\NUL\NULshimamoto\NUL\NULsuita\NUL\NULtadaoka\NUL\NULtaishi\NUL\NULtajiri\NUL\NULtakaishi\NUL\NULtakatsuki\NUL\NULtondabayashi\NUL\NULtoyonaka\NUL\NULtoyono\NUL\NULyao\NUL\NUL\NULsaga\NULariake\NUL\NULarita\NUL\NULfukudomi\NUL\NULgenkai\NUL\NULhamatama\NUL\NULhizen\NUL\NULimari\NUL\NULkamimine\NUL\NULkanzaki\NUL\NULkaratsu\NUL\NULkashima\NUL\NULkitagata\NUL\NULkitahata\NUL\NULkiyama\NUL\NULkouhoku\NUL\NULkyuragi\NUL\NULnishiarita\NUL\NULogi\NUL\NULomachi\NUL\NULouchi\NUL\NULsaga\NUL\NULshiroishi\NUL\NULtaku\NUL\NULtara\NUL\NULtosu\NUL\NULyoshinogari\NUL\NUL\NULsaitama\NULarakawa\NUL\NULasaka\NUL\NULchichibu\NUL\NULfujimi\NUL\NULfujimino\NUL\NULfukaya\NUL\NULhanno\NUL\NULhanyu\NUL\NULhasuda\NUL\NULhatogaya\NUL\NULhatoyama\NUL\NULhidaka\NUL\NULhigashichichibu\NUL\NULhigashimatsuyama\NUL\NULhonjo\NUL\NULina\NUL\NULiruma\NUL\NULiwatsuki\NUL\NULkamiizumi\NUL\NULkamikawa\NUL\NULkamisato\NUL\NULkasukabe\NUL\NULkawagoe\NUL\NULkawaguchi\NUL\NULkawajima\NUL\NULkazo\NUL\NULkitamoto\NUL\NULkoshigaya\NUL\NULkounosu\NUL\NULkuki\NUL\NULkumagaya\NUL\NULmatsubushi\NUL\NULminano\NUL\NULmisato\NUL\NULmiyashiro\NUL\NULmiyoshi\NUL\NULmoroyama\NUL\NULnagatoro\NUL\NULnamegawa\NUL\NULniiza\NUL\NULogano\NUL\NULogawa\NUL\NULogose\NUL\NULokegawa\NUL\NULomiya\NUL\NULotaki\NUL\NULranzan\NUL\NULryokami\NUL\NULsaitama\NUL\NULsakado\NUL\NULsatte\NUL\NULsayama\NUL\NULshiki\NUL\NULshiraoka\NUL\NULsoka\NUL\NULsugito\NUL\NULtoda\NUL\NULtokigawa\NUL\NULtokorozawa\NUL\NULtsurugashima\NUL\NULurawa\NUL\NULwarabi\NUL\NULyashio\NUL\NULyokoze\NUL\NULyono\NUL\NULyorii\NUL\NULyoshida\NUL\NULyoshikawa\NUL\NULyoshimi\NUL\NUL\NULsapporo\NUL*\NUL\NUL\NULsendai\NUL*\NUL\NUL\NULshiga\NULaisho\NUL\NULgamo\NUL\NULhigashiomi\NUL\NULhikone\NUL\NULkoka\NUL\NULkonan\NUL\NULkosei\NUL\NULkoto\NUL\NULkusatsu\NUL\NULmaibara\NUL\NULmoriyama\NUL\NULnagahama\NUL\NULnishiazai\NUL\NULnotogawa\NUL\NULomihachiman\NUL\NULotsu\NUL\NULritto\NUL\NULryuoh\NUL\NULtakashima\NUL\NULtakatsuki\NUL\NULtorahime\NUL\NULtoyosato\NUL\NULyasu\NUL\NUL\NULshimane\NULakagi\NUL\NULama\NUL\NULgotsu\NUL\NULhamada\NUL\NULhigashiizumo\NUL\NULhikawa\NUL\NULhikimi\NUL\NULizumo\NUL\NULkakinoki\NUL\NULmasuda\NUL\NULmatsue\NUL\NULmisato\NUL\NULnishinoshima\NUL\NULohda\NUL\NULokinoshima\NUL\NULokuizumo\NUL\NULshimane\NUL\NULtamayu\NUL\NULtsuwano\NUL\NULunnan\NUL\NULyakumo\NUL\NULyasugi\NUL\NULyatsuka\NUL\NUL\NULshizuoka\NULarai\NUL\NULatami\NUL\NULfuji\NUL\NULfujieda\NUL\NULfujikawa\NUL\NULfujinomiya\NUL\NULfukuroi\NUL\NULgotemba\NUL\NULhaibara\NUL\NULhamamatsu\NUL\NULhigashiizu\NUL\NULito\NUL\NULiwata\NUL\NULizu\NUL\NULizunokuni\NUL\NULkakegawa\NUL\NULkannami\NUL\NULkawanehon\NUL\NULkawazu\NUL\NULkikugawa\NUL\NULkosai\NUL\NULmakinohara\NUL\NULmatsuzaki\NUL\NULminamiizu\NUL\NULmishima\NUL\NULmorimachi\NUL\NULnishiizu\NUL\NULnumazu\NUL\NULomaezaki\NUL\NULshimada\NUL\NULshimizu\NUL\NULshimoda\NUL\NULshizuoka\NUL\NULsusono\NUL\NULyaizu\NUL\NULyoshida\NUL\NUL\NULtochigi\NULashikaga\NUL\NULbato\NUL\NULhaga\NUL\NULichikai\NUL\NULiwafune\NUL\NULkaminokawa\NUL\NULkanuma\NUL\NULkarasuyama\NUL\NULkuroiso\NUL\NULmashiko\NUL\NULmibu\NUL\NULmoka\NUL\NULmotegi\NUL\NULnasu\NUL\NULnasushiobara\NUL\NULnikko\NUL\NULnishikata\NUL\NULnogi\NUL\NULohira\NUL\NULohtawara\NUL\NULoyama\NUL\NULsakura\NUL\NULsano\NUL\NULshimotsuke\NUL\NULshioya\NUL\NULtakanezawa\NUL\NULtochigi\NUL\NULtsuga\NUL\NULujiie\NUL\NULutsunomiya\NUL\NULyaita\NUL\NUL\NULtokushima\NULaizumi\NUL\NULanan\NUL\NULichiba\NUL\NULitano\NUL\NULkainan\NUL\NULkomatsushima\NUL\NULmatsushige\NUL\NULmima\NUL\NULminami\NUL\NULmiyoshi\NUL\NULmugi\NUL\NULnakagawa\NUL\NULnaruto\NUL\NULsanagochi\NUL\NULshishikui\NUL\NULtokushima\NUL\NULwajiki\NUL\NUL\NULtokyo\NULadachi\NUL\NULakiruno\NUL\NULakishima\NUL\NULaogashima\NUL\NULarakawa\NUL\NULbunkyo\NUL\NULchiyoda\NUL\NULchofu\NUL\NULchuo\NUL\NULedogawa\NUL\NULfuchu\NUL\NULfussa\NUL\NULhachijo\NUL\NULhachioji\NUL\NULhamura\NUL\NULhigashikurume\NUL\NULhigashimurayama\NUL\NULhigashiyamato\NUL\NULhino\NUL\NULhinode\NUL\NULhinohara\NUL\NULinagi\NUL\NULitabashi\NUL\NULkatsushika\NUL\NULkita\NUL\NULkiyose\NUL\NULkodaira\NUL\NULkoganei\NUL\NULkokubunji\NUL\NULkomae\NUL\NULkoto\NUL\NULkouzushima\NUL\NULkunitachi\NUL\NULmachida\NUL\NULmeguro\NUL\NULminato\NUL\NULmitaka\NUL\NULmizuho\NUL\NULmusashimurayama\NUL\NULmusashino\NUL\NULnakano\NUL\NULnerima\NUL\NULogasawara\NUL\NULokutama\NUL\NULome\NUL\NULoshima\NUL\NULota\NUL\NULsetagaya\NUL\NULshibuya\NUL\NULshinagawa\NUL\NULshinjuku\NUL\NULsuginami\NUL\NULsumida\NUL\NULtachikawa\NUL\NULtaito\NUL\NULtama\NUL\NULtoshima\NUL\NUL\NULtottori\NULchizu\NUL\NULhino\NUL\NULkawahara\NUL\NULkoge\NUL\NULkotoura\NUL\NULmisasa\NUL\NULnanbu\NUL\NULnichinan\NUL\NULsakaiminato\NUL\NULtottori\NUL\NULwakasa\NUL\NULyazu\NUL\NULyonago\NUL\NUL\NULtoyama\NULasahi\NUL\NULfuchu\NUL\NULfukumitsu\NUL\NULfunahashi\NUL\NULhimi\NUL\NULimizu\NUL\NULinami\NUL\NULjohana\NUL\NULkamiichi\NUL\NULkurobe\NUL\NULnakaniikawa\NUL\NULnamerikawa\NUL\NULnanto\NUL\NULnyuzen\NUL\NULoyabe\NUL\NULtaira\NUL\NULtakaoka\NUL\NULtateyama\NUL\NULtoga\NUL\NULtonami\NUL\NULtoyama\NUL\NULunazuki\NUL\NULuozu\NUL\NULyamada\NUL\NUL\NULwakayama\NULarida\NUL\NULaridagawa\NUL\NULgobo\NUL\NULhashimoto\NUL\NULhidaka\NUL\NULhirogawa\NUL\NULinami\NUL\NULiwade\NUL\NULkainan\NUL\NULkamitonda\NUL\NULkatsuragi\NUL\NULkimino\NUL\NULkinokawa\NUL\NULkitayama\NUL\NULkoya\NUL\NULkoza\NUL\NULkozagawa\NUL\NULkudoyama\NUL\NULkushimoto\NUL\NULmihama\NUL\NULmisato\NUL\NULnachikatsuura\NUL\NULshingu\NUL\NULshirahama\NUL\NULtaiji\NUL\NULtanabe\NUL\NULwakayama\NUL\NULyuasa\NUL\NULyura\NUL\NUL\NULxn--0trq7p7nn\NUL\NULxn--1ctwo\NUL\NULxn--1lqs03n\NUL\NULxn--1lqs71d\NUL\NULxn--2m4a15e\NUL\NULxn--32vp30h\NUL\NULxn--4it168d\NUL\NULxn--4it797k\NUL\NULxn--4pvxs\NUL\NULxn--5js045d\NUL\NULxn--5rtp49c\NUL\NULxn--5rtq34k\NUL\NULxn--6btw5a\NUL\NULxn--6orx2r\NUL\NULxn--7t0a264c\NUL\NULxn--8ltr62k\NUL\NULxn--8pvr4u\NUL\NULxn--c3s14m\NUL\NULxn--d5qv7z876c\NUL\NULxn--djrs72d6uy\NUL\NULxn--djty4k\NUL\NULxn--efvn9s\NUL\NULxn--ehqz56n\NUL\NULxn--elqq16h\NUL\NULxn--f6qx53a\NUL\NULxn--k7yn95e\NUL\NULxn--kbrq7o\NUL\NULxn--klt787d\NUL\NULxn--kltp7d\NUL\NULxn--kltx9a\NUL\NULxn--klty5x\NUL\NULxn--mkru45i\NUL\NULxn--nit225k\NUL\NULxn--ntso0iqx3a\NUL\NULxn--ntsq17g\NUL\NULxn--pssu33l\NUL\NULxn--qqqt11m\NUL\NULxn--rht27z\NUL\NULxn--rht3d\NUL\NULxn--rht61e\NUL\NULxn--rny31h\NUL\NULxn--tor131o\NUL\NULxn--uist22h\NUL\NULxn--uisz3g\NUL\NULxn--uuwu58a\NUL\NULxn--vgu402c\NUL\NULxn--zbx025d\NUL\NULyamagata\NULasahi\NUL\NULfunagata\NUL\NULhigashine\NUL\NULiide\NUL\NULkahoku\NUL\NULkaminoyama\NUL\NULkaneyama\NUL\NULkawanishi\NUL\NULmamurogawa\NUL\NULmikawa\NUL\NULmurayama\NUL\NULnagai\NUL\NULnakayama\NUL\NULnanyo\NUL\NULnishikawa\NUL\NULobanazawa\NUL\NULoe\NUL\NULoguni\NUL\NULohkura\NUL\NULoishida\NUL\NULsagae\NUL\NULsakata\NUL\NULsakegawa\NUL\NULshinjo\NUL\NULshirataka\NUL\NULshonai\NUL\NULtakahata\NUL\NULtendo\NUL\NULtozawa\NUL\NULtsuruoka\NUL\NULyamagata\NUL\NULyamanobe\NUL\NULyonezawa\NUL\NULyuza\NUL\NUL\NULyamaguchi\NULabu\NUL\NULhagi\NUL\NULhikari\NUL\NULhofu\NUL\NULiwakuni\NUL\NULkudamatsu\NUL\NULmitou\NUL\NULnagato\NUL\NULoshima\NUL\NULshimonoseki\NUL\NULshunan\NUL\NULtabuse\NUL\NULtokuyama\NUL\NULtoyota\NUL\NULube\NUL\NULyuu\NUL\NUL\NULyamanashi\NULchuo\NUL\NULdoshi\NUL\NULfuefuki\NUL\NULfujikawa\NUL\NULfujikawaguchiko\NUL\NULfujiyoshida\NUL\NULhayakawa\NUL\NULhokuto\NUL\NULichikawamisato\NUL\NULkai\NUL\NULkofu\NUL\NULkoshu\NUL\NULkosuge\NUL\NULminami-alps\NUL\NULminobu\NUL\NULnakamichi\NUL\NULnanbu\NUL\NULnarusawa\NUL\NULnirasaki\NUL\NULnishikatsura\NUL\NULoshino\NUL\NULotsuki\NUL\NULshowa\NUL\NULtabayama\NUL\NULtsuru\NUL\NULuenohara\NUL\NULyamanakako\NUL\NULyamanashi\NUL\NUL\NULyokohama\NUL*\NUL\NUL\NUL\NULjprs\NUL\NULjuegos\NUL\NULkaufen\NUL\NULkddi\NUL\NULke\NUL*\NUL\NUL\NULkfh\NUL\NULkg\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULkh\NUL*\NUL\NUL\NULki\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULnet\NUL\NULorg\NUL\NUL\NULkim\NUL\NULkinder\NUL\NULkitchen\NUL\NULkiwi\NUL\NULkm\NULass\NUL\NULasso\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgouv\NUL\NULgov\NUL\NULmedecin\NUL\NULmil\NUL\NULnom\NUL\NULnotaires\NUL\NULorg\NUL\NULpharmaciens\NUL\NULprd\NUL\NULpresse\NUL\NULtm\NUL\NULveterinaire\NUL\NUL\NULkn\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULkoeln\NUL\NULkomatsu\NUL\NULkp\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULorg\NUL\NULrep\NUL\NULtra\NUL\NUL\NULkpn\NUL\NULkr\NULac\NUL\NULblogspot\NUL\NULbusan\NUL\NULchungbuk\NUL\NULchungnam\NUL\NULco\NUL\NULdaegu\NUL\NULdaejeon\NUL\NULes\NUL\NULgangwon\NUL\NULgo\NUL\NULgwangju\NUL\NULgyeongbuk\NUL\NULgyeonggi\NUL\NULgyeongnam\NUL\NULhs\NUL\NULincheon\NUL\NULjeju\NUL\NULjeonbuk\NUL\NULjeonnam\NUL\NULkg\NUL\NULmil\NUL\NULms\NUL\NULne\NUL\NULor\NUL\NULpe\NUL\NULre\NUL\NULsc\NUL\NULseoul\NUL\NULulsan\NUL\NUL\NULkrd\NUL\NULkred\NUL\NULkw\NUL*\NUL\NUL\NULky\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULkyknet\NUL\NULkyoto\NUL\NULkz\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULla\NULc\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULnet\NUL\NULorg\NUL\NULper\NUL\NUL\NULlacaixa\NUL\NULlancaster\NUL\NULland\NUL\NULlandrover\NUL\NULlasalle\NUL\NULlat\NUL\NULlatrobe\NUL\NULlaw\NUL\NULlawyer\NUL\NULlb\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULlc\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULlds\NUL\NULlease\NUL\NULleclerc\NUL\NULlegal\NUL\NULlgbt\NUL\NULli\NUL\NULliaison\NUL\NULlidl\NUL\NULlife\NUL\NULlifeinsurance\NUL\NULlifestyle\NUL\NULlighting\NUL\NULlike\NUL\NULlimited\NUL\NULlimo\NUL\NULlincoln\NUL\NULlinde\NUL\NULlink\NUL\NULlive\NUL\NULlixil\NUL\NULlk\NULassn\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULgrp\NUL\NULhotel\NUL\NULint\NUL\NULltd\NUL\NULnet\NUL\NULngo\NUL\NULorg\NUL\NULsch\NUL\NULsoc\NUL\NULweb\NUL\NUL\NULloan\NUL\NULloans\NUL\NULlol\NUL\NULlondon\NUL\NULlotte\NUL\NULlotto\NUL\NULlove\NUL\NULlr\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULls\NULco\NUL\NULorg\NUL\NUL\NULlt\NULgov\NUL\NUL\NULltd\NUL\NULltda\NUL\NULlu\NUL\NULlupin\NUL\NULluxe\NUL\NULluxury\NUL\NULlv\NULasn\NUL\NULcom\NUL\NULconf\NUL\NULedu\NUL\NULgov\NUL\NULid\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULly\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULid\NUL\NULmed\NUL\NULnet\NUL\NULorg\NUL\NULplc\NUL\NULsch\NUL\NUL\NULma\NULac\NUL\NULco\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULpress\NUL\NUL\NULmadrid\NUL\NULmaif\NUL\NULmaison\NUL\NULmakeup\NUL\NULman\NUL\NULmanagement\NUL\NULmango\NUL\NULmarket\NUL\NULmarketing\NUL\NULmarkets\NUL\NULmarriott\NUL\NULmba\NUL\NULmc\NULasso\NUL\NULtm\NUL\NUL\NULmd\NUL\NULme\NULac\NUL\NULco\NUL\NULedu\NUL\NULgov\NUL\NULits\NUL\NULnet\NUL\NULorg\NUL\NULpriv\NUL\NUL\NULmedia\NUL\NULmeet\NUL\NULmelbourne\NUL\NULmeme\NUL\NULmemorial\NUL\NULmen\NUL\NULmenu\NUL\NULmeo\NUL\NULmg\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnom\NUL\NULorg\NUL\NULprd\NUL\NULtm\NUL\NUL\NULmh\NUL\NULmiami\NUL\NULmicrosoft\NUL\NULmil\NUL\NULmini\NUL\NULmk\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinf\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NUL\NULml\NULcom\NUL\NULedu\NUL\NULgouv\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULpresse\NUL\NUL\NULmm\NUL*\NUL\NUL\NULmma\NUL\NULmn\NULedu\NUL\NULgov\NUL\NULnyc\NUL\NULorg\NUL\NUL\NULmnet\NUL\NULmo\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmobi\NUL\NULmobily\NUL\NULmoda\NUL\NULmoe\NUL\NULmoi\NUL\NULmonash\NUL\NULmoney\NUL\NULmontblanc\NUL\NULmormon\NUL\NULmortgage\NUL\NULmoscow\NUL\NULmotorcycles\NUL\NULmov\NUL\NULmovie\NUL\NULmovistar\NUL\NULmp\NUL\NULmq\NUL\NULmr\NULblogspot\NUL\NULgov\NUL\NUL\NULms\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmt\NULcom\NUL\NULedu\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmtn\NUL\NULmtpc\NUL\NULmtr\NUL\NULmu\NULac\NUL\NULco\NUL\NULcom\NUL\NULgov\NUL\NULnet\NUL\NULor\NUL\NULorg\NUL\NUL\NULmultichoice\NUL\NULmuseum\NULacademy\NUL\NULagriculture\NUL\NULair\NUL\NULairguard\NUL\NULalabama\NUL\NULalaska\NUL\NULamber\NUL\NULambulance\NUL\NULamerican\NUL\NULamericana\NUL\NULamericanantiques\NUL\NULamericanart\NUL\NULamsterdam\NUL\NULand\NUL\NULannefrank\NUL\NULanthro\NUL\NULanthropology\NUL\NULantiques\NUL\NULaquarium\NUL\NULarboretum\NUL\NULarchaeological\NUL\NULarchaeology\NUL\NULarchitecture\NUL\NULart\NUL\NULartanddesign\NUL\NULartcenter\NUL\NULartdeco\NUL\NULarteducation\NUL\NULartgallery\NUL\NULarts\NUL\NULartsandcrafts\NUL\NULasmatart\NUL\NULassassination\NUL\NULassisi\NUL\NULassociation\NUL\NULastronomy\NUL\NULatlanta\NUL\NULaustin\NUL\NULaustralia\NUL\NULautomotive\NUL\NULaviation\NUL\NULaxis\NUL\NULbadajoz\NUL\NULbaghdad\NUL\NULbahn\NUL\NULbale\NUL\NULbaltimore\NUL\NULbarcelona\NUL\NULbaseball\NUL\NULbasel\NUL\NULbaths\NUL\NULbauern\NUL\NULbeauxarts\NUL\NULbeeldengeluid\NUL\NULbellevue\NUL\NULbergbau\NUL\NULberkeley\NUL\NULberlin\NUL\NULbern\NUL\NULbible\NUL\NULbilbao\NUL\NULbill\NUL\NULbirdart\NUL\NULbirthplace\NUL\NULbonn\NUL\NULboston\NUL\NULbotanical\NUL\NULbotanicalgarden\NUL\NULbotanicgarden\NUL\NULbotany\NUL\NULbrandywinevalley\NUL\NULbrasil\NUL\NULbristol\NUL\NULbritish\NUL\NULbritishcolumbia\NUL\NULbroadcast\NUL\NULbrunel\NUL\NULbrussel\NUL\NULbrussels\NUL\NULbruxelles\NUL\NULbuilding\NUL\NULburghof\NUL\NULbus\NUL\NULbushey\NUL\NULcadaques\NUL\NULcalifornia\NUL\NULcambridge\NUL\NULcan\NUL\NULcanada\NUL\NULcapebreton\NUL\NULcarrier\NUL\NULcartoonart\NUL\NULcasadelamoneda\NUL\NULcastle\NUL\NULcastres\NUL\NULceltic\NUL\NULcenter\NUL\NULchattanooga\NUL\NULcheltenham\NUL\NULchesapeakebay\NUL\NULchicago\NUL\NULchildren\NUL\NULchildrens\NUL\NULchildrensgarden\NUL\NULchiropractic\NUL\NULchocolate\NUL\NULchristiansburg\NUL\NULcincinnati\NUL\NULcinema\NUL\NULcircus\NUL\NULcivilisation\NUL\NULcivilization\NUL\NULcivilwar\NUL\NULclinton\NUL\NULclock\NUL\NULcoal\NUL\NULcoastaldefence\NUL\NULcody\NUL\NULcoldwar\NUL\NULcollection\NUL\NULcolonialwilliamsburg\NUL\NULcoloradoplateau\NUL\NULcolumbia\NUL\NULcolumbus\NUL\NULcommunication\NUL\NULcommunications\NUL\NULcommunity\NUL\NULcomputer\NUL\NULcomputerhistory\NUL\NULcontemporary\NUL\NULcontemporaryart\NUL\NULconvent\NUL\NULcopenhagen\NUL\NULcorporation\NUL\NULcorvette\NUL\NULcostume\NUL\NULcountryestate\NUL\NULcounty\NUL\NULcrafts\NUL\NULcranbrook\NUL\NULcreation\NUL\NULcultural\NUL\NULculturalcenter\NUL\NULculture\NUL\NULcyber\NUL\NULcymru\NUL\NULdali\NUL\NULdallas\NUL\NULdatabase\NUL\NULddr\NUL\NULdecorativearts\NUL\NULdelaware\NUL\NULdelmenhorst\NUL\NULdenmark\NUL\NULdepot\NUL\NULdesign\NUL\NULdetroit\NUL\NULdinosaur\NUL\NULdiscovery\NUL\NULdolls\NUL\NULdonostia\NUL\NULdurham\NUL\NULeastafrica\NUL\NULeastcoast\NUL\NULeducation\NUL\NULeducational\NUL\NULegyptian\NUL\NULeisenbahn\NUL\NULelburg\NUL\NULelvendrell\NUL\NULembroidery\NUL\NULencyclopedic\NUL\NULengland\NUL\NULentomology\NUL\NULenvironment\NUL\NULenvironmentalconservation\NUL\NULepilepsy\NUL\NULessex\NUL\NULestate\NUL\NULethnology\NUL\NULexeter\NUL\NULexhibition\NUL\NULfamily\NUL\NULfarm\NUL\NULfarmequipment\NUL\NULfarmers\NUL\NULfarmstead\NUL\NULfield\NUL\NULfigueres\NUL\NULfilatelia\NUL\NULfilm\NUL\NULfineart\NUL\NULfinearts\NUL\NULfinland\NUL\NULflanders\NUL\NULflorida\NUL\NULforce\NUL\NULfortmissoula\NUL\NULfortworth\NUL\NULfoundation\NUL\NULfrancaise\NUL\NULfrankfurt\NUL\NULfranziskaner\NUL\NULfreemasonry\NUL\NULfreiburg\NUL\NULfribourg\NUL\NULfrog\NUL\NULfundacio\NUL\NULfurniture\NUL\NULgallery\NUL\NULgarden\NUL\NULgateway\NUL\NULgeelvinck\NUL\NULgemological\NUL\NULgeology\NUL\NULgeorgia\NUL\NULgiessen\NUL\NULglas\NUL\NULglass\NUL\NULgorge\NUL\NULgrandrapids\NUL\NULgraz\NUL\NULguernsey\NUL\NULhalloffame\NUL\NULhamburg\NUL\NULhandson\NUL\NULharvestcelebration\NUL\NULhawaii\NUL\NULhealth\NUL\NULheimatunduhren\NUL\NULhellas\NUL\NULhelsinki\NUL\NULhembygdsforbund\NUL\NULheritage\NUL\NULhistoire\NUL\NULhistorical\NUL\NULhistoricalsociety\NUL\NULhistorichouses\NUL\NULhistorisch\NUL\NULhistorisches\NUL\NULhistory\NUL\NULhistoryofscience\NUL\NULhorology\NUL\NULhouse\NUL\NULhumanities\NUL\NULillustration\NUL\NULimageandsound\NUL\NULindian\NUL\NULindiana\NUL\NULindianapolis\NUL\NULindianmarket\NUL\NULintelligence\NUL\NULinteractive\NUL\NULiraq\NUL\NULiron\NUL\NULisleofman\NUL\NULjamison\NUL\NULjefferson\NUL\NULjerusalem\NUL\NULjewelry\NUL\NULjewish\NUL\NULjewishart\NUL\NULjfk\NUL\NULjournalism\NUL\NULjudaica\NUL\NULjudygarland\NUL\NULjuedisches\NUL\NULjuif\NUL\NULkarate\NUL\NULkarikatur\NUL\NULkids\NUL\NULkoebenhavn\NUL\NULkoeln\NUL\NULkunst\NUL\NULkunstsammlung\NUL\NULkunstunddesign\NUL\NULlabor\NUL\NULlabour\NUL\NULlajolla\NUL\NULlancashire\NUL\NULlandes\NUL\NULlans\NUL\NULlarsson\NUL\NULlewismiller\NUL\NULlincoln\NUL\NULlinz\NUL\NULliving\NUL\NULlivinghistory\NUL\NULlocalhistory\NUL\NULlondon\NUL\NULlosangeles\NUL\NULlouvre\NUL\NULloyalist\NUL\NULlucerne\NUL\NULluxembourg\NUL\NULluzern\NUL\NULmad\NUL\NULmadrid\NUL\NULmallorca\NUL\NULmanchester\NUL\NULmansion\NUL\NULmansions\NUL\NULmanx\NUL\NULmarburg\NUL\NULmaritime\NUL\NULmaritimo\NUL\NULmaryland\NUL\NULmarylhurst\NUL\NULmedia\NUL\NULmedical\NUL\NULmedizinhistorisches\NUL\NULmeeres\NUL\NULmemorial\NUL\NULmesaverde\NUL\NULmichigan\NUL\NULmidatlantic\NUL\NULmilitary\NUL\NULmill\NUL\NULminers\NUL\NULmining\NUL\NULminnesota\NUL\NULmissile\NUL\NULmissoula\NUL\NULmodern\NUL\NULmoma\NUL\NULmoney\NUL\NULmonmouth\NUL\NULmonticello\NUL\NULmontreal\NUL\NULmoscow\NUL\NULmotorcycle\NUL\NULmuenchen\NUL\NULmuenster\NUL\NULmulhouse\NUL\NULmuncie\NUL\NULmuseet\NUL\NULmuseumcenter\NUL\NULmuseumvereniging\NUL\NULmusic\NUL\NULnational\NUL\NULnationalfirearms\NUL\NULnationalheritage\NUL\NULnativeamerican\NUL\NULnaturalhistory\NUL\NULnaturalhistorymuseum\NUL\NULnaturalsciences\NUL\NULnature\NUL\NULnaturhistorisches\NUL\NULnatuurwetenschappen\NUL\NULnaumburg\NUL\NULnaval\NUL\NULnebraska\NUL\NULneues\NUL\NULnewhampshire\NUL\NULnewjersey\NUL\NULnewmexico\NUL\NULnewport\NUL\NULnewspaper\NUL\NULnewyork\NUL\NULniepce\NUL\NULnorfolk\NUL\NULnorth\NUL\NULnrw\NUL\NULnuernberg\NUL\NULnuremberg\NUL\NULnyc\NUL\NULnyny\NUL\NULoceanographic\NUL\NULoceanographique\NUL\NULomaha\NUL\NULonline\NUL\NULontario\NUL\NULopenair\NUL\NULoregon\NUL\NULoregontrail\NUL\NULotago\NUL\NULoxford\NUL\NULpacific\NUL\NULpaderborn\NUL\NULpalace\NUL\NULpaleo\NUL\NULpalmsprings\NUL\NULpanama\NUL\NULparis\NUL\NULpasadena\NUL\NULpharmacy\NUL\NULphiladelphia\NUL\NULphiladelphiaarea\NUL\NULphilately\NUL\NULphoenix\NUL\NULphotography\NUL\NULpilots\NUL\NULpittsburgh\NUL\NULplanetarium\NUL\NULplantation\NUL\NULplants\NUL\NULplaza\NUL\NULportal\NUL\NULportland\NUL\NULportlligat\NUL\NULposts-and-telecommunications\NUL\NULpreservation\NUL\NULpresidio\NUL\NULpress\NUL\NULproject\NUL\NULpublic\NUL\NULpubol\NUL\NULquebec\NUL\NULrailroad\NUL\NULrailway\NUL\NULresearch\NUL\NULresistance\NUL\NULriodejaneiro\NUL\NULrochester\NUL\NULrockart\NUL\NULroma\NUL\NULrussia\NUL\NULsaintlouis\NUL\NULsalem\NUL\NULsalvadordali\NUL\NULsalzburg\NUL\NULsandiego\NUL\NULsanfrancisco\NUL\NULsantabarbara\NUL\NULsantacruz\NUL\NULsantafe\NUL\NULsaskatchewan\NUL\NULsatx\NUL\NULsavannahga\NUL\NULschlesisches\NUL\NULschoenbrunn\NUL\NULschokoladen\NUL\NULschool\NUL\NULschweiz\NUL\NULscience\NUL\NULscience-fiction\NUL\NULscienceandhistory\NUL\NULscienceandindustry\NUL\NULsciencecenter\NUL\NULsciencecenters\NUL\NULsciencehistory\NUL\NULsciences\NUL\NULsciencesnaturelles\NUL\NULscotland\NUL\NULseaport\NUL\NULsettlement\NUL\NULsettlers\NUL\NULshell\NUL\NULsherbrooke\NUL\NULsibenik\NUL\NULsilk\NUL\NULski\NUL\NULskole\NUL\NULsociety\NUL\NULsologne\NUL\NULsoundandvision\NUL\NULsouthcarolina\NUL\NULsouthwest\NUL\NULspace\NUL\NULspy\NUL\NULsquare\NUL\NULstadt\NUL\NULstalbans\NUL\NULstarnberg\NUL\NULstate\NUL\NULstateofdelaware\NUL\NULstation\NUL\NULsteam\NUL\NULsteiermark\NUL\NULstjohn\NUL\NULstockholm\NUL\NULstpetersburg\NUL\NULstuttgart\NUL\NULsuisse\NUL\NULsurgeonshall\NUL\NULsurrey\NUL\NULsvizzera\NUL\NULsweden\NUL\NULsydney\NUL\NULtank\NUL\NULtcm\NUL\NULtechnology\NUL\NULtelekommunikation\NUL\NULtelevision\NUL\NULtexas\NUL\NULtextile\NUL\NULtheater\NUL\NULtime\NUL\NULtimekeeping\NUL\NULtopology\NUL\NULtorino\NUL\NULtouch\NUL\NULtown\NUL\NULtransport\NUL\NULtree\NUL\NULtrolley\NUL\NULtrust\NUL\NULtrustee\NUL\NULuhren\NUL\NULulm\NUL\NULundersea\NUL\NULuniversity\NUL\NULusa\NUL\NULusantiques\NUL\NULusarts\NUL\NULuscountryestate\NUL\NULusculture\NUL\NULusdecorativearts\NUL\NULusgarden\NUL\NULushistory\NUL\NULushuaia\NUL\NULuslivinghistory\NUL\NULutah\NUL\NULuvic\NUL\NULvalley\NUL\NULvantaa\NUL\NULversailles\NUL\NULviking\NUL\NULvillage\NUL\NULvirginia\NUL\NULvirtual\NUL\NULvirtuel\NUL\NULvlaanderen\NUL\NULvolkenkunde\NUL\NULwales\NUL\NULwallonie\NUL\NULwar\NUL\NULwashingtondc\NUL\NULwatch-and-clock\NUL\NULwatchandclock\NUL\NULwestern\NUL\NULwestfalen\NUL\NULwhaling\NUL\NULwildlife\NUL\NULwilliamsburg\NUL\NULwindmill\NUL\NULworkshop\NUL\NULxn--9dbhblg6di\NUL\NULxn--comunicaes-v6a2o\NUL\NULxn--correios-e-telecomunicaes-ghc29a\NUL\NULxn--h1aegh\NUL\NULxn--lns-qla\NUL\NULyork\NUL\NULyorkshire\NUL\NULyosemite\NUL\NULyouth\NUL\NULzoological\NUL\NULzoology\NUL\NUL\NULmutual\NUL\NULmv\NULaero\NUL\NULbiz\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULmil\NUL\NULmuseum\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NUL\NULmw\NULac\NUL\NULbiz\NUL\NULco\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgov\NUL\NULint\NUL\NULmuseum\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmx\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmy\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmz\NUL*\NUL\NUL\NULmzansimagic\NUL\NULna\NULca\NUL\NULcc\NUL\NULco\NUL\NULcom\NUL\NULdr\NUL\NULin\NUL\NULinfo\NUL\NULmobi\NUL\NULmx\NUL\NULname\NUL\NULor\NUL\NULorg\NUL\NULpro\NUL\NULschool\NUL\NULtv\NUL\NULus\NUL\NULws\NUL\NUL\NULnadex\NUL\NULnagoya\NUL\NULname\NULher\NULforgot\NUL\NUL\NULhis\NULforgot\NUL\NUL\NUL\NULnaspers\NUL\NULnatura\NUL\NULnavy\NUL\NULnc\NULasso\NUL\NUL\NULne\NUL\NULnec\NUL\NULnet\NULat-band-camp\NUL\NULazure-mobile\NUL\NULazurewebsites\NUL\NULblogdns\NUL\NULbroke-it\NUL\NULbuyshouses\NUL\NULcloudapp\NUL\NULcloudfront\NUL\NULdnsalias\NUL\NULdnsdojo\NUL\NULdoes-it\NUL\NULdontexist\NUL\NULdynalias\NUL\NULdynathome\NUL\NULendofinternet\NUL\NULfastly\NULprod\NULa\NUL\NULglobal\NUL\NUL\NULssl\NULa\NUL\NULb\NUL\NULglobal\NUL\NUL\NUL\NULfrom-az\NUL\NULfrom-co\NUL\NULfrom-la\NUL\NULfrom-ny\NUL\NULgb\NUL\NULgets-it\NUL\NULham-radio-op\NUL\NULhomeftp\NUL\NULhomeip\NUL\NULhomelinux\NUL\NULhomeunix\NUL\NULhu\NUL\NULin\NUL\NULin-the-band\NUL\NULis-a-chef\NUL\NULis-a-geek\NUL\NULisa-geek\NUL\NULjp\NUL\NULkicks-ass\NUL\NULoffice-on-the\NUL\NULpodzone\NUL\NULscrapper-site\NUL\NULse\NUL\NULselfip\NUL\NULsells-it\NUL\NULservebbs\NUL\NULserveftp\NUL\NULthruhere\NUL\NULuk\NUL\NULwebhop\NUL\NULza\NUL\NUL\NULnetbank\NUL\NULnetwork\NUL\NULneustar\NUL\NULnew\NUL\NULnews\NUL\NULnexus\NUL\NULnf\NULarts\NUL\NULcom\NUL\NULfirm\NUL\NULinfo\NUL\NULnet\NUL\NULother\NUL\NULper\NUL\NULrec\NUL\NULstore\NUL\NULweb\NUL\NUL\NULng\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULmobi\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NUL\NULngo\NUL\NULnhk\NUL\NULni\NUL*\NUL\NUL\NULnico\NUL\NULninja\NUL\NULnissan\NUL\NULnl\NULblogspot\NUL\NULbv\NUL\NULco\NUL\NUL\NULno\NULaa\NULgs\NUL\NUL\NULaarborte\NUL\NULaejrie\NUL\NULafjord\NUL\NULagdenes\NUL\NULah\NULgs\NUL\NUL\NULakershus\NULnes\NUL\NUL\NULaknoluokta\NUL\NULakrehamn\NUL\NULal\NUL\NULalaheadju\NUL\NULalesund\NUL\NULalgard\NUL\NULalstahaug\NUL\NULalta\NUL\NULalvdal\NUL\NULamli\NUL\NULamot\NUL\NULandasuolo\NUL\NULandebu\NUL\NULandoy\NUL\NULardal\NUL\NULaremark\NUL\NULarendal\NUL\NULarna\NUL\NULaseral\NUL\NULasker\NUL\NULaskim\NUL\NULaskoy\NUL\NULaskvoll\NUL\NULasnes\NUL\NULaudnedaln\NUL\NULaukra\NUL\NULaure\NUL\NULaurland\NUL\NULaurskog-holand\NUL\NULaustevoll\NUL\NULaustrheim\NUL\NULaveroy\NUL\NULbadaddja\NUL\NULbahcavuotna\NUL\NULbahccavuotna\NUL\NULbaidar\NUL\NULbajddar\NUL\NULbalat\NUL\NULbalestrand\NUL\NULballangen\NUL\NULbalsfjord\NUL\NULbamble\NUL\NULbardu\NUL\NULbarum\NUL\NULbatsfjord\NUL\NULbearalvahki\NUL\NULbeardu\NUL\NULbeiarn\NUL\NULberg\NUL\NULbergen\NUL\NULberlevag\NUL\NULbievat\NUL\NULbindal\NUL\NULbirkenes\NUL\NULbjarkoy\NUL\NULbjerkreim\NUL\NULbjugn\NUL\NULblogspot\NUL\NULbodo\NUL\NULbokn\NUL\NULbomlo\NUL\NULbremanger\NUL\NULbronnoy\NUL\NULbronnoysund\NUL\NULbrumunddal\NUL\NULbryne\NUL\NULbu\NULgs\NUL\NUL\NULbudejju\NUL\NULbuskerud\NULnes\NUL\NUL\NULbygland\NUL\NULbykle\NUL\NULcahcesuolo\NUL\NULco\NUL\NULdavvenjarga\NUL\NULdavvesiida\NUL\NULdeatnu\NUL\NULdep\NUL\NULdielddanuorri\NUL\NULdivtasvuodna\NUL\NULdivttasvuotna\NUL\NULdonna\NUL\NULdovre\NUL\NULdrammen\NUL\NULdrangedal\NUL\NULdrobak\NUL\NULdyroy\NUL\NULegersund\NUL\NULeid\NUL\NULeidfjord\NUL\NULeidsberg\NUL\NULeidskog\NUL\NULeidsvoll\NUL\NULeigersund\NUL\NULelverum\NUL\NULenebakk\NUL\NULengerdal\NUL\NULetne\NUL\NULetnedal\NUL\NULevenassi\NUL\NULevenes\NUL\NULevje-og-hornnes\NUL\NULfarsund\NUL\NULfauske\NUL\NULfedje\NUL\NULfet\NUL\NULfetsund\NUL\NULfhs\NUL\NULfinnoy\NUL\NULfitjar\NUL\NULfjaler\NUL\NULfjell\NUL\NULfla\NUL\NULflakstad\NUL\NULflatanger\NUL\NULflekkefjord\NUL\NULflesberg\NUL\NULflora\NUL\NULfloro\NUL\NULfm\NULgs\NUL\NUL\NULfolkebibl\NUL\NULfolldal\NUL\NULforde\NUL\NULforsand\NUL\NULfosnes\NUL\NULfrana\NUL\NULfredrikstad\NUL\NULfrei\NUL\NULfrogn\NUL\NULfroland\NUL\NULfrosta\NUL\NULfroya\NUL\NULfuoisku\NUL\NULfuossko\NUL\NULfusa\NUL\NULfylkesbibl\NUL\NULfyresdal\NUL\NULgaivuotna\NUL\NULgalsa\NUL\NULgamvik\NUL\NULgangaviika\NUL\NULgaular\NUL\NULgausdal\NUL\NULgiehtavuoatna\NUL\NULgildeskal\NUL\NULgiske\NUL\NULgjemnes\NUL\NULgjerdrum\NUL\NULgjerstad\NUL\NULgjesdal\NUL\NULgjovik\NUL\NULgloppen\NUL\NULgol\NUL\NULgran\NUL\NULgrane\NUL\NULgranvin\NUL\NULgratangen\NUL\NULgrimstad\NUL\NULgrong\NUL\NULgrue\NUL\NULgulen\NUL\NULguovdageaidnu\NUL\NULha\NUL\NULhabmer\NUL\NULhadsel\NUL\NULhagebostad\NUL\NULhalden\NUL\NULhalsa\NUL\NULhamar\NUL\NULhamaroy\NUL\NULhammarfeasta\NUL\NULhammerfest\NUL\NULhapmir\NUL\NULharam\NUL\NULhareid\NUL\NULharstad\NUL\NULhasvik\NUL\NULhattfjelldal\NUL\NULhaugesund\NUL\NULhedmark\NULos\NUL\NULvaler\NUL\NULxn--vler-qoa\NUL\NUL\NULhemne\NUL\NULhemnes\NUL\NULhemsedal\NUL\NULherad\NUL\NULhitra\NUL\NULhjartdal\NUL\NULhjelmeland\NUL\NULhl\NULgs\NUL\NUL\NULhm\NULgs\NUL\NUL\NULhobol\NUL\NULhof\NUL\NULhokksund\NUL\NULhol\NUL\NULhole\NUL\NULholmestrand\NUL\NULholtalen\NUL\NULhonefoss\NUL\NULhordaland\NULos\NUL\NUL\NULhornindal\NUL\NULhorten\NUL\NULhoyanger\NUL\NULhoylandet\NUL\NULhurdal\NUL\NULhurum\NUL\NULhvaler\NUL\NULhyllestad\NUL\NULibestad\NUL\NULidrett\NUL\NULinderoy\NUL\NULiveland\NUL\NULivgu\NUL\NULjan-mayen\NULgs\NUL\NUL\NULjessheim\NUL\NULjevnaker\NUL\NULjolster\NUL\NULjondal\NUL\NULjorpeland\NUL\NULkafjord\NUL\NULkarasjohka\NUL\NULkarasjok\NUL\NULkarlsoy\NUL\NULkarmoy\NUL\NULkautokeino\NUL\NULkirkenes\NUL\NULklabu\NUL\NULklepp\NUL\NULkommune\NUL\NULkongsberg\NUL\NULkongsvinger\NUL\NULkopervik\NUL\NULkraanghke\NUL\NULkragero\NUL\NULkristiansand\NUL\NULkristiansund\NUL\NULkrodsherad\NUL\NULkrokstadelva\NUL\NULkvafjord\NUL\NULkvalsund\NUL\NULkvam\NUL\NULkvanangen\NUL\NULkvinesdal\NUL\NULkvinnherad\NUL\NULkviteseid\NUL\NULkvitsoy\NUL\NULlaakesvuemie\NUL\NULlahppi\NUL\NULlangevag\NUL\NULlardal\NUL\NULlarvik\NUL\NULlavagis\NUL\NULlavangen\NUL\NULleangaviika\NUL\NULlebesby\NUL\NULleikanger\NUL\NULleirfjord\NUL\NULleirvik\NUL\NULleka\NUL\NULleksvik\NUL\NULlenvik\NUL\NULlerdal\NUL\NULlesja\NUL\NULlevanger\NUL\NULlier\NUL\NULlierne\NUL\NULlillehammer\NUL\NULlillesand\NUL\NULlindas\NUL\NULlindesnes\NUL\NULloabat\NUL\NULlodingen\NUL\NULlom\NUL\NULloppa\NUL\NULlorenskog\NUL\NULloten\NUL\NULlund\NUL\NULlunner\NUL\NULluroy\NUL\NULluster\NUL\NULlyngdal\NUL\NULlyngen\NUL\NULmalatvuopmi\NUL\NULmalselv\NUL\NULmalvik\NUL\NULmandal\NUL\NULmarker\NUL\NULmarnardal\NUL\NULmasfjorden\NUL\NULmasoy\NUL\NULmatta-varjjat\NUL\NULmeland\NUL\NULmeldal\NUL\NULmelhus\NUL\NULmeloy\NUL\NULmeraker\NUL\NULmidsund\NUL\NULmidtre-gauldal\NUL\NULmil\NUL\NULmjondalen\NUL\NULmo-i-rana\NUL\NULmoareke\NUL\NULmodalen\NUL\NULmodum\NUL\NULmolde\NUL\NULmore-og-romsdal\NULheroy\NUL\NULsande\NUL\NUL\NULmosjoen\NUL\NULmoskenes\NUL\NULmoss\NUL\NULmosvik\NUL\NULmr\NULgs\NUL\NUL\NULmuosat\NUL\NULmuseum\NUL\NULnaamesjevuemie\NUL\NULnamdalseid\NUL\NULnamsos\NUL\NULnamsskogan\NUL\NULnannestad\NUL\NULnaroy\NUL\NULnarviika\NUL\NULnarvik\NUL\NULnaustdal\NUL\NULnavuotna\NUL\NULnedre-eiker\NUL\NULnesna\NUL\NULnesodden\NUL\NULnesoddtangen\NUL\NULnesseby\NUL\NULnesset\NUL\NULnissedal\NUL\NULnittedal\NUL\NULnl\NULgs\NUL\NUL\NULnord-aurdal\NUL\NULnord-fron\NUL\NULnord-odal\NUL\NULnorddal\NUL\NULnordkapp\NUL\NULnordland\NULbo\NUL\NULheroy\NUL\NULxn--b-5ga\NUL\NULxn--hery-ira\NUL\NUL\NULnordre-land\NUL\NULnordreisa\NUL\NULnore-og-uvdal\NUL\NULnotodden\NUL\NULnotteroy\NUL\NULnt\NULgs\NUL\NUL\NULodda\NUL\NULof\NULgs\NUL\NUL\NULoksnes\NUL\NULol\NULgs\NUL\NUL\NULomasvuotna\NUL\NULoppdal\NUL\NULoppegard\NUL\NULorkanger\NUL\NULorkdal\NUL\NULorland\NUL\NULorskog\NUL\NULorsta\NUL\NULosen\NUL\NULoslo\NULgs\NUL\NUL\NULosoyro\NUL\NULosteroy\NUL\NULostfold\NULvaler\NUL\NUL\NULostre-toten\NUL\NULoverhalla\NUL\NULovre-eiker\NUL\NULoyer\NUL\NULoygarden\NUL\NULoystre-slidre\NUL\NULporsanger\NUL\NULporsangu\NUL\NULporsgrunn\NUL\NULpriv\NUL\NULrade\NUL\NULradoy\NUL\NULrahkkeravju\NUL\NULraholt\NUL\NULraisa\NUL\NULrakkestad\NUL\NULralingen\NUL\NULrana\NUL\NULrandaberg\NUL\NULrauma\NUL\NULrendalen\NUL\NULrennebu\NUL\NULrennesoy\NUL\NULrindal\NUL\NULringebu\NUL\NULringerike\NUL\NULringsaker\NUL\NULrisor\NUL\NULrissa\NUL\NULrl\NULgs\NUL\NUL\NULroan\NUL\NULrodoy\NUL\NULrollag\NUL\NULromsa\NUL\NULromskog\NUL\NULroros\NUL\NULrost\NUL\NULroyken\NUL\NULroyrvik\NUL\NULruovat\NUL\NULrygge\NUL\NULsalangen\NUL\NULsalat\NUL\NULsaltdal\NUL\NULsamnanger\NUL\NULsandefjord\NUL\NULsandnes\NUL\NULsandnessjoen\NUL\NULsandoy\NUL\NULsarpsborg\NUL\NULsauda\NUL\NULsauherad\NUL\NULsel\NUL\NULselbu\NUL\NULselje\NUL\NULseljord\NUL\NULsf\NULgs\NUL\NUL\NULsiellak\NUL\NULsigdal\NUL\NULsiljan\NUL\NULsirdal\NUL\NULskanit\NUL\NULskanland\NUL\NULskaun\NUL\NULskedsmo\NUL\NULskedsmokorset\NUL\NULski\NUL\NULskien\NUL\NULskierva\NUL\NULskiptvet\NUL\NULskjak\NUL\NULskjervoy\NUL\NULskodje\NUL\NULslattum\NUL\NULsmola\NUL\NULsnaase\NUL\NULsnasa\NUL\NULsnillfjord\NUL\NULsnoasa\NUL\NULsogndal\NUL\NULsogne\NUL\NULsokndal\NUL\NULsola\NUL\NULsolund\NUL\NULsomna\NUL\NULsondre-land\NUL\NULsongdalen\NUL\NULsor-aurdal\NUL\NULsor-fron\NUL\NULsor-odal\NUL\NULsor-varanger\NUL\NULsorfold\NUL\NULsorreisa\NUL\NULsortland\NUL\NULsorum\NUL\NULspjelkavik\NUL\NULspydeberg\NUL\NULst\NULgs\NUL\NUL\NULstange\NUL\NULstat\NUL\NULstathelle\NUL\NULstavanger\NUL\NULstavern\NUL\NULsteigen\NUL\NULsteinkjer\NUL\NULstjordal\NUL\NULstjordalshalsen\NUL\NULstokke\NUL\NULstor-elvdal\NUL\NULstord\NUL\NULstordal\NUL\NULstorfjord\NUL\NULstrand\NUL\NULstranda\NUL\NULstryn\NUL\NULsula\NUL\NULsuldal\NUL\NULsund\NUL\NULsunndal\NUL\NULsurnadal\NUL\NULsvalbard\NULgs\NUL\NUL\NULsveio\NUL\NULsvelvik\NUL\NULsykkylven\NUL\NULtana\NUL\NULtananger\NUL\NULtelemark\NULbo\NUL\NULxn--b-5ga\NUL\NUL\NULtime\NUL\NULtingvoll\NUL\NULtinn\NUL\NULtjeldsund\NUL\NULtjome\NUL\NULtm\NULgs\NUL\NUL\NULtokke\NUL\NULtolga\NUL\NULtonsberg\NUL\NULtorsken\NUL\NULtr\NULgs\NUL\NUL\NULtrana\NUL\NULtranby\NUL\NULtranoy\NUL\NULtroandin\NUL\NULtrogstad\NUL\NULtromsa\NUL\NULtromso\NUL\NULtrondheim\NUL\NULtrysil\NUL\NULtvedestrand\NUL\NULtydal\NUL\NULtynset\NUL\NULtysfjord\NUL\NULtysnes\NUL\NULtysvar\NUL\NULullensaker\NUL\NULullensvang\NUL\NULulvik\NUL\NULunjarga\NUL\NULutsira\NUL\NULva\NULgs\NUL\NUL\NULvaapste\NUL\NULvadso\NUL\NULvaga\NUL\NULvagan\NUL\NULvagsoy\NUL\NULvaksdal\NUL\NULvalle\NUL\NULvang\NUL\NULvanylven\NUL\NULvardo\NUL\NULvarggat\NUL\NULvaroy\NUL\NULvefsn\NUL\NULvega\NUL\NULvegarshei\NUL\NULvennesla\NUL\NULverdal\NUL\NULverran\NUL\NULvestby\NUL\NULvestfold\NULsande\NUL\NUL\NULvestnes\NUL\NULvestre-slidre\NUL\NULvestre-toten\NUL\NULvestvagoy\NUL\NULvevelstad\NUL\NULvf\NULgs\NUL\NUL\NULvgs\NUL\NULvik\NUL\NULvikna\NUL\NULvindafjord\NUL\NULvoagat\NUL\NULvolda\NUL\NULvoss\NUL\NULvossevangen\NUL\NULxn--andy-ira\NUL\NULxn--asky-ira\NUL\NULxn--aurskog-hland-jnb\NUL\NULxn--avery-yua\NUL\NULxn--bdddj-mrabd\NUL\NULxn--bearalvhki-y4a\NUL\NULxn--berlevg-jxa\NUL\NULxn--bhcavuotna-s4a\NUL\NULxn--bhccavuotna-k7a\NUL\NULxn--bidr-5nac\NUL\NULxn--bievt-0qa\NUL\NULxn--bjarky-fya\NUL\NULxn--bjddar-pta\NUL\NULxn--blt-elab\NUL\NULxn--bmlo-gra\NUL\NULxn--bod-2na\NUL\NULxn--brnny-wuac\NUL\NULxn--brnnysund-m8ac\NUL\NULxn--brum-voa\NUL\NULxn--btsfjord-9za\NUL\NULxn--davvenjrga-y4a\NUL\NULxn--dnna-gra\NUL\NULxn--drbak-wua\NUL\NULxn--dyry-ira\NUL\NULxn--eveni-0qa01ga\NUL\NULxn--finny-yua\NUL\NULxn--fjord-lra\NUL\NULxn--fl-zia\NUL\NULxn--flor-jra\NUL\NULxn--frde-gra\NUL\NULxn--frna-woa\NUL\NULxn--frya-hra\NUL\NULxn--ggaviika-8ya47h\NUL\NULxn--gildeskl-g0a\NUL\NULxn--givuotna-8ya\NUL\NULxn--gjvik-wua\NUL\NULxn--gls-elac\NUL\NULxn--h-2fa\NUL\NULxn--hbmer-xqa\NUL\NULxn--hcesuolo-7ya35b\NUL\NULxn--hgebostad-g3a\NUL\NULxn--hmmrfeasta-s4ac\NUL\NULxn--hnefoss-q1a\NUL\NULxn--hobl-ira\NUL\NULxn--holtlen-hxa\NUL\NULxn--hpmir-xqa\NUL\NULxn--hyanger-q1a\NUL\NULxn--hylandet-54a\NUL\NULxn--indery-fya\NUL\NULxn--jlster-bya\NUL\NULxn--jrpeland-54a\NUL\NULxn--karmy-yua\NUL\NULxn--kfjord-iua\NUL\NULxn--klbu-woa\NUL\NULxn--koluokta-7ya57h\NUL\NULxn--krager-gya\NUL\NULxn--kranghke-b0a\NUL\NULxn--krdsherad-m8a\NUL\NULxn--krehamn-dxa\NUL\NULxn--krjohka-hwab49j\NUL\NULxn--ksnes-uua\NUL\NULxn--kvfjord-nxa\NUL\NULxn--kvitsy-fya\NUL\NULxn--kvnangen-k0a\NUL\NULxn--l-1fa\NUL\NULxn--laheadju-7ya\NUL\NULxn--langevg-jxa\NUL\NULxn--ldingen-q1a\NUL\NULxn--leagaviika-52b\NUL\NULxn--lesund-hua\NUL\NULxn--lgrd-poac\NUL\NULxn--lhppi-xqa\NUL\NULxn--linds-pra\NUL\NULxn--loabt-0qa\NUL\NULxn--lrdal-sra\NUL\NULxn--lrenskog-54a\NUL\NULxn--lt-liac\NUL\NULxn--lten-gra\NUL\NULxn--lury-ira\NUL\NULxn--mely-ira\NUL\NULxn--merker-kua\NUL\NULxn--mjndalen-64a\NUL\NULxn--mlatvuopmi-s4a\NUL\NULxn--mli-tla\NUL\NULxn--mlselv-iua\NUL\NULxn--moreke-jua\NUL\NULxn--mosjen-eya\NUL\NULxn--mot-tla\NUL\NULxn--mre-og-romsdal-qqb\NULsande\NUL\NULxn--hery-ira\NUL\NUL\NULxn--msy-ula0h\NUL\NULxn--mtta-vrjjat-k7af\NUL\NULxn--muost-0qa\NUL\NULxn--nmesjevuemie-tcba\NUL\NULxn--nry-yla5g\NUL\NULxn--nttery-byae\NUL\NULxn--nvuotna-hwa\NUL\NULxn--oppegrd-ixa\NUL\NULxn--ostery-fya\NUL\NULxn--osyro-wua\NUL\NULxn--porsgu-sta26f\NUL\NULxn--rady-ira\NUL\NULxn--rdal-poa\NUL\NULxn--rde-ula\NUL\NULxn--rdy-0nab\NUL\NULxn--rennesy-v1a\NUL\NULxn--rhkkervju-01af\NUL\NULxn--rholt-mra\NUL\NULxn--risa-5na\NUL\NULxn--risr-ira\NUL\NULxn--rland-uua\NUL\NULxn--rlingen-mxa\NUL\NULxn--rmskog-bya\NUL\NULxn--rros-gra\NUL\NULxn--rskog-uua\NUL\NULxn--rst-0na\NUL\NULxn--rsta-fra\NUL\NULxn--ryken-vua\NUL\NULxn--ryrvik-bya\NUL\NULxn--s-1fa\NUL\NULxn--sandnessjen-ogb\NUL\NULxn--sandy-yua\NUL\NULxn--seral-lra\NUL\NULxn--sgne-gra\NUL\NULxn--skierv-uta\NUL\NULxn--skjervy-v1a\NUL\NULxn--skjk-soa\NUL\NULxn--sknit-yqa\NUL\NULxn--sknland-fxa\NUL\NULxn--slat-5na\NUL\NULxn--slt-elab\NUL\NULxn--smla-hra\NUL\NULxn--smna-gra\NUL\NULxn--snase-nra\NUL\NULxn--sndre-land-0cb\NUL\NULxn--snes-poa\NUL\NULxn--snsa-roa\NUL\NULxn--sr-aurdal-l8a\NUL\NULxn--sr-fron-q1a\NUL\NULxn--sr-odal-q1a\NUL\NULxn--sr-varanger-ggb\NUL\NULxn--srfold-bya\NUL\NULxn--srreisa-q1a\NUL\NULxn--srum-gra\NUL\NULxn--stfold-9xa\NULxn--vler-qoa\NUL\NUL\NULxn--stjrdal-s1a\NUL\NULxn--stjrdalshalsen-sqb\NUL\NULxn--stre-toten-zcb\NUL\NULxn--tjme-hra\NUL\NULxn--tnsberg-q1a\NUL\NULxn--trany-yua\NUL\NULxn--trgstad-r1a\NUL\NULxn--trna-woa\NUL\NULxn--troms-zua\NUL\NULxn--tysvr-vra\NUL\NULxn--unjrga-rta\NUL\NULxn--vads-jra\NUL\NULxn--vard-jra\NUL\NULxn--vegrshei-c0a\NUL\NULxn--vestvgy-ixa6o\NUL\NULxn--vg-yiab\NUL\NULxn--vgan-qoa\NUL\NULxn--vgsy-qoa0j\NUL\NULxn--vre-eiker-k8a\NUL\NULxn--vrggt-xqad\NUL\NULxn--vry-yla5g\NUL\NULxn--yer-zna\NUL\NULxn--ygarden-p1a\NUL\NULxn--ystre-slidre-ujb\NUL\NUL\NULnokia\NUL\NULnorton\NUL\NULnowruz\NUL\NULnp\NUL*\NUL\NUL\NULnr\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULnet\NUL\NULorg\NUL\NUL\NULnra\NUL\NULnrw\NUL\NULntt\NUL\NULnu\NULmerseine\NUL\NULmine\NUL\NULshacknet\NUL\NUL\NULnyc\NUL\NULnz\NULac\NUL\NULco\NULblogspot\NUL\NUL\NULcri\NUL\NULgeek\NUL\NULgen\NUL\NULgovt\NUL\NULhealth\NUL\NULiwi\NUL\NULkiwi\NUL\NULmaori\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULparliament\NUL\NULschool\NUL\NULxn--mori-qsa\NUL\NUL\NULobi\NUL\NULoffice\NUL\NULokinawa\NUL\NULom\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmed\NUL\NULmuseum\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NUL\NULomega\NUL\NULone\NUL\NULong\NUL\NULonl\NUL\NULonline\NUL\NULooo\NUL\NULoracle\NUL\NULorange\NUL\NULorg\NULae\NUL\NULblogdns\NUL\NULblogsite\NUL\NULboldlygoingnowhere\NUL\NULdnsalias\NUL\NULdnsdojo\NUL\NULdoesntexist\NUL\NULdontexist\NUL\NULdoomdns\NUL\NULdvrdns\NUL\NULdynalias\NUL\NULdyndns\NULgo\NUL\NULhome\NUL\NUL\NULendofinternet\NUL\NULendoftheinternet\NUL\NULfrom-me\NUL\NULgame-host\NUL\NULgotdns\NUL\NULhk\NUL\NULhobby-site\NUL\NULhomedns\NUL\NULhomeftp\NUL\NULhomelinux\NUL\NULhomeunix\NUL\NULis-a-bruinsfan\NUL\NULis-a-candidate\NUL\NULis-a-celticsfan\NUL\NULis-a-chef\NUL\NULis-a-geek\NUL\NULis-a-knight\NUL\NULis-a-linux-user\NUL\NULis-a-patsfan\NUL\NULis-a-soxfan\NUL\NULis-found\NUL\NULis-lost\NUL\NULis-saved\NUL\NULis-very-bad\NUL\NULis-very-evil\NUL\NULis-very-good\NUL\NULis-very-nice\NUL\NULis-very-sweet\NUL\NULisa-geek\NUL\NULkicks-ass\NUL\NULmisconfused\NUL\NULpodzone\NUL\NULreadmyblog\NUL\NULselfip\NUL\NULsellsyourhome\NUL\NULservebbs\NUL\NULserveftp\NUL\NULservegame\NUL\NULstuff-4-sale\NUL\NULus\NUL\NULwebhop\NUL\NULza\NUL\NUL\NULorganic\NUL\NULorientexpress\NUL\NULosaka\NUL\NULotsuka\NUL\NULovh\NUL\NULpa\NULabo\NUL\NULac\NUL\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULing\NUL\NULmed\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NULsld\NUL\NUL\NULpage\NUL\NULpamperedchef\NUL\NULpanerai\NUL\NULparis\NUL\NULpars\NUL\NULpartners\NUL\NULparts\NUL\NULparty\NUL\NULpassagens\NUL\NULpayu\NUL\NULpe\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULmil\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NUL\NULpf\NULcom\NUL\NULedu\NUL\NULorg\NUL\NUL\NULpg\NUL*\NUL\NUL\NULph\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULi\NUL\NULmil\NUL\NULnet\NUL\NULngo\NUL\NULorg\NUL\NUL\NULpharmacy\NUL\NULphilips\NUL\NULphoto\NUL\NULphotography\NUL\NULphotos\NUL\NULphysio\NUL\NULpiaget\NUL\NULpics\NUL\NULpictet\NUL\NULpictures\NUL\NULpid\NUL\NULpin\NUL\NULpink\NUL\NULpizza\NUL\NULpk\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULfam\NUL\NULgob\NUL\NULgok\NUL\NULgon\NUL\NULgop\NUL\NULgos\NUL\NULgov\NUL\NULinfo\NUL\NULnet\NUL\NULorg\NUL\NULweb\NUL\NUL\NULpl\NULagro\NUL\NULaid\NUL\NULart\NUL\NULatm\NUL\NULaugustow\NUL\NULauto\NUL\NULbabia-gora\NUL\NULbedzin\NUL\NULbeskidy\NUL\NULbialowieza\NUL\NULbialystok\NUL\NULbielawa\NUL\NULbieszczady\NUL\NULbiz\NUL\NULboleslawiec\NUL\NULbydgoszcz\NUL\NULbytom\NUL\NULcieszyn\NUL\NULco\NUL\NULcom\NUL\NULczeladz\NUL\NULczest\NUL\NULdlugoleka\NUL\NULedu\NUL\NULelblag\NUL\NULelk\NUL\NULgda\NUL\NULgdansk\NUL\NULgdynia\NUL\NULgliwice\NUL\NULglogow\NUL\NULgmina\NUL\NULgniezno\NUL\NULgorlice\NUL\NULgov\NULpa\NUL\NULpo\NUL\NULso\NUL\NULsr\NUL\NULstarostwo\NUL\NULug\NUL\NULum\NUL\NULupow\NUL\NULuw\NUL\NUL\NULgrajewo\NUL\NULgsm\NUL\NULilawa\NUL\NULinfo\NUL\NULjaworzno\NUL\NULjelenia-gora\NUL\NULjgora\NUL\NULkalisz\NUL\NULkarpacz\NUL\NULkartuzy\NUL\NULkaszuby\NUL\NULkatowice\NUL\NULkazimierz-dolny\NUL\NULkepno\NUL\NULketrzyn\NUL\NULklodzko\NUL\NULkobierzyce\NUL\NULkolobrzeg\NUL\NULkonin\NUL\NULkonskowola\NUL\NULkrakow\NUL\NULkutno\NUL\NULlapy\NUL\NULlebork\NUL\NULlegnica\NUL\NULlezajsk\NUL\NULlimanowa\NUL\NULlomza\NUL\NULlowicz\NUL\NULlubin\NUL\NULlukow\NUL\NULmail\NUL\NULmalbork\NUL\NULmalopolska\NUL\NULmazowsze\NUL\NULmazury\NUL\NULmed\NUL\NULmedia\NUL\NULmiasta\NUL\NULmielec\NUL\NULmielno\NUL\NULmil\NUL\NULmragowo\NUL\NULnaklo\NUL\NULnet\NUL\NULnieruchomosci\NUL\NULnom\NUL\NULnowaruda\NUL\NULnysa\NUL\NULolawa\NUL\NULolecko\NUL\NULolkusz\NUL\NULolsztyn\NUL\NULopoczno\NUL\NULopole\NUL\NULorg\NUL\NULostroda\NUL\NULostroleka\NUL\NULostrowiec\NUL\NULostrowwlkp\NUL\NULpc\NUL\NULpila\NUL\NULpisz\NUL\NULpodhale\NUL\NULpodlasie\NUL\NULpolkowice\NUL\NULpomorskie\NUL\NULpomorze\NUL\NULpowiat\NUL\NULpoznan\NUL\NULpriv\NUL\NULprochowice\NUL\NULpruszkow\NUL\NULprzeworsk\NUL\NULpulawy\NUL\NULradom\NUL\NULrawa-maz\NUL\NULrealestate\NUL\NULrel\NUL\NULrybnik\NUL\NULrzeszow\NUL\NULsanok\NUL\NULsejny\NUL\NULsex\NUL\NULshop\NUL\NULsklep\NUL\NULskoczow\NUL\NULslask\NUL\NULslupsk\NUL\NULsopot\NUL\NULsos\NUL\NULsosnowiec\NUL\NULstalowa-wola\NUL\NULstarachowice\NUL\NULstargard\NUL\NULsuwalki\NUL\NULswidnica\NUL\NULswiebodzin\NUL\NULswinoujscie\NUL\NULszczecin\NUL\NULszczytno\NUL\NULszkola\NUL\NULtargi\NUL\NULtarnobrzeg\NUL\NULtgory\NUL\NULtm\NUL\NULtourism\NUL\NULtravel\NUL\NULturek\NUL\NULturystyka\NUL\NULtychy\NUL\NULustka\NUL\NULwalbrzych\NUL\NULwarmia\NUL\NULwarszawa\NUL\NULwaw\NUL\NULwegrow\NUL\NULwielun\NUL\NULwlocl\NUL\NULwloclawek\NUL\NULwodzislaw\NUL\NULwolomin\NUL\NULwroc\NUL\NULwroclaw\NUL\NULzachpomor\NUL\NULzagan\NUL\NULzakopane\NUL\NULzarow\NUL\NULzgora\NUL\NULzgorzelec\NUL\NUL\NULplace\NUL\NULplay\NUL\NULplumbing\NUL\NULplus\NUL\NULpm\NUL\NULpn\NULco\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULpohl\NUL\NULpoker\NUL\NULporn\NUL\NULpost\NUL\NULpr\NULac\NUL\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULest\NUL\NULgov\NUL\NULinfo\NUL\NULisla\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NULprof\NUL\NUL\NULpraxi\NUL\NULpress\NUL\NULpro\NULaca\NUL\NULbar\NUL\NULcpa\NUL\NULeng\NUL\NULjur\NUL\NULlaw\NUL\NULmed\NUL\NUL\NULprod\NUL\NULproductions\NUL\NULprof\NUL\NULpromo\NUL\NULproperties\NUL\NULproperty\NUL\NULps\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULplo\NUL\NULsec\NUL\NUL\NULpt\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULint\NUL\NULnet\NUL\NULnome\NUL\NULorg\NUL\NULpubl\NUL\NUL\NULpub\NUL\NULpw\NULbelau\NUL\NULco\NUL\NULed\NUL\NULgo\NUL\NULne\NUL\NULor\NUL\NUL\NULpy\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULqa\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NUL\NULqpon\NUL\NULquebec\NUL\NULquest\NUL\NULracing\NUL\NULre\NULasso\NUL\NULblogspot\NUL\NULcom\NUL\NULnom\NUL\NUL\NULread\NUL\NULrealtor\NUL\NULrealty\NUL\NULrecipes\NUL\NULred\NUL\NULredstone\NUL\NULredumbrella\NUL\NULrehab\NUL\NULreise\NUL\NULreisen\NUL\NULreit\NUL\NULreliance\NUL\NULren\NUL\NULrent\NUL\NULrentals\NUL\NULrepair\NUL\NULreport\NUL\NULrepublican\NUL\NULrest\NUL\NULrestaurant\NUL\NULreview\NUL\NULreviews\NUL\NULrich\NUL\NULricoh\NUL\NULril\NUL\NULrio\NUL\NULrip\NUL\NULro\NULarts\NUL\NULblogspot\NUL\NULcom\NUL\NULfirm\NUL\NULinfo\NUL\NULnom\NUL\NULnt\NUL\NULorg\NUL\NULrec\NUL\NULstore\NUL\NULtm\NUL\NULwww\NUL\NUL\NULrocher\NUL\NULrocks\NUL\NULrodeo\NUL\NULroom\NUL\NULrs\NULac\NUL\NULco\NUL\NULedu\NUL\NULgov\NUL\NULin\NUL\NULorg\NUL\NUL\NULrsvp\NUL\NULru\NULac\NUL\NULadygeya\NUL\NULaltai\NUL\NULamur\NUL\NULamursk\NUL\NULarkhangelsk\NUL\NULastrakhan\NUL\NULbaikal\NUL\NULbashkiria\NUL\NULbelgorod\NUL\NULbir\NUL\NULblogspot\NUL\NULbryansk\NUL\NULburyatia\NUL\NULcbg\NUL\NULchel\NUL\NULchelyabinsk\NUL\NULchita\NUL\NULchukotka\NUL\NULchuvashia\NUL\NULcmw\NUL\NULcom\NUL\NULdagestan\NUL\NULdudinka\NUL\NULe-burg\NUL\NULedu\NUL\NULfareast\NUL\NULgov\NUL\NULgrozny\NUL\NULint\NUL\NULirkutsk\NUL\NULivanovo\NUL\NULizhevsk\NUL\NULjamal\NUL\NULjar\NUL\NULjoshkar-ola\NUL\NULk-uralsk\NUL\NULkalmykia\NUL\NULkaluga\NUL\NULkamchatka\NUL\NULkarelia\NUL\NULkazan\NUL\NULkchr\NUL\NULkemerovo\NUL\NULkhabarovsk\NUL\NULkhakassia\NUL\NULkhv\NUL\NULkirov\NUL\NULkms\NUL\NULkoenig\NUL\NULkomi\NUL\NULkostroma\NUL\NULkrasnoyarsk\NUL\NULkuban\NUL\NULkurgan\NUL\NULkursk\NUL\NULkustanai\NUL\NULkuzbass\NUL\NULlipetsk\NUL\NULmagadan\NUL\NULmagnitka\NUL\NULmari\NUL\NULmari-el\NUL\NULmarine\NUL\NULmil\NUL\NULmordovia\NUL\NULmsk\NUL\NULmurmansk\NUL\NULmytis\NUL\NULnakhodka\NUL\NULnalchik\NUL\NULnet\NUL\NULnkz\NUL\NULnnov\NUL\NULnorilsk\NUL\NULnov\NUL\NULnovosibirsk\NUL\NULnsk\NUL\NULomsk\NUL\NULorenburg\NUL\NULorg\NUL\NULoryol\NUL\NULoskol\NUL\NULpalana\NUL\NULpenza\NUL\NULperm\NUL\NULpp\NUL\NULptz\NUL\NULpyatigorsk\NUL\NULrnd\NUL\NULrubtsovsk\NUL\NULryazan\NUL\NULsakhalin\NUL\NULsamara\NUL\NULsaratov\NUL\NULsimbirsk\NUL\NULsmolensk\NUL\NULsnz\NUL\NULspb\NUL\NULstavropol\NUL\NULstv\NUL\NULsurgut\NUL\NULsyzran\NUL\NULtambov\NUL\NULtatarstan\NUL\NULtest\NUL\NULtom\NUL\NULtomsk\NUL\NULtsaritsyn\NUL\NULtsk\NUL\NULtula\NUL\NULtuva\NUL\NULtver\NUL\NULtyumen\NUL\NULudm\NUL\NULudmurtia\NUL\NULulan-ude\NUL\NULvdonsk\NUL\NULvladikavkaz\NUL\NULvladimir\NUL\NULvladivostok\NUL\NULvolgograd\NUL\NULvologda\NUL\NULvoronezh\NUL\NULvrn\NUL\NULvyatka\NUL\NULyakutia\NUL\NULyamal\NUL\NULyaroslavl\NUL\NULyekaterinburg\NUL\NULyuzhno-sakhalinsk\NUL\NULzgrad\NUL\NUL\NULruhr\NUL\NULrun\NUL\NULrw\NULac\NUL\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgouv\NUL\NULgov\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NUL\NULrwe\NUL\NULryukyu\NUL\NULsa\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmed\NUL\NULnet\NUL\NULorg\NUL\NULpub\NUL\NULsch\NUL\NUL\NULsaarland\NUL\NULsafe\NUL\NULsafety\NUL\NULsakura\NUL\NULsale\NUL\NULsalon\NUL\NULsamsung\NUL\NULsandvik\NUL\NULsandvikcoromant\NUL\NULsanofi\NUL\NULsap\NUL\NULsapo\NUL\NULsarl\NUL\NULsas\NUL\NULsaxo\NUL\NULsb\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsbi\NUL\NULsbs\NUL\NULsc\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsca\NUL\NULscb\NUL\NULschmidt\NUL\NULscholarships\NUL\NULschool\NUL\NULschule\NUL\NULschwarz\NUL\NULscience\NUL\NULscor\NUL\NULscot\NUL\NULsd\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULmed\NUL\NULnet\NUL\NULorg\NUL\NULtv\NUL\NUL\NULse\NULa\NUL\NULac\NUL\NULb\NUL\NULbd\NUL\NULblogspot\NUL\NULbrand\NUL\NULc\NUL\NULcom\NUL\NULd\NUL\NULe\NUL\NULf\NUL\NULfh\NUL\NULfhsk\NUL\NULfhv\NUL\NULg\NUL\NULh\NUL\NULi\NUL\NULk\NUL\NULkomforb\NUL\NULkommunalforbund\NUL\NULkomvux\NUL\NULl\NUL\NULlanbib\NUL\NULm\NUL\NULn\NUL\NULnaturbruksgymn\NUL\NULo\NUL\NULorg\NUL\NULp\NUL\NULparti\NUL\NULpp\NUL\NULpress\NUL\NULr\NUL\NULs\NUL\NULt\NUL\NULtm\NUL\NULu\NUL\NULw\NUL\NULx\NUL\NULy\NUL\NULz\NUL\NUL\NULseat\NUL\NULseek\NUL\NULsener\NUL\NULservices\NUL\NULsew\NUL\NULsex\NUL\NULsexy\NUL\NULsg\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULper\NUL\NUL\NULsh\NULcom\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULplatform\NUL*\NUL\NUL\NUL\NULsharp\NUL\NULshia\NUL\NULshiksha\NUL\NULshoes\NUL\NULshouji\NUL\NULshow\NUL\NULshriram\NUL\NULsi\NUL\NULsina\NUL\NULsingles\NUL\NULsite\NUL\NULsj\NUL\NULsk\NULblogspot\NUL\NUL\NULskin\NUL\NULsky\NUL\NULskype\NUL\NULsl\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsm\NUL\NULsmile\NUL\NULsn\NULart\NUL\NULcom\NUL\NULedu\NUL\NULgouv\NUL\NULorg\NUL\NULperso\NUL\NULuniv\NUL\NUL\NULsncf\NUL\NULso\NULcom\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsoccer\NUL\NULsocial\NUL\NULsoftware\NUL\NULsohu\NUL\NULsolar\NUL\NULsolutions\NUL\NULsong\NUL\NULsony\NUL\NULsoy\NUL\NULspace\NUL\NULspiegel\NUL\NULspot\NUL\NULspreadbetting\NUL\NULsr\NUL\NULst\NULco\NUL\NULcom\NUL\NULconsulado\NUL\NULedu\NUL\NULembaixada\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULprincipe\NUL\NULsaotome\NUL\NULstore\NUL\NUL\NULstada\NUL\NULstar\NUL\NULstarhub\NUL\NULstatebank\NUL\NULstatoil\NUL\NULstc\NUL\NULstcgroup\NUL\NULstockholm\NUL\NULstorage\NUL\NULstudio\NUL\NULstudy\NUL\NULstyle\NUL\NULsu\NULadygeya\NUL\NULarkhangelsk\NUL\NULbalashov\NUL\NULbashkiria\NUL\NULbryansk\NUL\NULdagestan\NUL\NULgrozny\NUL\NULivanovo\NUL\NULkalmykia\NUL\NULkaluga\NUL\NULkarelia\NUL\NULkhakassia\NUL\NULkrasnodar\NUL\NULkurgan\NUL\NULlenug\NUL\NULmordovia\NUL\NULmsk\NUL\NULmurmansk\NUL\NULnalchik\NUL\NULnov\NUL\NULobninsk\NUL\NULpenza\NUL\NULpokrovsk\NUL\NULsochi\NUL\NULspb\NUL\NULtogliatti\NUL\NULtroitsk\NUL\NULtula\NUL\NULtuva\NUL\NULvladikavkaz\NUL\NULvladimir\NUL\NULvologda\NUL\NUL\NULsucks\NUL\NULsupersport\NUL\NULsupplies\NUL\NULsupply\NUL\NULsupport\NUL\NULsurf\NUL\NULsurgery\NUL\NULsuzuki\NUL\NULsv\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULorg\NUL\NULred\NUL\NUL\NULswatch\NUL\NULswiss\NUL\NULsx\NULgov\NUL\NUL\NULsy\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsydney\NUL\NULsymantec\NUL\NULsystems\NUL\NULsz\NULac\NUL\NULco\NUL\NULorg\NUL\NUL\NULtab\NUL\NULtaipei\NUL\NULtaobao\NUL\NULtatamotors\NUL\NULtatar\NUL\NULtattoo\NUL\NULtax\NUL\NULtaxi\NUL\NULtc\NUL\NULtci\NUL\NULtd\NULblogspot\NUL\NUL\NULteam\NUL\NULtech\NUL\NULtechnology\NUL\NULtel\NUL\NULtelecity\NUL\NULtelefonica\NUL\NULtemasek\NUL\NULtennis\NUL\NULtf\NUL\NULtg\NUL\NULth\NULac\NUL\NULco\NUL\NULgo\NUL\NULin\NUL\NULmi\NUL\NULnet\NUL\NULor\NUL\NUL\NULthd\NUL\NULtheater\NUL\NULtickets\NUL\NULtienda\NUL\NULtiffany\NUL\NULtips\NUL\NULtires\NUL\NULtirol\NUL\NULtj\NULac\NUL\NULbiz\NUL\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgo\NUL\NULgov\NUL\NULint\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULnic\NUL\NULorg\NUL\NULtest\NUL\NULweb\NUL\NUL\NULtk\NUL\NULtl\NULgov\NUL\NUL\NULtm\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NUL\NULtmall\NUL\NULtn\NULagrinet\NUL\NULcom\NUL\NULdefense\NUL\NULedunet\NUL\NULens\NUL\NULfin\NUL\NULgov\NUL\NULind\NUL\NULinfo\NUL\NULintl\NUL\NULmincom\NUL\NULnat\NUL\NULnet\NUL\NULorg\NUL\NULperso\NUL\NULrnrt\NUL\NULrns\NUL\NULrnu\NUL\NULtourism\NUL\NULturen\NUL\NUL\NULto\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULtoday\NUL\NULtokyo\NUL\NULtools\NUL\NULtop\NUL\NULtoray\NUL\NULtoshiba\NUL\NULtours\NUL\NULtown\NUL\NULtoys\NUL\NULtp\NUL\NULtr\NULav\NUL\NULbbs\NUL\NULbel\NUL\NULbiz\NUL\NULcom\NULblogspot\NUL\NUL\NULdr\NUL\NULedu\NUL\NULgen\NUL\NULgov\NUL\NULinfo\NUL\NULk12\NUL\NULkep\NUL\NULmil\NUL\NULname\NUL\NULnc\NULgov\NUL\NUL\NULnet\NUL\NULorg\NUL\NULpol\NUL\NULtel\NUL\NULtv\NUL\NULweb\NUL\NUL\NULtrade\NUL\NULtrading\NUL\NULtraining\NUL\NULtravel\NUL\NULtravelers\NUL\NULtravelersinsurance\NUL\NULtrust\NUL\NULtrv\NUL\NULtt\NULaero\NUL\NULbiz\NUL\NULco\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULjobs\NUL\NULmobi\NUL\NULmuseum\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NULtravel\NUL\NUL\NULtui\NUL\NULtunes\NUL\NULtushu\NUL\NULtv\NULbetter-than\NUL\NULdyndns\NUL\NULon-the-web\NUL\NULworse-than\NUL\NUL\NULtvs\NUL\NULtw\NULblogspot\NUL\NULclub\NUL\NULcom\NUL\NULebiz\NUL\NULedu\NUL\NULgame\NUL\NULgov\NUL\NULidv\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULxn--czrw28b\NUL\NULxn--uc0atv\NUL\NULxn--zf0ao64a\NUL\NUL\NULtz\NULac\NUL\NULco\NUL\NULgo\NUL\NULhotel\NUL\NULinfo\NUL\NULme\NUL\NULmil\NUL\NULmobi\NUL\NULne\NUL\NULor\NUL\NULsc\NUL\NULtv\NUL\NUL\NULua\NULcherkassy\NUL\NULcherkasy\NUL\NULchernigov\NUL\NULchernihiv\NUL\NULchernivtsi\NUL\NULchernovtsy\NUL\NULck\NUL\NULcn\NUL\NULco\NUL\NULcom\NUL\NULcr\NUL\NULcrimea\NUL\NULcv\NUL\NULdn\NUL\NULdnepropetrovsk\NUL\NULdnipropetrovsk\NUL\NULdominic\NUL\NULdonetsk\NUL\NULdp\NUL\NULedu\NUL\NULgov\NUL\NULif\NUL\NULin\NUL\NULivano-frankivsk\NUL\NULkh\NUL\NULkharkiv\NUL\NULkharkov\NUL\NULkherson\NUL\NULkhmelnitskiy\NUL\NULkhmelnytskyi\NUL\NULkiev\NUL\NULkirovograd\NUL\NULkm\NUL\NULkr\NUL\NULkrym\NUL\NULks\NUL\NULkv\NUL\NULkyiv\NUL\NULlg\NUL\NULlt\NUL\NULlugansk\NUL\NULlutsk\NUL\NULlv\NUL\NULlviv\NUL\NULmk\NUL\NULmykolaiv\NUL\NULnet\NUL\NULnikolaev\NUL\NULod\NUL\NULodesa\NUL\NULodessa\NUL\NULorg\NUL\NULpl\NUL\NULpoltava\NUL\NULpp\NUL\NULrivne\NUL\NULrovno\NUL\NULrv\NUL\NULsb\NUL\NULsebastopol\NUL\NULsevastopol\NUL\NULsm\NUL\NULsumy\NUL\NULte\NUL\NULternopil\NUL\NULuz\NUL\NULuzhgorod\NUL\NULvinnica\NUL\NULvinnytsia\NUL\NULvn\NUL\NULvolyn\NUL\NULyalta\NUL\NULzaporizhzhe\NUL\NULzaporizhzhia\NUL\NULzhitomir\NUL\NULzhytomyr\NUL\NULzp\NUL\NULzt\NUL\NUL\NULubs\NUL\NULug\NULac\NUL\NULco\NUL\NULcom\NUL\NULgo\NUL\NULne\NUL\NULor\NUL\NULorg\NUL\NULsc\NUL\NUL\NULuk\NULac\NUL\NULco\NULblogspot\NUL\NUL\NULgov\NULservice\NUL\NUL\NULltd\NUL\NULme\NUL\NULnet\NUL\NULnhs\NUL\NULorg\NUL\NULplc\NUL\NULpolice\NUL\NULsch\NUL*\NUL\NUL\NUL\NULuniversity\NUL\NULuno\NUL\NULuol\NUL\NULus\NULak\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULal\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULar\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULas\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULaz\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULca\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULco\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULct\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULdc\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULde\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULdni\NUL\NULfed\NUL\NULfl\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULga\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULgu\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULhi\NULcc\NUL\NULlib\NUL\NUL\NULia\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULid\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULil\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULin\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULis-by\NUL\NULisa\NUL\NULkids\NUL\NULks\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULky\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULla\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULland-4-sale\NUL\NULma\NULcc\NUL\NULk12\NULchtr\NUL\NULparoch\NUL\NULpvt\NUL\NUL\NULlib\NUL\NUL\NULmd\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULme\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULmi\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULmn\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULmo\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULms\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULmt\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnc\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnd\NULcc\NUL\NULlib\NUL\NUL\NULne\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnh\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnj\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnm\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnsn\NUL\NULnv\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULny\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULoh\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULok\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULor\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULpa\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULpr\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULri\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULsc\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULsd\NULcc\NUL\NULlib\NUL\NUL\NULstuff-4-sale\NUL\NULtn\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULtx\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULut\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULva\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULvi\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULvt\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULwa\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULwi\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULwv\NULcc\NUL\NUL\NULwy\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NUL\NULuy\NULcom\NUL\NULedu\NUL\NULgub\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULuz\NULco\NUL\NULcom\NUL\NULnet\NUL\NULorg\NUL\NUL\NULva\NUL\NULvacations\NUL\NULvana\NUL\NULvc\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULve\NULarts\NUL\NULco\NUL\NULcom\NUL\NULe12\NUL\NULedu\NUL\NULfirm\NUL\NULgob\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULrec\NUL\NULstore\NUL\NULtec\NUL\NULweb\NUL\NUL\NULvegas\NUL\NULventures\NUL\NULversicherung\NUL\NULvet\NUL\NULvg\NUL\NULvi\NULco\NUL\NULcom\NUL\NULk12\NUL\NULnet\NUL\NULorg\NUL\NUL\NULviajes\NUL\NULvideo\NUL\NULviking\NUL\NULvillas\NUL\NULvip\NUL\NULvirgin\NUL\NULvision\NUL\NULvista\NUL\NULvistaprint\NUL\NULviva\NUL\NULvlaanderen\NUL\NULvn\NULac\NUL\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULhealth\NUL\NULinfo\NUL\NULint\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NUL\NULvodka\NUL\NULvote\NUL\NULvoting\NUL\NULvoto\NUL\NULvoyage\NUL\NULvu\NULcom\NUL\NULedu\NUL\NULnet\NUL\NULorg\NUL\NUL\NULvuelos\NUL\NULwales\NUL\NULwalter\NUL\NULwang\NUL\NULwanggou\NUL\NULwatch\NUL\NULwatches\NUL\NULweather\NUL\NULweatherchannel\NUL\NULwebcam\NUL\NULwebsite\NUL\NULwed\NUL\NULwedding\NUL\NULweibo\NUL\NULweir\NUL\NULwf\NUL\NULwhoswho\NUL\NULwien\NUL\NULwiki\NUL\NULwilliamhill\NUL\NULwin\NUL\NULwindows\NUL\NULwme\NUL\NULwork\NUL\NULworks\NUL\NULworld\NUL\NULws\NULcom\NUL\NULdyndns\NUL\NULedu\NUL\NULgov\NUL\NULmypets\NUL\NULnet\NUL\NULorg\NUL\NUL\NULwtc\NUL\NULwtf\NUL\NULxbox\NUL\NULxerox\NUL\NULxihuan\NUL\NULxin\NUL\NULxn--11b4c3d\NUL\NULxn--1ck2e1b\NUL\NULxn--1qqw23a\NUL\NULxn--30rr7y\NUL\NULxn--3bst00m\NUL\NULxn--3ds443g\NUL\NULxn--3e0b707e\NUL\NULxn--3pxu8k\NUL\NULxn--42c2d9a\NUL\NULxn--45brj9c\NUL\NULxn--45q11c\NUL\NULxn--4gbrim\NUL\NULxn--54b7fta0cc\NUL\NULxn--55qw42g\NUL\NULxn--55qx5d\NUL\NULxn--5tzm5g\NUL\NULxn--6frz82g\NUL\NULxn--6qq986b3xl\NUL\NULxn--80adxhks\NUL\NULxn--80ao21a\NUL\NULxn--80asehdb\NUL\NULxn--80aswg\NUL\NULxn--8y0a063a\NUL\NULxn--90a3ac\NULxn--80au\NUL\NULxn--90azh\NUL\NULxn--c1avg\NUL\NULxn--d1at\NUL\NULxn--o1ac\NUL\NULxn--o1ach\NUL\NUL\NULxn--9dbq2a\NUL\NULxn--9et52u\NUL\NULxn--9krt00a\NUL\NULxn--b4w605ferd\NUL\NULxn--bck1b9a5dre4c\NUL\NULxn--c1avg\NUL\NULxn--c2br7g\NUL\NULxn--cck2b3b\NUL\NULxn--cg4bki\NUL\NULxn--clchc0ea0b2g2a9gcd\NUL\NULxn--czr694b\NUL\NULxn--czrs0t\NUL\NULxn--czru2d\NUL\NULxn--d1acj3b\NUL\NULxn--eckvdtc9d\NUL\NULxn--efvy88h\NUL\NULxn--estv75g\NUL\NULxn--fhbei\NUL\NULxn--fiq228c5hs\NUL\NULxn--fiq64b\NUL\NULxn--fiqs8s\NUL\NULxn--fiqz9s\NUL\NULxn--fjq720a\NUL\NULxn--flw351e\NUL\NULxn--fpcrj9c3d\NUL\NULxn--fzc2c9e2c\NUL\NULxn--g2xx48c\NUL\NULxn--gckr3f0f\NUL\NULxn--gecrj9c\NUL\NULxn--h2brj9c\NUL\NULxn--hxt814e\NUL\NULxn--i1b6b1a6a2e\NUL\NULxn--imr513n\NUL\NULxn--io0a7i\NUL\NULxn--j1aef\NUL\NULxn--j1amh\NUL\NULxn--j6w193g\NUL\NULxn--jlq61u9w7b\NUL\NULxn--jvr189m\NUL\NULxn--kcrx77d1x4a\NUL\NULxn--kprw13d\NUL\NULxn--kpry57d\NUL\NULxn--kpu716f\NUL\NULxn--kput3i\NUL\NULxn--l1acc\NUL\NULxn--lgbbat1ad8j\NUL\NULxn--mgb2ddes\NUL\NULxn--mgb9awbf\NUL\NULxn--mgba3a3ejt\NUL\NULxn--mgba3a4f16a\NUL\NULxn--mgba3a4fra\NUL\NULxn--mgbaam7a8h\NUL\NULxn--mgbab2bd\NUL\NULxn--mgbayh7gpa\NUL\NULxn--mgbb9fbpob\NUL\NULxn--mgbbh1a71e\NUL\NULxn--mgbc0a9azcg\NUL\NULxn--mgberp4a5d4a87g\NUL\NULxn--mgberp4a5d4ar\NUL\NULxn--mgbqly7c0a67fbc\NUL\NULxn--mgbqly7cvafr\NUL\NULxn--mgbt3dhd\NUL\NULxn--mgbtf8fl\NUL\NULxn--mgbx4cd0ab\NUL\NULxn--mk1bu44c\NUL\NULxn--mxtq1m\NUL\NULxn--ngbc5azd\NUL\NULxn--ngbe9e0a\NUL\NULxn--nnx388a\NUL\NULxn--node\NUL\NULxn--nqv7f\NUL\NULxn--nqv7fs00ema\NUL\NULxn--nyqy26a\NUL\NULxn--o3cw4h\NUL\NULxn--ogbpf8fl\NUL\NULxn--p1acf\NUL\NULxn--p1ai\NUL\NULxn--pbt977c\NUL\NULxn--pgbs0dh\NUL\NULxn--pssy2u\NUL\NULxn--q9jyb4c\NUL\NULxn--qcka1pmc\NUL\NULxn--rhqv96g\NUL\NULxn--rovu88b\NUL\NULxn--s9brj9c\NUL\NULxn--ses554g\NUL\NULxn--t60b56a\NUL\NULxn--tckwe\NUL\NULxn--unup4y\NUL\NULxn--vermgensberater-ctb\NUL\NULxn--vermgensberatung-pwb\NUL\NULxn--vhquv\NUL\NULxn--vuq861b\NUL\NULxn--wgbh1c\NUL\NULxn--wgbl6a\NUL\NULxn--xhq521b\NUL\NULxn--xkc2al3hye2a\NUL\NULxn--xkc2dl3a5ee0h\NUL\NULxn--yfro4i67o\NUL\NULxn--ygbi2ammx\NUL\NULxn--zfr164b\NUL\NULxxx\NUL\NULxyz\NUL\NULyachts\NUL\NULyahoo\NUL\NULyamaxun\NUL\NULyandex\NUL\NULye\NUL*\NUL\NUL\NULyodobashi\NUL\NULyoga\NUL\NULyokohama\NUL\NULyoutube\NUL\NULyt\NUL\NULyun\NUL\NULza\NUL*\NUL\NUL\NULzara\NUL\NULzero\NUL\NULzip\NUL\NULzm\NUL*\NUL\NUL\NULzone\NUL\NULzuerich\NUL\NULzw\NUL*\NUL\NUL\NUL\NULck\NULwww\NUL\NUL\NULjp\NULkawasaki\NULcity\NUL\NUL\NULkitakyushu\NULcity\NUL\NUL\NULkobe\NULcity\NUL\NUL\NULnagoya\NULcity\NUL\NUL\NULsapporo\NULcity\NUL\NUL\NULsendai\NULcity\NUL\NUL\NULyokohama\NULcity\NUL\NUL\NUL\NULmz\NULteledata\NUL\NUL\NUL\NUL" #endif http-client-0.4.26.2/publicsuffixlist/Network/PublicSuffixList/Lookup.hs0000644000000000000000000000772612636306172024502 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.PublicSuffixList.Lookup (effectiveTLDPlusOne, effectiveTLDPlusOne', isSuffix, isSuffix') where import qualified Data.Map as M import Data.Maybe (isNothing) import qualified Data.Text as T import qualified Network.PublicSuffixList.DataStructure as DS import Network.PublicSuffixList.Types {-| OffEnd's Bool argument represents whether we fell off a leaf or whether we fell off a non-leaf. True means that we fell off a leaf. Its Text argument is the component that pushed us off the end, along with all the components to the right of that one, interspersed with "."s -} data LookupResult = Inside | AtLeaf | OffEnd Bool T.Text deriving (Eq) {-| This function returns whether or not this domain is owned by a registrar or a regular person. 'Nothing' means that this is a registrar domain; 'Just x' means it's owned by a person. This is used to determine if a cookie is allowed to bet set for a particular domain. For example, you shouldn't be able to set a cookie for \"com\". If the value is 'Just x', then the x value is what is known as the effective TLD plus one. This is one segment more than the suffix of the domain. For example, the eTLD+1 for "this.is.a.subdom.com" is Just "subdom.com" Note that this function expects lowercase ASCII strings. These strings should be gotten from the toASCII algorithm as described in RFC 3490. These strings should not start or end with the \'.\' character, and should not have two \'.\' characters next to each other. (The toASCII algorithm is implemented in the \'idna\' hackage package, though that package doesn't always map strings to lowercase) -} effectiveTLDPlusOne' :: DataStructure -> T.Text -> Maybe T.Text effectiveTLDPlusOne' dataStructure s -- Any TLD is a suffix | length ss == 1 = Nothing | otherwise = output rulesResult exceptionResult where ss = T.splitOn "." s ps = reverse ss exceptionResult = recurse ps [] $ snd dataStructure rulesResult = recurse ps [] $ fst dataStructure -- If we fell off, did we do it at a leaf? Otherwise, what's the -- subtree that we're at getNext :: Tree T.Text -> T.Text -> Either Bool (Tree T.Text) getNext t s' = case M.lookup s' $ children t of Nothing -> Left (M.null $ children t) Just t' -> Right t' -- Look up the component we're looking for... getNextWithStar t s' = case getNext t s' of -- and if that fails, look up "*" Left _ -> getNext t "*" r -> r recurse :: [T.Text] -> [T.Text] -> Tree T.Text -> LookupResult recurse [] _ t | M.null $ children t = AtLeaf | otherwise = Inside recurse (c : cs) prev t = case getNextWithStar t c of Left b -> OffEnd b $ T.intercalate "." (c : prev) Right t' -> recurse cs (c : prev) t' -- Only match against the exception rules if we have a full match output _ AtLeaf = Just s output _ (OffEnd True x) = Just $ T.intercalate "." $ tail $ T.splitOn "." x -- If we have a subdomain on an existing rule, we're not a suffix output (OffEnd _ x) _ -- A single level domain can never be a eTLD+1 | isNothing $ T.find (== '.') x = Just $ T.intercalate "." $ drop (length ss - 2) ss | otherwise = Just x -- Otherwise, we're a suffix of a suffix, which is a suffix output _ _ = Nothing -- | >>> effectiveTLDPlusOne = effectiveTLDPlusOne' Network.PublicSuffixList.DataStructure.dataStructure effectiveTLDPlusOne :: T.Text -> Maybe T.Text effectiveTLDPlusOne = effectiveTLDPlusOne' DS.dataStructure -- | >>> isSuffix' dataStructure = isNothing . effectiveTLDPlusOne' dataStructure isSuffix' :: DataStructure -> T.Text -> Bool isSuffix' dataStructure = isNothing . effectiveTLDPlusOne' dataStructure -- | >>> isSuffix = isSuffix' Network.PublicSuffixList.DataStructure.dataStructure isSuffix :: T.Text -> Bool isSuffix = isNothing . effectiveTLDPlusOne http-client-0.4.26.2/publicsuffixlist/Network/PublicSuffixList/Serialize.hs0000644000000000000000000000366212636306172025153 0ustar0000000000000000module Network.PublicSuffixList.Serialize (getDataStructure, putDataStructure) where import Blaze.ByteString.Builder (Builder, fromWord8, toByteString) import Blaze.ByteString.Builder.Char.Utf8 (fromText) import qualified Data.ByteString as BS import Data.Foldable (foldMap) import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid (mappend) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Network.PublicSuffixList.Types getTree :: BS.ByteString -> (Tree T.Text, BS.ByteString) getTree = loop Map.empty where loop m bs | BS.null bs = (Node m, bs) | BS.head bs == 0 = (Node m, BS.drop 1 bs) | otherwise = let (k, v, bs') = getPair bs in loop (Map.insert k v m) bs' getPair :: BS.ByteString -> (T.Text, Tree T.Text, BS.ByteString) getPair bs0 = (k, v, bs2) where (k, bs1) = getText bs0 (v, bs2) = getTree bs1 getText :: BS.ByteString -> (T.Text, BS.ByteString) getText bs0 = (TE.decodeUtf8 v, BS.drop 1 bs1) where (v, bs1) = BS.breakByte 0 bs0 getDataStructure :: BS.ByteString -> DataStructure getDataStructure bs0 = (x, y) where (x, bs1) = getTree bs0 (y, _) = getTree bs1 putTree :: Tree T.Text -> Builder putTree = putMap . children putMap :: Map T.Text (Tree T.Text) -> Builder putMap m = foldMap putPair (Map.toList m) `mappend` fromWord8 0 putPair :: (T.Text, Tree T.Text) -> Builder putPair (x, y) = putText x `mappend` putTree y putText :: T.Text -> Builder putText t = fromText t `mappend` fromWord8 0 putDataStructure :: DataStructure -> BS.ByteString putDataStructure (x, y) = toByteString $ putTree x `mappend` putTree y http-client-0.4.26.2/publicsuffixlist/Network/PublicSuffixList/Types.hs0000644000000000000000000000071412636306172024323 0ustar0000000000000000{-| This module is only exported for the use of the 'publicsuffixlistcreate' package. Every one else should consider everything in this file to be opaque. -} module Network.PublicSuffixList.Types where import qualified Data.Map as M import qualified Data.Text as T newtype Tree e = Node { children :: M.Map e (Tree e) } deriving (Show, Eq) def :: Ord e => Tree e def = Node M.empty type DataStructure = (Tree T.Text, Tree T.Text) http-client-0.4.26.2/test/0000755000000000000000000000000012636306172013351 5ustar0000000000000000http-client-0.4.26.2/test/Spec.hs0000644000000000000000000000005412636306172014576 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-client-0.4.26.2/test/Network/0000755000000000000000000000000012636306172015002 5ustar0000000000000000http-client-0.4.26.2/test/Network/HTTP/0000755000000000000000000000000012636306172015561 5ustar0000000000000000http-client-0.4.26.2/test/Network/HTTP/ClientSpec.hs0000644000000000000000000000163212636306172020150 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.ClientSpec where import Network (withSocketsDo) import Network.HTTP.Client import Network.HTTP.Types (status200) import Test.Hspec import Data.ByteString.Lazy.Char8 () -- orphan instance main :: IO () main = hspec spec spec :: Spec spec = describe "Client" $ do it "works" $ withSocketsDo $ do req <- parseUrl "http://httpbin.org/" man <- newManager defaultManagerSettings res <- httpLbs req man responseStatus res `shouldBe` status200 it "managerModifyRequest" $ do let modify req = return req { port = 80 } settings = defaultManagerSettings { managerModifyRequest = modify } withManager settings $ \man -> do res <- httpLbs "http://httpbin.org:1234" man responseStatus res `shouldBe` status200 http-client-0.4.26.2/test-nonet/0000755000000000000000000000000012636306172014472 5ustar0000000000000000http-client-0.4.26.2/test-nonet/Spec.hs0000644000000000000000000000005412636306172015717 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-client-0.4.26.2/test-nonet/Network/0000755000000000000000000000000012636306172016123 5ustar0000000000000000http-client-0.4.26.2/test-nonet/Network/HTTP/0000755000000000000000000000000012636306172016702 5ustar0000000000000000http-client-0.4.26.2/test-nonet/Network/HTTP/ClientSpec.hs0000644000000000000000000002034112636306172021267 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Network.HTTP.ClientSpec where import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.Async (withAsync) import qualified Control.Concurrent.Async as Async import Control.Exception (bracket, catch, IOException) import Control.Monad (forever, replicateM_, void) import Network.HTTP.Client import Network.HTTP.Types (status413) import Network.Socket (sClose) import Test.Hspec import qualified Data.Streaming.Network as N import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as SL import Data.ByteString.Lazy.Char8 () -- orphan instance main :: IO () main = hspec spec redirectServer :: (Int -> IO a) -> IO a redirectServer inner = bracket (N.bindRandomPortTCP "*4") (sClose . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where app ad = do forkIO $ forever $ N.appRead ad forever $ do N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\ncontent-length: 5\r\n\r\n" threadDelay 10000 N.appWrite ad "hello\r\n" threadDelay 10000 redirectCloseServer :: (Int -> IO a) -> IO a redirectCloseServer inner = bracket (N.bindRandomPortTCP "*4") (sClose . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where app ad = do Async.race_ (forever (N.appRead ad)) (N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\nConnection: close\r\n\r\nhello") N.appCloseConnection ad bad100Server :: Bool -- ^ include extra headers? -> (Int -> IO a) -> IO a bad100Server extraHeaders inner = bracket (N.bindRandomPortTCP "*4") (sClose . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where app ad = do forkIO $ forever $ N.appRead ad forever $ do N.appWrite ad $ S.concat [ "HTTP/1.1 100 Continue\r\n" , if extraHeaders then "foo:bar\r\nbaz: bin\r\n" else "" , "\r\nHTTP/1.1 200 OK\r\ncontent-length: 5\r\n\r\nhello\r\n" ] threadDelay 10000 earlyClose413 :: (Int -> IO a) -> IO a earlyClose413 inner = bracket (N.bindRandomPortTCP "*4") (sClose . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where app ad = do let readHeaders front = do newBS <- N.appRead ad let bs = S.append front newBS if "\r\n\r\n" `S.isInfixOf` bs then return () else readHeaders bs readHeaders S.empty N.appWrite ad "HTTP/1.1 413 Too Large\r\ncontent-length: 7\r\n\r\ngoodbye" -- Make sure we detect bad situations like -- https://github.com/yesodweb/wai/issues/346 better than we did previously, so -- that misreporting like https://github.com/snoyberg/http-client/issues/108 -- doesn't occur. lengthAndChunked :: (Int -> IO a) -> IO a lengthAndChunked = serveWith "HTTP/1.1 200 OK\r\ncontent-length: 24\r\ntransfer-encoding: chunked\r\n\r\n4\r\nWiki\r\n5\r\npedia\r\ne\r\n in\r\n\r\nchunks.\r\n0\r\n\r\n" lengthZeroAndChunked :: (Int -> IO a) -> IO a lengthZeroAndChunked = serveWith "HTTP/1.1 200 OK\r\ncontent-length: 0\r\ntransfer-encoding: chunked\r\n\r\n4\r\nWiki\r\n5\r\npedia\r\ne\r\n in\r\n\r\nchunks.\r\n0\r\n\r\n" lengthZeroAndChunkZero :: (Int -> IO a) -> IO a lengthZeroAndChunkZero = serveWith "HTTP/1.1 200 OK\r\ncontent-length: 0\r\ntransfer-encoding: chunked\r\n\r\n0\r\n\r\n" serveWith :: S.ByteString -> (Int -> IO a) -> IO a serveWith resp inner = bracket (N.bindRandomPortTCP "*4") (sClose . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where app ad = do let readHeaders front = do newBS <- N.appRead ad let bs = S.append front newBS if "\r\n\r\n" `S.isInfixOf` bs then return () else readHeaders bs readHeaders S.empty N.appWrite ad resp getChunkedResponse :: Int -> Manager -> IO (Response SL.ByteString) getChunkedResponse port' man = flip httpLbs man "http://localhost" { port = port' , checkStatus = \_ _ _ -> Nothing , requestBody = RequestBodyStreamChunked ($ return (S.replicate 100000 65)) } spec :: Spec spec = describe "Client" $ do describe "fails on empty hostnames #40" $ do let test url = it url $ do req <- parseUrl url man <- newManager defaultManagerSettings _ <- httpLbs req man `shouldThrow` \e -> case e of InvalidDestinationHost "" -> True _ -> False return () mapM_ test ["http://", "https://", "http://:8000", "https://:8001"] it "redirecting #41" $ redirectServer $ \port -> do req' <- parseUrl $ "http://127.0.0.1:" ++ show port let req = req' { redirectCount = 1 } withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do httpLbs req man `shouldThrow` \e -> case e of TooManyRedirects _ -> True _ -> False it "redirectCount=0" $ redirectServer $ \port -> do req' <- parseUrl $ "http://127.0.0.1:" ++ show port let req = req' { redirectCount = 0 } withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do httpLbs req man `shouldThrow` \e -> case e of StatusCodeException{} -> True _ -> False it "connecting to missing server gives nice error message" $ do (port, socket) <- N.bindRandomPortTCP "*4" sClose socket req <- parseUrl $ "http://127.0.0.1:" ++ show port withManager defaultManagerSettings $ \man -> httpLbs req man `shouldThrow` \e -> case e of FailedConnectionException2 "127.0.0.1" port' False _ -> port == port' _ -> False describe "extra headers after 100 #49" $ do let test x = it (show x) $ bad100Server x $ \port -> do req <- parseUrl $ "http://127.0.0.1:" ++ show port withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do x <- httpLbs req man responseBody x `shouldBe` "hello" test False test True it "early close on a 413" $ earlyClose413 $ \port' -> do withManager defaultManagerSettings $ \man -> do res <- getChunkedResponse port' man responseBody res `shouldBe` "goodbye" responseStatus res `shouldBe` status413 it "length zero and chunking zero #108" $ lengthZeroAndChunkZero $ \port' -> do withManager defaultManagerSettings $ \man -> do res <- getChunkedResponse port' man responseBody res `shouldBe` "" it "length zero and chunking" $ lengthZeroAndChunked $ \port' -> do withManager defaultManagerSettings $ \man -> do res <- getChunkedResponse port' man responseBody res `shouldBe` "Wikipedia in\r\n\r\nchunks." it "length and chunking" $ lengthAndChunked $ \port' -> do withManager defaultManagerSettings $ \man -> do res <- getChunkedResponse port' man responseBody res `shouldBe` "Wikipedia in\r\n\r\nchunks." it "withResponseHistory and redirect" $ redirectCloseServer $ \port -> do -- see https://github.com/snoyberg/http-client/issues/169 req' <- parseUrl $ "http://127.0.0.1:" ++ show port let req = req' {redirectCount = 1} withManager defaultManagerSettings $ \man -> do withResponseHistory req man (const $ return ()) `shouldThrow` \e -> case e of TooManyRedirects _ -> True _ -> False http-client-0.4.26.2/test-nonet/Network/HTTP/Client/0000755000000000000000000000000012636306172020120 5ustar0000000000000000http-client-0.4.26.2/test-nonet/Network/HTTP/Client/BodySpec.hs0000644000000000000000000000642512636306172022173 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Client.BodySpec where import Test.Hspec import Network.HTTP.Client import Network.HTTP.Client.Internal import qualified Data.ByteString as S import Codec.Compression.GZip (compress) import qualified Data.ByteString.Lazy as L main :: IO () main = hspec spec brComplete :: BodyReader -> IO Bool brComplete brRead = do xs <- brRead return (xs == "") spec :: Spec spec = describe "BodySpec" $ do it "chunked, single" $ do (conn, _, input) <- dummyConnection [ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed" ] reader <- makeChunkedReader False conn body <- brConsume reader S.concat body `shouldBe` "hello world" input' <- input S.concat input' `shouldBe` "not consumed" brComplete reader `shouldReturn` True it "chunked, pieces" $ do (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed" reader <- makeChunkedReader False conn body <- brConsume reader S.concat body `shouldBe` "hello world" input' <- input S.concat input' `shouldBe` "not consumed" brComplete reader `shouldReturn` True it "chunked, raw" $ do (conn, _, input) <- dummyConnection [ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed" ] reader <- makeChunkedReader True conn body <- brConsume reader S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\n" input' <- input S.concat input' `shouldBe` "not consumed" brComplete reader `shouldReturn` True it "chunked, pieces, raw" $ do (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed" reader <- makeChunkedReader True conn body <- brConsume reader S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\n" input' <- input S.concat input' `shouldBe` "not consumed" brComplete reader `shouldReturn` True it "length, single" $ do (conn, _, input) <- dummyConnection [ "hello world done" ] reader <- makeLengthReader 11 conn body <- brConsume reader S.concat body `shouldBe` "hello world" input' <- input S.concat input' `shouldBe` " done" brComplete reader `shouldReturn` True it "length, pieces" $ do (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack "hello world done" reader <- makeLengthReader 11 conn body <- brConsume reader S.concat body `shouldBe` "hello world" input' <- input S.concat input' `shouldBe` " done" brComplete reader `shouldReturn` True it "gzip" $ do let orig = L.fromChunks $ replicate 5000 "Hello world!" origZ = compress orig (conn, _, input) <- dummyConnection $ L.toChunks origZ ++ ["ignored"] reader' <- makeLengthReader (fromIntegral $ L.length origZ) conn reader <- makeGzipReader reader' body <- brConsume reader L.fromChunks body `shouldBe` orig input' <- input S.concat input' `shouldBe` "ignored" brComplete reader `shouldReturn` True http-client-0.4.26.2/test-nonet/Network/HTTP/Client/CookieSpec.hs0000644000000000000000000000175212636306172022505 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Client.CookieSpec where import Data.Time.Clock import Network.HTTP.Client.Internal import Network.HTTP.Types import Test.Hspec main :: IO () main = hspec spec spec :: Spec spec = describe "CookieSpec" $ do it "cookie equality - case insensitive Eq" $ do now <- getCurrentTime let cookie1 = Cookie "test" "value" now "doMain.Org" "/" now now False False False False cookie2 = Cookie "test" "value" now "DOMAIn.ORg" "/" now now False False False False cookie1 `shouldBe` cookie2 it "domainMatches - case insensitive" $ do domainMatches "www.org" "www.org" `shouldBe` True domainMatches "wWw.OrG" "Www.oRG" `shouldBe` True domainMatches "wxw.OrG" "Www.oRG" `shouldBe` False it "domainMatches - case insensitive, partial" $ do domainMatches "www.org" "xxx.www.org" `shouldBe` False domainMatches "xxx.www.org" "WWW.ORG" `shouldBe` True http-client-0.4.26.2/test-nonet/Network/HTTP/Client/HeadersSpec.hs0000644000000000000000000000432212636306172022643 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Client.HeadersSpec where import Network.HTTP.Client.Internal import Network.HTTP.Types import Test.Hspec main :: IO () main = hspec spec spec :: Spec spec = describe "HeadersSpec" $ do it "simple response" $ do let input = [ "HTTP/" , "1.1 200" , " OK\r\nfoo" , ": bar\r\n" , "baz:bin\r\n\r" , "\nignored" ] (connection, _, _) <- dummyConnection input statusHeaders <- parseStatusHeaders connection Nothing Nothing statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") , ("baz", "bin") ] it "Expect: 100-continue (success)" $ do let input = [ "HTTP/1.1 100 Continue\r\n\r\n" , "HTTP/1.1 200 OK\r\n" , "foo: bar\r\n\r\n" ] (conn, out, _) <- dummyConnection input let sendBody = connectionWrite conn "data" statusHeaders <- parseStatusHeaders conn Nothing (Just sendBody) statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") ] out >>= (`shouldBe` ["data"]) it "Expect: 100-continue (failure)" $ do let input = [ "HTTP/1.1 417 Expectation Failed\r\n\r\n" ] (conn, out, _) <- dummyConnection input let sendBody = connectionWrite conn "data" statusHeaders <- parseStatusHeaders conn Nothing (Just sendBody) statusHeaders `shouldBe` StatusHeaders status417 (HttpVersion 1 1) [] out >>= (`shouldBe` []) it "100 Continue without expectation is OK" $ do let input = [ "HTTP/1.1 100 Continue\r\n\r\n" , "HTTP/1.1 200 OK\r\n" , "foo: bar\r\n\r\n" , "result" ] (conn, out, inp) <- dummyConnection input statusHeaders <- parseStatusHeaders conn Nothing Nothing statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") ] out >>= (`shouldBe` []) inp >>= (`shouldBe` ["result"]) http-client-0.4.26.2/test-nonet/Network/HTTP/Client/RequestBodySpec.hs0000644000000000000000000000325412636306172023541 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Client.RequestBodySpec where import Control.Monad import Test.Hspec import Control.Exception import System.IO import Data.IORef import qualified Data.ByteString as BS import Network.HTTP.Client (streamFile, parseUrl, requestBody) import Network.HTTP.Client.Internal (dummyConnection, Connection, connectionWrite, requestBuilder) import System.Directory (getTemporaryDirectory) spec :: Spec spec = describe "streamFile" $ it "works" $ withTmpFile $ \(path, h) -> do replicateM_ 5000 $ BS.hPut h "Hello, world!\r\n" hClose h withBinaryFile path ReadMode $ \h' -> do conn <- verifyFileConnection h' req0 <- parseUrl "http://example.com" body <- streamFile path let req = req0 { requestBody = body } requestBuilder req conn hIsEOF h' `shouldReturn` True where withTmpFile = bracket getTmpFile closeTmpFile getTmpFile = do tmp <- getTemporaryDirectory openBinaryTempFile tmp "request-body-stream-file" closeTmpFile (_, h) = hClose h firstReadBS = "GET / HTTP/1.1\r\nHost: example.com\r\nAccept-Encoding: gzip\r\nContent-Length: 75000\r\n\r\n" verifyFileConnection h = do (conn, _, _) <- dummyConnection [] isFirstReadRef <- newIORef True return conn { connectionWrite = \bs -> do isFirstRead <- readIORef isFirstReadRef if isFirstRead then do bs `shouldBe` firstReadBS writeIORef isFirstReadRef False else do bs' <- BS.hGet h (BS.length bs) bs `shouldBe` bs' } http-client-0.4.26.2/test-nonet/Network/HTTP/Client/RequestSpec.hs0000644000000000000000000001315212636306172022721 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Client.RequestSpec where import Blaze.ByteString.Builder (fromByteString) import Control.Applicative ((<$>)) import Control.Monad (join, forM_) import Data.IORef import Data.Maybe (isJust, fromMaybe, fromJust) import Network.HTTP.Client (parseUrl, requestHeaders, applyBasicProxyAuth) import Network.HTTP.Client.Internal import Network.URI (URI(..), URIAuth(..)) --(parseURI, relativeTo, escapeURIString, isAllowedInURI) import Test.Hspec spec :: Spec spec = do describe "case insensitive scheme" $ do forM_ ["http://example.com", "httP://example.com", "HttP://example.com", "HttPs://example.com"] $ \url -> it url $ case parseUrl url of Nothing -> error "failed" Just _ -> return () :: IO () forM_ ["ftp://example.com"] $ \url -> it url $ case parseUrl url of Nothing -> return () :: IO () Just req -> error $ show req describe "authentication in url" $ do it "passes validation" $ do case parseUrl "http://agent:topsecret@example.com" of Nothing -> error "failed" Just _ -> return () :: IO () it "add username/password to headers section" $ do let request = parseUrl "http://user:pass@example.com" field = join $ lookup "Authorization" . requestHeaders <$> request requestHostnameWithoutAuth = "example.com" (uriRegName $ fromJust $ uriAuthority $ getUri $ fromJust request) `shouldBe` requestHostnameWithoutAuth field `shouldSatisfy` isJust field `shouldBe` Just "Basic dXNlcjpwYXNz" describe "applyBasicProxyAuth" $ do let request = applyBasicProxyAuth "user" "pass" <$> parseUrl "http://example.org" field = join $ lookup "Proxy-Authorization" . requestHeaders <$> request it "Should add a proxy-authorization header" $ do field `shouldSatisfy` isJust it "Should add a proxy-authorization header with the specified username and password." $ do field `shouldBe` Just "Basic dXNlcjpwYXNz" describe "extract credentials from a URI" $ do it "fetches non-empty username before the first ':'" $ do username "agent:secret@example.com" `shouldBe` "agent" it "extra colons do not delimit username" $ do username "agent:006:supersecret@example.com" `shouldBe` "agent" it "after ':' is considered password" $ do password "agent007:shakenNotStirred@example.com" `shouldBe` "shakenNotStirred" it "encodes username special characters per RFC3986" $ do username "/?#[]!$&'()*+,;=:therealpassword@example.com" `shouldBe` "%2F%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D" it "encodes password special characters per RFC3986" $ do password "therealusername:?#[]!$&'()*+,;=/@example.com" `shouldBe` "%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D%2F" it "no auth is empty" $ do username "example.com" `shouldBe` "" password "example.com" `shouldBe` "" describe "requestBuilder" $ do it "sends the full request, combining headers and body in the non-streaming case" $ do let Just req = parseUrl "http://localhost" let req' = req { method = "PUT", path = "foo" } (conn, out, _) <- dummyConnection [] forM_ (bodies `zip` out1) $ \(b, o) -> do cont <- requestBuilder (req' { requestBody = b } ) conn (const "" <$> cont) `shouldBe` Nothing out >>= (`shouldBe` o) it "sends only headers and returns an action for the body on 'Expect: 100-continue'" $ do let Just req = parseUrl "http://localhost" let req' = req { requestHeaders = [("Expect", "100-continue")] , method = "PUT" , path = "foo" } (conn, out, _) <- dummyConnection [] forM_ (bodies `zip` out2) $ \(b, (h, o)) -> do cont <- requestBuilder (req' { requestBody = b } ) conn out >>= (`shouldBe` [h, ""]) fromMaybe (return ()) cont out >>= (`shouldBe` o) where bodies = [ RequestBodyBS "data" , RequestBodyLBS "data" , RequestBodyBuilder 4 (fromByteString "data") , RequestBodyStream 4 (popper ["data"] >>=) , RequestBodyStreamChunked (popper ["data"] >>=) ] out1 = [ [nonChunked <> "\r\ndata"] , [nonChunked <> "\r\ndata"] , [nonChunked <> "\r\ndata"] , [nonChunked <> "\r\n", "", "data"] , [chunked <> "\r\n", "", "4\r\ndata\r\n","0\r\n\r\n"] ] out2 = [ (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"]) , (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"]) , (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"]) , (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"]) , (chunked <> "Expect: 100-continue\r\n\r\n", ["4\r\ndata\r\n","0\r\n\r\n"]) ] nonChunked = "PUT /foo HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\nContent-Length: 4\r\n" chunked = "PUT /foo HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\nTransfer-Encoding: chunked\r\n" popper dat = do r <- newIORef dat return . atomicModifyIORef' r $ \xs -> case xs of (x:xs') -> (xs', x) [] -> ([], "") http-client-0.4.26.2/test-nonet/Network/HTTP/Client/ResponseSpec.hs0000644000000000000000000000571312636306172023073 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Network.HTTP.Client.ResponseSpec where import Test.Hspec import Network.HTTP.Client import Network.HTTP.Client.Internal import Network.HTTP.Types import Codec.Compression.GZip (compress) import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Char8 () import qualified Data.ByteString as S main :: IO () main = hspec spec spec :: Spec spec = describe "ResponseSpec" $ do let getResponse' conn = getResponse (const $ return ()) Nothing req conn Nothing Just req = parseUrl "http://localhost" it "basic" $ do (conn, _, _) <- dummyConnection [ "HTTP/1.1 200 OK\r\n" , "Key1: Value1\r\n" , "Content-length: 11\r\n\r\n" , "Hello" , " W" , "orld\r\nHTTP/1.1" ] Response {..} <- getResponse' conn responseStatus `shouldBe` status200 responseVersion `shouldBe` HttpVersion 1 1 responseHeaders `shouldBe` [ ("Key1", "Value1") , ("Content-length", "11") ] pieces <- brConsume responseBody pieces `shouldBe` ["Hello", " W", "orld"] it "no length" $ do (conn, _, _) <- dummyConnection [ "HTTP/1.1 200 OK\r\n" , "Key1: Value1\r\n\r\n" , "Hello" , " W" , "orld\r\nHTTP/1.1" ] Response {..} <- getResponse' conn responseStatus `shouldBe` status200 responseVersion `shouldBe` HttpVersion 1 1 responseHeaders `shouldBe` [ ("Key1", "Value1") ] pieces <- brConsume responseBody pieces `shouldBe` ["Hello", " W", "orld\r\nHTTP/1.1"] it "chunked" $ do (conn, _, _) <- dummyConnection [ "HTTP/1.1 200 OK\r\n" , "Key1: Value1\r\n" , "Transfer-encoding: chunked\r\n\r\n" , "5\r\nHello\r" , "\n2\r\n W" , "\r\n4 ignored\r\norld\r\n0\r\nHTTP/1.1" ] Response {..} <- getResponse' conn responseStatus `shouldBe` status200 responseVersion `shouldBe` HttpVersion 1 1 responseHeaders `shouldBe` [ ("Key1", "Value1") , ("Transfer-encoding", "chunked") ] pieces <- brConsume responseBody pieces `shouldBe` ["Hello", " W", "orld"] it "gzip" $ do (conn, _, _) <- dummyConnection $ "HTTP/1.1 200 OK\r\n" : "Key1: Value1\r\n" : "Content-Encoding: gzip\r\n\r\n" : L.toChunks (compress "Compressed Hello World") Response {..} <- getResponse' conn responseStatus `shouldBe` status200 responseVersion `shouldBe` HttpVersion 1 1 responseHeaders `shouldBe` [ ("Key1", "Value1") , ("Content-Encoding", "gzip") ] pieces <- brConsume responseBody S.concat pieces `shouldBe` "Compressed Hello World"