summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/dhtd.hs23
-rw-r--r--src/Network/BitTorrent/DHT/Query.hs1
2 files changed, 22 insertions, 2 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index f8ca8575..cb507f71 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -31,6 +31,7 @@ import Data.Torrent (InfoHash)
31import Network.BitTorrent.Address 31import Network.BitTorrent.Address
32import Network.BitTorrent.DHT 32import Network.BitTorrent.DHT
33import Network.BitTorrent.DHT.Query 33import Network.BitTorrent.DHT.Query
34import Network.BitTorrent.DHT.Message (FindNode(..),NodeFound(..))
34import Network.KRPC.Manager (QueryFailure(..)) 35import Network.KRPC.Manager (QueryFailure(..))
35import Network.KRPC.Message (ReflectedIP(..)) 36import Network.KRPC.Message (ReflectedIP(..))
36import qualified Network.BitTorrent.DHT.Routing as R 37import qualified Network.BitTorrent.DHT.Routing as R
@@ -212,6 +213,21 @@ clientSession st signalQuit sock n h = do
212 hPutClient h $ unlines rs 213 hPutClient h $ unlines rs
213 Left er -> return $ hPutClient h er 214 Left er -> return $ hPutClient h er
214 215
216 ("find-nodes", s) -> cmd $ do
217 let (hs,as) = second (dropWhile isSpace) $ break isSpace s
218 parse = do ih <- readEither hs
219 a <- readEither as
220 -- XXX: using 'InfoHash' only because 'NodeId' currently
221 -- has no 'Read' instance.
222 return (ih :: InfoHash, a :: NodeAddr IPv4)
223 case parse of
224 Right (ih,a) -> do
225 result <- try $ queryNode' (a ::NodeAddr IPv4) $ FindNode (R.toNodeId ih)
226 let rs = either (pure . showQueryFail) reportNodes result
227 return $ do
228 hPutClient h $ unlines rs
229 Left er -> return $ hPutClient h er
230
215 _ -> cmd0 $ hPutClient h "error." 231 _ -> cmd0 $ hPutClient h "error."
216 232
217defaultPort = error "TODO defaultPort" 233defaultPort = error "TODO defaultPort"
@@ -219,9 +235,12 @@ defaultPort = error "TODO defaultPort"
219showQueryFail :: QueryFailure -> String 235showQueryFail :: QueryFailure -> String
220showQueryFail e = show e 236showQueryFail e = show e
221 237
238consip (ReflectedIP ip) xs = ("(external-ip " ++ show ip ++ ")") : xs
239
222reportPong (info,myip) = maybe id consip myip [show $ pPrint info] 240reportPong (info,myip) = maybe id consip myip [show $ pPrint info]
223 where 241
224 consip (ReflectedIP ip) xs = ("(external-ip " ++ show ip ++ ")") : xs 242reportNodes :: (NodeId, NodeFound IPv4, Maybe ReflectedIP) -> [String]
243reportNodes (nid,NodeFound ns,myip) = maybe id consip myip $ show (pPrint nid) : map (show . pPrint) ns
225 244
226main :: IO () 245main :: IO ()
227main = do 246main = do
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index 533068c6..e0338572 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -47,6 +47,7 @@ module Network.BitTorrent.DHT.Query
47 47
48 -- ** Messaging 48 -- ** Messaging
49 , queryNode 49 , queryNode
50 , queryNode'
50 , (<@>) 51 , (<@>)
51 ) where 52 ) where
52 53