diff options
Diffstat (limited to 'Mainline.hs')
-rw-r--r-- | Mainline.hs | 46 |
1 files changed, 44 insertions, 2 deletions
diff --git a/Mainline.hs b/Mainline.hs index 29f1df80..76e914b3 100644 --- a/Mainline.hs +++ b/Mainline.hs | |||
@@ -54,6 +54,8 @@ import qualified Network.DHT.Routing as R | |||
54 | ;import Network.DHT.Routing (Info, Timestamp, getTimestamp) | 54 | ;import Network.DHT.Routing (Info, Timestamp, getTimestamp) |
55 | import Network.QueryResponse | 55 | import Network.QueryResponse |
56 | import Network.Socket | 56 | import Network.Socket |
57 | import System.IO.Error | ||
58 | import System.IO.Unsafe (unsafeInterleaveIO) | ||
57 | 59 | ||
58 | newtype NodeId = NodeId ByteString | 60 | newtype NodeId = NodeId ByteString |
59 | deriving (Eq,Ord,Show,ByteArrayAccess, BEncode, Bits, Hashable) | 61 | deriving (Eq,Ord,Show,ByteArrayAccess, BEncode, Bits, Hashable) |
@@ -344,7 +346,7 @@ data Routing = Routing | |||
344 | 346 | ||
345 | type MainlineClient = Client String Method TransactionId NodeInfo (Message BValue) | 347 | type MainlineClient = Client String Method TransactionId NodeInfo (Message BValue) |
346 | 348 | ||
347 | newClient :: SockAddr -> IO MainlineClient | 349 | newClient :: SockAddr -> IO (MainlineClient, Routing) |
348 | newClient addr = do | 350 | newClient addr = do |
349 | udp <- udpTransport addr | 351 | udp <- udpTransport addr |
350 | nid <- NodeId <$> getRandomBytes 20 | 352 | nid <- NodeId <$> getRandomBytes 20 |
@@ -414,7 +416,7 @@ newClient addr = do | |||
414 | , clientResponseId = return | 416 | , clientResponseId = return |
415 | } | 417 | } |
416 | 418 | ||
417 | return client | 419 | return (client, routing) |
418 | 420 | ||
419 | defaultHandler :: ByteString -> Handler | 421 | defaultHandler :: ByteString -> Handler |
420 | defaultHandler meth = MethodHandler decodePayload errorPayload returnError | 422 | defaultHandler meth = MethodHandler decodePayload errorPayload returnError |
@@ -840,3 +842,43 @@ nodeSearch = Search | |||
840 | , searchNodeAddress = nodeIP &&& nodePort | 842 | , searchNodeAddress = nodeIP &&& nodePort |
841 | , searchQuery = error "searchQuery" | 843 | , searchQuery = error "searchQuery" |
842 | } | 844 | } |
845 | |||
846 | -- | List of bootstrap nodes maintained by different bittorrent | ||
847 | -- software authors. | ||
848 | bootstrapNodes :: WantIP -> IO [NodeInfo] | ||
849 | bootstrapNodes want = unsafeInterleaveIO $ do | ||
850 | let wellknowns = | ||
851 | [ "router.bittorrent.com:6881" -- by BitTorrent Inc. | ||
852 | |||
853 | -- doesn't work at the moment (use git blame) of commit | ||
854 | , "dht.transmissionbt.com:6881" -- by Transmission project | ||
855 | |||
856 | , "router.utorrent.com:6881" | ||
857 | ] | ||
858 | nss <- forM wellknowns $ \hostAndPort -> do | ||
859 | e <- resolve want hostAndPort | ||
860 | case e of | ||
861 | Left _ -> return [] | ||
862 | Right sockaddr -> either (const $ return []) | ||
863 | (return . (: [])) | ||
864 | $ nodeInfo zeroID sockaddr | ||
865 | return $ concat nss | ||
866 | |||
867 | -- | Resolve either a numeric network address or a hostname to a | ||
868 | -- numeric IP address of the node. | ||
869 | resolve :: WantIP -> String -> IO (Either IOError SockAddr) | ||
870 | resolve want hostAndPort = do | ||
871 | let hints = defaultHints { addrSocketType = Datagram | ||
872 | , addrFamily = case want of | ||
873 | Want_IP4 -> AF_INET | ||
874 | _ -> AF_INET6 | ||
875 | } | ||
876 | (rport,rhost) = span (/= ':') $ reverse hostAndPort | ||
877 | (host,port) = case rhost of | ||
878 | [] -> (hostAndPort, Nothing) | ||
879 | (_:hs) -> (reverse hs, Just (reverse rport)) | ||
880 | tryIOError $ do | ||
881 | -- getAddrInfo throws exception on empty list, so this | ||
882 | -- pattern matching never fails. | ||
883 | info : _ <- getAddrInfo (Just hints) (Just host) port | ||
884 | return $ addrAddress info | ||