From 804499c370068febee47b3e2b7441e2c742f7b9a Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 24 Jan 2017 05:54:58 -0500 Subject: dhtd "ping" command --- examples/dhtd.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'examples') diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 1790d10a..f8ca8575 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs @@ -30,6 +30,9 @@ import System.Posix.Process (getProcessID) import Data.Torrent (InfoHash) import Network.BitTorrent.Address import Network.BitTorrent.DHT +import Network.BitTorrent.DHT.Query +import Network.KRPC.Manager (QueryFailure(..)) +import Network.KRPC.Message (ReflectedIP(..)) import qualified Network.BitTorrent.DHT.Routing as R import Network.BitTorrent.DHT.Session import Network.SocketLike @@ -201,10 +204,25 @@ clientSession st signalQuit sock n h = do hPutClient h $ unlines $ map (showEnry . (flip (,) 0)) nodes Left er -> return $ hPutClient h er + ("ping", s) -> cmd $ do + case readEither s of + Right addr -> do result <- try $ pingQ addr + let rs = either (pure . showQueryFail) reportPong result + return $ do + hPutClient h $ unlines rs + Left er -> return $ hPutClient h er + _ -> cmd0 $ hPutClient h "error." defaultPort = error "TODO defaultPort" +showQueryFail :: QueryFailure -> String +showQueryFail e = show e + +reportPong (info,myip) = maybe id consip myip [show $ pPrint info] + where + consip (ReflectedIP ip) xs = ("(external-ip " ++ show ip ++ ")") : xs + main :: IO () main = do args <- getArgs -- cgit v1.2.3