diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 23 |
1 files changed, 21 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) | |||
31 | import Network.BitTorrent.Address | 31 | import Network.BitTorrent.Address |
32 | import Network.BitTorrent.DHT | 32 | import Network.BitTorrent.DHT |
33 | import Network.BitTorrent.DHT.Query | 33 | import Network.BitTorrent.DHT.Query |
34 | import Network.BitTorrent.DHT.Message (FindNode(..),NodeFound(..)) | ||
34 | import Network.KRPC.Manager (QueryFailure(..)) | 35 | import Network.KRPC.Manager (QueryFailure(..)) |
35 | import Network.KRPC.Message (ReflectedIP(..)) | 36 | import Network.KRPC.Message (ReflectedIP(..)) |
36 | import qualified Network.BitTorrent.DHT.Routing as R | 37 | import 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 | ||
217 | defaultPort = error "TODO defaultPort" | 233 | defaultPort = error "TODO defaultPort" |
@@ -219,9 +235,12 @@ defaultPort = error "TODO defaultPort" | |||
219 | showQueryFail :: QueryFailure -> String | 235 | showQueryFail :: QueryFailure -> String |
220 | showQueryFail e = show e | 236 | showQueryFail e = show e |
221 | 237 | ||
238 | consip (ReflectedIP ip) xs = ("(external-ip " ++ show ip ++ ")") : xs | ||
239 | |||
222 | reportPong (info,myip) = maybe id consip myip [show $ pPrint info] | 240 | reportPong (info,myip) = maybe id consip myip [show $ pPrint info] |
223 | where | 241 | |
224 | consip (ReflectedIP ip) xs = ("(external-ip " ++ show ip ++ ")") : xs | 242 | reportNodes :: (NodeId, NodeFound IPv4, Maybe ReflectedIP) -> [String] |
243 | reportNodes (nid,NodeFound ns,myip) = maybe id consip myip $ show (pPrint nid) : map (show . pPrint) ns | ||
225 | 244 | ||
226 | main :: IO () | 245 | main :: IO () |
227 | main = do | 246 | main = do |